Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations derfloh on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Access violation errors. How to fix/debug them? 1

Status
Not open for further replies.
TheBugSlayer

TheBugSlayer

Programmer
Sep 22, 2002
887
US
Guys,
this is something that has always puzzled me. How do you deal with the Access Violation errors?

My program was running just fine, made some changes the other day and suddenly I am not able to run it. Each time I try I get "Project XYZ faulted with message:'access violation at address 0x006b0167: write of address 0x006007f'. Process stopped. Use Step or Run to continue" and you know that neither Step nor Run work after that.

Now, what I need to know is how to use those addresses to determine which control is the one causing the problem. There is a CPU window with assembler coding and what seems to be a dump of something...How do I use all that information to fix my program?

Thank you very much.
 
Sort by date Sort by votes
Couple of things:

"Access violation" is commonly caused by referencing an object that hasn't been created.

Use Tools/Debugger Options... to check "Stop on Delphi Exceptions" on the Language Exceptions tab. Then "Step or Run to continue" will work. You can then set a break point on a line above where processing resumed to allow you to step into the code that is failing the next time you try to run the app.

View/Debug Windows/Modules (Ctrl+Alt+M) can sometimes be used to see which part of the code corresponds to the address you were given. (But not always.)

 
Upvote 0 Downvote
Hi.
There is a way to find out a little bit more about the Access Violation, but that includes the procedure "Assert"?

Code: 
Assert(MyObject <> nil, 'MyObject not created!');

Then, you can redirect AssertErrorProc to decode the Assertion message...


//Nordlund
 
Upvote 0 Downvote
Stop on Delphi Exceptions" was checked and I still can't access Step or Run...
 
Upvote 0 Downvote
have you stepped through the code from the beginning?

I usually find the source of these errors by placing a break point somewhere above where it's failing and step through line by line. Now you can't just hit F7, you have to look at which line you are on before pressing it so you know where to come back to.

Here's a perfect example:

I have a public variable (varPublic) on a form (frmSomething), while stepping through the code I find that I am assigning a value to frmSomething.varPublic = 'Something'. Except I haven't created frmSomething yet, so I'm going to get the access violation, but I don't get the error until after I have pressed F7 to continue, and then the editor is left somewhere else, but I know where I was just before the error occurred, so I can go back and figure out what I'm doing wrong.

Leslie
 
Upvote 0 Downvote
Thank you all. The problem I am having is that the main form doesn't even get to open, so I really don't know where it is happening. Tomorrow I will try setting up a break point at the beginning of the program, probably in the main program.

Thank you again.
 
Upvote 0 Downvote
show us some code, maybe we can help :)

--------------------------------------
What You See Is What You Get
 
Upvote 0 Downvote
I apologize if the code is too long but I had to paste it all as I don't know where the problem might be occuring. Please bear with me.
Code: 
{ $HDR$}
{**********************************************************************}
{ Unit archived using Team Coherence                                   }
{ Team Coherence is Copyright 2001 by Quality Software Components      }
{                                                                      }
{ For further information / comments, visit our WEB site at            }
{ [URL unfurl="true"]http://www.TeamCoherence.com[/URL]                                         }
{**********************************************************************}
{}
{ $Log:  30727: uSplitBatch.pas 
{
{   Rev 1.0    4/29/2004 12:47:52 PM  tino
}
unit uSplitBatch;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, MCP2Ctrl, ExtCtrls, RXClock, LTCUtils, StdCtrls, ComCtrls, DB,
  ADODB, ZipMstr, OleCtrls, XceedZipLib_TLB, Mask, ToolEdit, DateUtils,
  CheckLst;

const
  sActiveLiveKey = 'SELECT IT.*, U.UDF_VALUE, CONVERT(VARCHAR(10), ITS_DTSTART, 101) AS SD FROM MCPITEMTASKS IT JOIN MCPUDFS U ON U.ITE_ID = IT.ITE_ID WHERE IT.ITS_STATUS = 1 AND IT.TAS_ID = 4 AND IT.ITT_NAME = ''Batches'' AND U.UDF_NAME = ''FormsTotal''';
  sUpdItemStatus = 'UPDATE MCPITEMTASKS SET ITS_STATUS = %d WHERE TAS_ID = %d AND ITE_NAME = ''%s''';
  sUpdItemStatusOp = 'UPDATE MCPITEMTASKS SET ITS_STATUS = %d, USE_LOGIN = ''%s'' WHERE TAS_ID = %d AND ITE_NAME = ''%s''';
  sUpdUDF = 'UPDATE MCPUDFS SET MCPUDFS.UDF_VALUE = ''%s'' FROM MCPUDFS INNER JOIN MCPITEMS ON MCPUDFS.ITE_ID = MCPITEMS.ITE_ID WHERE MCPITEMS.ITE_NAME = ''%s'' AND MCPUDFS.UDF_NAME = ''%s''';
  sUpdNote = 'UPDATE MCPITEMS SET ITE_NOTE = ''%s'' WHERE ITE_NAME = ''%s''';
  sUpdStopDate = 'UPDATE MCPITEMTASKS SET ITS_DTSTOP = CONVERT(DATETIME,CONVERT(VARCHAR(10), ITS_DTSTART, 101) + '' 23:30'',121) WHERE TAS_ID = 4 AND ITE_NAME = ''%S''';
  sUpdMachine = 'UPDATE MCPITEMTASKS SET ITS_MACHINE  = ''%s'' WHERE TAS_ID = 4 AND ITE_NAME = ''%S''';
  sUpdStartDate = 'UPDATE MCPITEMTASKS SET ITS_DTSTART  = ''%s'' WHERE TAS_ID = 4 AND ITE_NAME = ''%S''';
  sGetUDFValue = 'SELECT UDF_VALUE FROM MCPUDFS JOIN MCPITEMS ON MCPUDFS.ITE_ID = MCPITEMS.ITE_ID WHERE MCPITEMS.ITE_NAME = ''%s'' AND MCPUDFS.UDF_NAME = ''%s''';
  //Using TAS_ID instead of TAS_NAME due to string constant length restriction (<=255).
  sGetInStopDate = 'SELECT TOP 1 IT.ITS_DTSTOP, IT.TAS_ID, T.TAS_NAME FROM MCPITEMTASKS IT JOIN MCPTASKS T ON IT.TAS_ID = T.TAS_ID WHERE T.TAS_ID IN (0,1,12,13,54,63) AND IT.ITE_NAME = ''%s'' ORDER BY IT.ITS_DTSTOP DESC';
  sUpdInStopDate = 'UPDATE MCPITEMTASKS SET ITS_DTSTOP = ''%s'' WHERE TAS_ID = %d AND ITE_NAME = ''%S''';
  sDisputes = 'DC DT DE DA DP DL DD DM DR BD DK FR DF DN RR';
type
  TForm1 = class(TForm)
    RxClock: TRxClock;                
    MCP: TMCP2;
    btnActivate: TButton;
    SBar: TStatusBar;
    Conn: TADOConnection;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    dtpTime: TDateTimePicker;
    Zip1: TXceedZip;
    Label4: TLabel;
    cbLog: TCheckBox;
    Label5: TLabel;
    qryUpdUDF2: TADOQuery;
    btnRefAlarm: TButton;
    Button1: TButton;
    cbBackup: TCheckBox;
    Label6: TLabel;
    edBatchFolder: TDirectoryEdit;
    edTempFolder: TDirectoryEdit;
    edLogFile: TDirectoryEdit;
    edDataFolder: TDirectoryEdit;
    edBKPFolder: TDirectoryEdit;
    cbDateFilter: TCheckBox;
    dtpFilter: TDateTimePicker;
    qryActiveLK: TADOQuery;
    clbxBatchList: TCheckListBox;
    btnView: TButton;
    btnCheck: TButton;
    btnUncheck: TButton;
    procedure RxClockAlarm(Sender: TObject);
    procedure btnActivateClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure dtpTimeChange(Sender: TObject);
    procedure cbLogClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure cbBackupClick(Sender: TObject);
    procedure cbDateFilterClick(Sender: TObject);
    procedure btnViewClick(Sender: TObject);
    procedure btnCheckClick(Sender: TObject);
    procedure btnUncheckClick(Sender: TObject);
    procedure FormShow(Sender: TObject);

  private
    { Private declarations }
    RS : _RecordSet;
    ItemList, ProcessedList, NotKeyedList, ProcessedDotBarList : TStringList;
    procedure ParseCommandLine;
    procedure SplitBatches;
    function PutBatch(IteName, TasName, TasType, RteCode, UsrID: string): boolean;
    procedure MakeNKDollarFile(var PL, NKL : TStringList);
    procedure BackupFiles(Src, Dest : string);
    procedure GetNewBatchIn;
    procedure UpdateOriginalBatchValues;
    procedure UpdateNewBatchValues;
    function GetActiveItems : _Recordset;
    function IsChecked(IteName : string) : boolean;
  public
    { Public declarations }
    RowStart, FormsTotal : integer;
    ItemPath, Op, ItemName : string;
    procedure DeleteFiles(Path : string; Mask : string);
    procedure CopyFiles(Src, Dest : string);
    procedure LogIt(Msg, LogFile : string);
    //procedure LogAndMoveNext(Msg, LogFile : string);
    procedure FileCopy(const FSrc, FDst: string);
  end;


var
  Form1: TForm1;


implementation

uses IdGlobal;

{$R *.dfm}
{***************** ParseCommandLine ********************}
procedure TForm1.ParseCommandLine;
var
  i: Integer;
  CurParam: String;
begin
  // Get the command line arguments
  for i := 1 to ParamCount do
    begin
      CurParam := ParamStr(i);
      case Clarify(ParamType(CurParam), ' ')[1] of
        'S': if ParamType(CurParam) = 'S' then
          MCP.ServerPath := ParamValue(CurParam)
        else
          if ParamType(CurParam) = 'SQLU' then
            MCP.SQLUser := ParamValue(CurParam)
          else
            if ParamType(CurParam) = 'SQLP' then
              MCP.SQLPassword := ParamValue(CurParam);
        'P': MCP.McpProject := ParamValue(CurParam);
        'I': MCP.ItemType := ParamValue(CurParam);
        'T': MCP.TaskName := ParamValue(CurParam);
        'U': MCP.UserId := ParamValue(CurParam);
        {'F': MCP.FileGroupID := ParamValue(CurParam);
        'A': MCP.ApplicationID := ParamValue(CurParam);}
      end;
    end;
end;
{***************** SplitBatches ********************}
procedure TForm1.SplitBatches;
var ImageFile, ImageFileStatus, SaveProc, SaveNK, RecCnt : string;
    i, j, PosEqual, PosComma, StopAt : integer;
    LKStartDate : string[10];
    IsDateEqual : boolean;
    D1, D2 : string[10];
begin
   if edTempFolder.Text[Length(edTempFolder.Text)] <> '\' then edTempFolder.Text := edTempFolder.Text + '\';
   if edDataFolder.Text[Length(edDataFolder.Text)] <> '\' then edDataFolder.Text := edDataFolder.Text + '\';
   if edBatchFolder.Text[Length(edBatchFolder.Text)] <> '\' then edBatchFolder.Text := edBatchFolder.Text + '\';
   GetActiveItems; //Initializes RS. //RS := MCP.OpenSQL(sActiveLiveKey);
   if RS.EOF or RS.BOF then begin
        LogIt('There are no active items left over in LiveKey on ' + DateToStr(dtpFilter.Date), ExtractFilePath(Application.ExeName) + 'splitbatch.txt');
        //dtpTime.Time := IncSecond(dtpTime.Time, 10);
        //RxClock.SetAlarmTime(dtpTime.Time);
        SBar.Panels[2].Text := 'No active batches found.';
        Exit;
   end;
   RS.MoveFirst;
   RecCnt := IntToStr(RS.RecordCount);
   SBar.Panels[0].Text := 'Batch: 0/' + RecCnt;
   j := 1;
   StopAt := 0;
   RowStart := StrToInt(MCP.TaskParameters.Values['RowStart']);
   {*}LogIt(RecCnt + ' active batches in LiveKey.', ExtractFilePath(Application.ExeName) + 'splitbatch.txt');
   while (not RS.EOF) do
   begin
    ItemName := trim(RS.Fields['ITE_NAME'].Value);
    if IsChecked(trim(RS.Fields['ITE_NAME'].Value)) then begin
      ItemList.Clear; ProcessedList.Clear; NotKeyedList.Clear; ProcessedDotBarList.Clear;
      Op := Trim(RS.Fields['USE_LOGIN'].Value);
      ItemName := trim(RS.Fields['ITE_NAME'].Value);
      MCP.ItemName := ItemName;
      LKStartDate := RS.Fields['SD'].Value;
      ItemPath := edBatchFolder.Text + Op + '\';
      D1 := FormatDateTime('mm/dd/yyyy', dtpFilter.Date);
      D2 := FormatDateTime('mm/dd/yyyy', FileDateToDateTime(FileAge(ItemPath + ItemName + '.$$$')));
      if  not cbDateFilter.Checked then IsDateEqual := true else
          IsDateEqual := (D1 = D2);
      if IsDateEqual and (Pos(Copy(ItemName,1,2), sDisputes) > 0) then begin
        SBar.Panels[0].Text := 'Batch: ' + IntToStr(j) + '/' + RecCnt;
        SBar.Panels[1].Text := Op + '\' + ItemName;
        try
           try
                {*}LogIt('Attempting to load .$$$ file for batch ' + ItemName + '.', ExtractFilePath(Application.ExeName) + 'splitbatch.txt');
                ItemList.LoadFromFile(ItemPath + ItemName + '.$$$');
           except
                {*}LogIt('Failed to load $$$ file for batch ' + ItemName + '.', ExtractFilePath(Application.ExeName) + 'splitbatch.txt');
                RS.MoveNext;
                continue;
           end;
           for i := 0 to RowStart - 2 do ProcessedList.Add(ItemList.Strings[i]);
           for i := RowStart -1 to ItemList.Count - 1 do begin
               PosEqual := Pos('=', ItemList[i]);
               PosComma := Pos(',', ItemList[i]);
               ImageFile := Copy(ItemList[i], PosEqual + 1, (PosComma - PosEqual) - 1);
               ImageFileStatus := Copy(ItemList[i], PosComma + 1, Length(ItemList[i]) - PosComma);
               SBar.Panels[2].Text := ImageFile + '\' + ImageFileStatus;

               //Zip in the proper file (batch complete, new batch) as we go along. Add to the proper list to create .$$$ and .bar file later.
               Zip1.FilesToProcess := ItemPath + ImageFile;
               if Trim(UpperCase(ImageFileStatus)) = 'NOT KEYED' then begin
                  Zip1.ZipFilename := edTempFolder.Text + ItemName + 'R.zip';
                  NotKeyedList.Add(ImageFile);
               end else begin
                  Zip1.ZipFilename := edTempFolder.Text + ItemName + '.zip';
                  ProcessedList.Add(ItemList[i]);
                  ProcessedDotBarList.Add(ImageFile);
               end;
               if Zip1.Zip <> xerSuccess then
                  raise Exception.Create('Error zipping file ' + Zip1.ZipFilename + '!');
               Application.ProcessMessages;
           end;
           if (ProcessedList.Count > 7) and (NotKeyedList.Count > 7) then begin
           {Even when there is nothing to process, the list has a seven-line header.
            ******** KEYED ********.}
                {*}LogIt('Entered the KEYED section.', ExtractFilePath(Application.ExeName) + 'splitbatch.txt');
                SaveProc := edTempFolder.Text + ItemName + '.$$$';
                ProcessedList.SaveToFile(SaveProc);
                ProcessedDotBarList.SaveToFile(edTempFolder.Text + ItemName + '.bar');
                Zip1.ZipFilename := edTempFolder.Text + ItemName + '.zip';
                Zip1.FilesToProcess := SaveProc;
                if Zip1.Zip <> xerSuccess then raise Exception.Create('Error zipping file ' + Zip1.ZipFilename + '!');
                Zip1.FilesToProcess := edTempFolder.Text + ItemName + '.bar';
                if Zip1.Zip <> xerSuccess then raise Exception.Create('Error zipping file ' + Zip1.ZipFilename + '!');
                {Clear folder, throw new files there and then Put the original batch, with the modified files.
                 in the folder. Update ProcessDate and FormsTotal.}
                {*}LogIt('Entered the file op section in KEYED.', ExtractFilePath(Application.ExeName) + 'splitbatch.txt');
                if cbBackup.Checked then BackupFiles(ItemPath, edBKPFolder.Text);//!!!!This is a backup. Remove after testing.
                DeleteFiles(ItemPath, '*.*');
                FileCopy(edTempFolder.Text + ItemName + '.zip', ItemPath + ItemName + '.zip' );
                FileCopy(edTempFolder.Text + ItemName + '.zip', edDataFolder.Text + ItemName + '.zip' );//!!!

                Zip1.ZipFilename := ItemPath + ItemName + '.zip';
                Zip1.FilesToProcess := '*.*';
                Zip1.UnzipToFolder := ItemPath;
                if Zip1.Unzip <> xerSuccess then raise Exception.Create('Error unzipping file ' + Zip1.ZipFilename + '!');
                PutBatch(ItemName, 'LiveKey', 'Custom', 'OK' , Op);
                {*}LogIt('PUT ' + ItemName , ExtractFilePath(Application.ExeName) + 'splitbatch.txt');
                UpdateOriginalBatchValues;
                {*}LogIt('Updated original batch values.' , ExtractFilePath(Application.ExeName) + 'splitbatch.txt');
                DeleteFiles(ItemPath, '*.*');//Looks like Put doesn't delete them...

           {******** NOT KEYED ********.}
                {*}LogIt('Entered the NOT KEYED section.', ExtractFilePath(Application.ExeName) + 'splitbatch.txt');
                SaveNK := edTempFolder.Text + ItemName + 'R.bar';
                NotKeyedList.SaveToFile(SaveNK);
                Zip1.ZipFilename := edTempFolder.Text + ItemName + 'R.zip';
                Zip1.FilesToProcess := SaveNK;
                if Zip1.Zip <> xerSuccess then raise Exception.Create('Error zipping file ' + Zip1.FilesToProcess + '!');

                MakeNKDollarFile(ProcessedList, NotKeyedList);

                Zip1.ZipFilename := edTempFolder.Text + ItemName + 'R.zip';
                Zip1.FilesToProcess := edTempFolder.Text + ItemName + 'R.$$$';
                if Zip1.Zip <> xerSuccess then raise Exception.Create('Error zipping file ' + Zip1.FilesToProcess + '!');
                {Copy the new batch to the data folder. Empty the op's folder, throw the new batches' files there.
                Put the new batch. Set it to Active in LiveKey so the same operator gets it.
                Update ProcessDate, FormsTotal and FormsTotalInv for the new batch}
                {*}LogIt('Entered the file op section in NOT KEYED.', ExtractFilePath(Application.ExeName) + 'splitbatch.txt');
                FileCopy(edTempFolder.Text + ItemName + 'R.zip', edDataFolder.Text + '\' + ItemName + 'R.zip' );
                DeleteFiles(ItemPath, '*.*');//Are there files in the folder at this point?
                CopyFileTo(edTempFolder.Text + ItemName + 'R.zip', ItemPath + ItemName + 'R.zip' );

                Zip1.ZipFilename := ItemPath + ItemName + 'R.zip';
                Zip1.FilesToProcess := '*.*';
                Zip1.UnzipToFolder := ItemPath;
                if Zip1.Unzip <> xerSuccess then raise Exception.Create('Error unzipping file ' + Zip1.ZipFilename + '!');

                PutBatch(ItemName + 'R', 'SplitBatch', 'Custom', 'OK' , Op);
                {*}LogIt('PUT ' + ItemName + 'R' , ExtractFilePath(Application.ExeName) + 'splitbatch.txt');
                MCP.OpenSQL(Format(sUpdItemStatusOp,[1, Op, 4, ItemName + 'R']));//Active in LiveKey.

                UpdateNewBatchValues;
                {*}LogIt('Updated new batch values.' , ExtractFilePath(Application.ExeName) + 'splitbatch.txt');
                GetNewBatchIn;
                LogIt('Processed ' + ItemName + ' for operator ' + Op, edLogFile.Text);
           end else
               LogIt('Processed ' + ItemName + ' for operator ' + Op + ' but no unkeyed documents found.', edLogFile.Text);
           DeleteFiles(edTempFolder.Text, '*.*');
           {*}LogIt('Deleted temporary folder.' , ExtractFilePath(Application.ExeName) + 'splitbatch.txt');

           j := j + 1;
        except
           RxClock.Color := clRed;
           if cbLog.Checked then LogIt('An error occured while processing ' + ItemName + ' for operator ' + Op + '!', edLogFile.Text); //!!!
           RS.MoveNext;
           continue;
           //raise;
        end;
      end; {if IsDateEqual}
    end; {If  IsChecked(trim(RS.Fields['ITE_NAME'].Value))}
      RS.MoveNext;
      {*}LogIt('Fetching next record.' , ExtractFilePath(Application.ExeName) + 'splitbatch.txt');
      Inc(StopAt);
      Application.ProcessMessages;
   end; {While}
   SBar.Panels[2].Text := 'Complete.';
end;
{***************** PutBatch ********************}
function TForm1.PutBatch(IteName, TasName, TasType, RteCode, UsrID: string): boolean;
begin
  Result := true;
  with MCP do begin
     //ItemType := 'testftpfiles';
     ItemName := IteName; //Not necessary.
     TaskName := TasName;
     TaskType := TasType;
     RouteCode := RteCode;
     UserID := UsrID;
     try
        Put;
     except
        Result := false;
     end;
  end;
end;
{***************** RxClockAlarm ********************}
procedure TForm1.RxClockAlarm(Sender: TObject);
var bSplit, bAnyChecked : boolean;
    i : integer;
begin
  if not cbDateFilter.Checked then bSplit := true
     else if (DateToStr(dtpFilter.Date) = DateToStr(Date)) then
       if MessageDlg('Batches may have problems if they are split based on today''s date, would you like to proceed?',
          mtConfirmation, [mbYes, mbNo], 0) = mrYes then bSplit := true
             else bSplit := false;

  i := 0; bAnyChecked := false;
  while (i <= clbxBatchList.Items.Count - 1) and not bAnyChecked do
     if clbxBatchList.Checked[i] then begin
        bAnyChecked := true;
        bSplit := true;
     end else Inc(i);
  if not bAnyChecked then begin
     SBar.Panels[2].Text := '[' + TimeToStr(Time) + '] No batch selected for split.';
     LogIt('No batch was selected for split. Exiting procedure.' , ExtractFilePath(Application.ExeName) + 'splitbatch.txt');
     Exit;
  end;

  if bSplit then begin
   ParseCommandLine;
   MCP.GetTaskParameters;
   SplitBatches;
   RxClock.SetAlarmTime(dtpTime.Time);
  end else MessageDlg('Batches will not be split under today''s date.', mtInformation, [mbOk], 0);
end;
{***************** btnActivateClick ********************}
procedure TForm1.btnActivateClick(Sender: TObject);
begin
   if btnActivate.Caption = '&Activate Alarm' then
   begin
     RxClock.Color := clGreen;
     RxClock.SetAlarmTime(dtpTime.Time);
     RxClock.AlarmEnabled := true;
     btnActivate.Caption := '&Stop Alarm';
   end else
   begin
     RxClock.Color := clGray;
     RxClock.AlarmEnabled := false;
     btnActivate.Caption := '&Activate Alarm';
   end;
   ParseCommandLine;
end;
{***************** FormCreate ********************}
procedure TForm1.FormCreate(Sender: TObject);
begin
   ItemList := TStringList.Create;
   ProcessedList := TStringList.Create;
   NotKeyedList := TStringList.Create;
   ProcessedDotBarList :=  TStringList.Create;
   RxClock.Color := clGray;
   edLogFile.Enabled := cbLog.Checked;
   dtpFilter.Date := Now - 1;
   dtpFilter.Enabled := cbDateFilter.Checked;
end;
{***************** FormDestroy ********************}
procedure TForm1.FormDestroy(Sender: TObject);
begin
  FreeAndNil(ItemList);
  FreeAndNil(ProcessedList);
  FreeAndNil(NotKeyedList);
  FreeAndNil(ProcessedDotBarList);
end;
{***************** dtpTimeChange ********************}
procedure TForm1.dtpTimeChange(Sender: TObject);
begin
   //RxClock.SetAlarmTime(dtpTime.Time);
   RxClock.Refresh;
end;
{***************** DeleteFiles ********************}
procedure TForm1.DeleteFiles(Path : string; Mask : string);
var
   SearchRec: TSearchRec;
   FindResult:  Integer;
begin
   FindResult:= FindFirst(Path + Mask, 0, SearchRec);
   try
     while FindResult=0 do
     begin
       while FileExists(Path + SearchRec.Name) do
           DeleteFile(Path + SearchRec.Name);
       FindResult:= FindNext(SearchRec);
     end;
   finally
       FindClose(SearchRec);
       //RemoveDir(ImagesPath);
   end;
end;
{***************** CopyFiles ********************}
procedure TForm1.CopyFiles(Src, Dest : string);
var
   SearchRec: TSearchRec;
   FindResult:  Integer;
begin
   if Src[Length(Src)] <> '\' then Src := Src + '\';
   if Dest[Length(Dest)] <> '\' then Dest := Dest + '\';
   FindResult:= FindFirst(Src + '*.*', 0, SearchRec);
   try
     while FindResult=0 do
     begin
       FileCopy(Src + SearchRec.Name, Dest + SearchRec.Name);
       FindResult:= FindNext(SearchRec);
     end;
   finally
       FindClose(SearchRec);
   end;
end;
{***************** LogIt ********************}
procedure TForm1.LogIt(Msg, LogFile : string);
var
   hFile : TextFile;
begin
   if LogFile <> '' then
   try
       try
           AssignFile(hFile, LogFile);
           if not FileExists(LogFile) then
               Rewrite(hFile)
           else begin
               Reset(hFile);
               Append(hFile);
           end;
           writeln(hFile, 'Time            :' + DateTimeToStr(Now));
           writeln(hFile, 'Client          :' + Application.Title);
           writeln(hFile, 'ItemName        :' + MCP.ItemName);
           writeln(hFile, 'Message         :' + Msg);
           writeln(hFile, '********************');
       finally
           CloseFile(hFile);
       end;
   except
   end;
end;
{***************** cbLogClick ********************}
procedure TForm1.cbLogClick(Sender: TObject);
begin
   edLogFile.Enabled := cbLog.Checked;
end;
{***************** FileCopy ********************}
procedure TForm1.FileCopy(const FSrc, FDst: string);
var
  sStream,
  dStream: TFileStream;
begin
  sStream := TFileStream.Create(FSrc, fmOpenRead);
  try
    dStream := TFileStream.Create(FDst, fmCreate);
    try
      dStream.CopyFrom(sStream, 0);
    finally
      dStream.Free;
    end;
  finally
    sStream.Free;
  end;
end;
{***************** FileCopy ********************}
procedure TForm1.MakeNKDollarFile(var PL, NKL : TStringList);
var i : integer;
    DFList : TStringList;
    Item : string;
begin
   DFList := TStringList.Create;
   for i := 0 to RowStart - 2 do DFList.Add(PL.Strings[i]);
   DFList.Strings[0] := DFList.Strings[0] + 'R';
   DFList.Strings[3] := 'OpID=' + Op;
   DFList.Strings[6] := 'CurrClaim=' + NKL.Strings[0];
   for i := 0 to NKL.Count - 1 do begin
       Item := 'Claim' + IntToStr(i) + '=' + NKL.Strings[i] + ',Not Keyed';
       DFList.Add(Item);
   end;
   DFList.SaveToFile(edTempFolder.Text + ItemName + 'R.$$$');
   FreeAndNil(DFList);
end;
{***************** Use this to test anything ********************}
procedure TForm1.Button1Click(Sender: TObject);
begin
   ShowMessage(FormatDateTime('mm/dd/yyyy', dtpFilter.Date));
   ShowMessage(FormatDateTime('mm/dd/yyyy', FileDateToDateTime(FileAge('D:\Temp\OpFiles\DC051704-0098.$$$'))));
   //RS := GetActiveItems;
   //ShowMessage(IntToStr(RS.RecordCount));
end;
{***************** cbBackupClick ********************}
procedure TForm1.cbBackupClick(Sender: TObject);
begin
  edBKPFolder.Enabled := cbBackup.Checked;
end;
{***************** BackupFiles ********************}
procedure TForm1.BackupFiles(Src, Dest : string);
begin
  {$I-}
  if not DirectoryExists(Dest) then
     MkDir(Dest);
  if IOResult = 0 then begin
     CopyFiles(Src, Dest);
     //Do something else.
  end
  else
    if cbLog.Checked then
       LogIt('An error occured while trying to create backup folder. Current files will not be saved for ' + ItemName + '.', edLogFile.Text); //!!!
  {$I+}
end;
{***************** GetNewBatchIn ********************}
procedure TForm1.GetNewBatchIn;
var TempRS : _Recordset;
    sValue : string;
begin
   //Select the task that got the original batch in the system.
   TempRS := MCP.OpenSQL(Format(sGetInStopDate,[ItemName]));
   //PUT the new batch in the same originator task as the original batch.
   PutBatch(ItemName + 'R', TempRS.Fields['TAS_NAME'].Value, 'Custom', 'OK', Op);
   //Update status of new batch in RegisterBatches- the next task to any IN task- to Bypassed.
   MCP.OpenSQL(Format(sUpdItemStatus,[4, 3, ItemName + 'R']));
   //Update Stop date of new batch in originator task to that of the original batch in the same task.
   sValue := IntToStr(TempRS.Fields['TAS_ID'].Value);
   with TempRS do
      MCP.OpenSQL(Format(sUpdInStopDate,[TempRS.Fields['ITS_DTSTOP'].Value, StrToInt(sValue), ItemName + 'R']));
end;
{***************** UpdateOriginalBatchValues ********************}
procedure TForm1.UpdateOriginalBatchValues;
var sValue : string;
begin
   sValue := FormatDateTime('yymmdd', FileDateToDateTime(FileAge(edTempFolder.Text + ItemName + '.$$$')));
   MCP.OpenSQL(Format(sUpdUDF,[sValue, ItemName + 'R', 'ProcessDate']));

   FormsTotal := StrToInt(Trim(RS.Fields['UDF_VALUE'].Value));
   sValue := IntToStr(FormsTotal - NotKeyedList.Count);
   MCP.OpenSQL(Format(sUpdUDF,[sValue, ItemName, 'FormsTotalInv']));

   MCP.OpenSQL(Format(sUpdUDF,[Op, ItemName, 'Keyer']));

   MCP.OpenSQL(Format(sUpdStopDate,[ItemName]));

   MCP.OpenSQL(Format(sUpdNote,['Split.', ItemName, 'Note']));
end;
{***************** UpdateNewBatchValues ********************}
procedure TForm1.UpdateNewBatchValues;
var sValue : string;
    TempRS : _Recordset;
begin
   sValue := RS.Fields['ITS_MACHINE'].Value;
   MCP.OpenSQL(Format(sUpdMachine,[sValue, ItemName + 'R', 'ITS_MACHINE']));

   sValue := DateTimeToStr(Now);
   MCP.OpenSQL(Format(sUpdStartDate,[sValue, ItemName + 'R', 'ITS_DTSTART']));

   sValue := FormatDateTime('yymmdd', FileDateToDateTime(FileAge(edTempFolder.Text + ItemName + 'R.$$$')));
   MCP.OpenSQL(Format(sUpdUDF,[sValue, ItemName + 'R', 'ProcessDate']));

   sValue := IntToStr(NotKeyedList.Count);
   MCP.OpenSQL(Format(sUpdUDF,[sValue, ItemName + 'R', 'FormsTotalInv']));

   sValue := Trim(RS.Fields['UDF_VALUE'].Value);
   MCP.OpenSQL(Format(sUpdUDF,[sValue, ItemName + 'R', 'FormsTotal']));

   TempRS := MCP.OpenSQL(Format(sGetUDFValue,[ItemName, 'FileName']));
   sValue := Trim(TempRS.Fields['UDF_VALUE'].Value);
   MCP.OpenSQL(Format(sUpdUDF,[sValue, ItemName + 'R', 'FileName']));

   TempRS := MCP.OpenSQL(Format(sGetUDFValue,[ItemName, 'WorkType']));
   sValue := Trim(TempRS.Fields['UDF_VALUE'].Value);
   MCP.OpenSQL(Format(sUpdUDF,[sValue, ItemName + 'R', 'WorkType']));

   TempRS := MCP.OpenSQL(Format(sGetUDFValue,[ItemName, 'StampDate']));
   sValue := Trim(TempRS.Fields['UDF_VALUE'].Value);
   MCP.OpenSQL(Format(sUpdUDF,[sValue, ItemName + 'R', 'StampDate']));

   MCP.OpenSQL(Format(sUpdUDF,[Op, ItemName + 'R', 'Keyer']));

   sValue := 'SplitBatch updated UDFs ProcessDate, FormsTotal, FormsTotalInv, FileName, WorkType, StampDate and Keyer.';
   MCP.OpenSQL(Format(sUpdNote,[sValue, ItemName + 'R', 'Note']));
end;
{***************** OpenRecordset ********************}
function TForm1.GetActiveItems : _Recordset;
begin
   Result := nil;
   if not Conn.Connected then Conn.Open;
   with qryActiveLK do begin
        Close;
        SQL.Clear;
        if cbDateFilter.Checked then begin
           SQL.Add('SELECT IT.*, U.UDF_VALUE, CONVERT(VARCHAR(10), ITS_DTSTART, 101) AS SD ');
           SQL.Add('FROM MCPITEMTASKS IT JOIN MCPUDFS U ON U.ITE_ID = IT.ITE_ID ');
           SQL.Add('WHERE IT.ITS_STATUS = 1 AND IT.TAS_ID = 4 AND IT.ITT_NAME = ''Batches'' ');
           SQL.Add('AND U.UDF_NAME = ''FormsTotal'' AND CONVERT(VARCHAR(10), ITS_DTSTART, 101) = :DateFilter');
           SQL.Add(' ORDER BY USE_LOGIN, ITE_NAME');
           Parameters.ParamByName('DateFilter').Value := FormatDateTime('mm/dd/yyyy', dtpFilter.Date);
        end
        else SQL.Add(sActiveLiveKey);
        Open;
        RS := RecordSet;
        Result := RecordSet;
   end;
end;
{***************** cbDateFilterClick ****************}
procedure TForm1.cbDateFilterClick(Sender: TObject);
begin
    dtpFilter.Enabled := cbDateFilter.Checked;
end;
{***************** Button2Click ********************}
procedure TForm1.btnViewClick(Sender: TObject);
var i : integer;
begin
        GetActiveItems;
        clbxBatchList.Items.Clear;
        while not RS.EOF do begin
           //clbxBatchList.Items.Append(trim(RS.Fields['ITE_NAME'].Value));
           i := clbxBatchList.Items.Add('[' + trim(RS.Fields['USE_LOGIN'].Value) + ']' +
           '.[' + trim(RS.Fields['ITE_NAME'].Value) + ']');
           clbxBatchList.Checked[i]:=true;
           //clbxBatchList.State[i]:=cbChecked;
           RS.MoveNext;
       end;
       RS.MoveFirst;
end;
{***************** IsChecked ********************}
function TForm1.IsChecked(IteName : string) : boolean;
var i : integer;
    IsFound : boolean;
begin
   i := 0;
   IsFound := false;
   while (i <= clbxBatchList.Items.Count - 1) and not IsFound do begin
        if UpperCase(Copy(clbxBatchList.Items.Strings[i], 8, Length(clbxBatchList.Items.Strings[i]) - 8)) =
           UpperCase(IteName) then IsFound := true else Inc(i);
   end;
   Result := IsFound and clbxBatchList.Checked[i]
end;
{***************** btnCheckClick ********************}
procedure TForm1.btnCheckClick(Sender: TObject);
var i : integer;
begin
   if clbxBatchList.Items.Count > 0 then
      for i := 0 to clbxBatchList.Items.Count - 1 do clbxBatchList.Checked[i]:=true;
end;
{***************** btnUncheckClick ********************}
procedure TForm1.btnUncheckClick(Sender: TObject);
var i : integer;
begin
   if clbxBatchList.Items.Count > 0 then
      for i := 0 to clbxBatchList.Items.Count - 1 do clbxBatchList.Checked[i]:=false;
end;
{***************** KONIEC ********************}
procedure TForm1.FormShow(Sender: TObject);
begin
   btnViewClick(Self);
end;

end.

Main program.
Code: 
{ $HDR$}
{**********************************************************************}
{ Unit archived using Team Coherence                                   }
{ Team Coherence is Copyright 2001 by Quality Software Components      }
{                                                                      }
{ For further information / comments, visit our WEB site at            }
{ [URL unfurl="true"]http://www.TeamCoherence.com[/URL]                                         }
{**********************************************************************}
{}
{ $Log:  30723: SplitBatch.dpr 
{
{   Rev 1.0    4/29/2004 12:46:50 PM  tino
}
program SplitBatch;

uses
  Forms,
  uSplitBatch in 'uSplitBatch.pas' {Form1};

{$R *.res}

begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.
 
Upvote 0 Downvote
Oh, do not bother: the program eventually started to run. The problem is that in the Show event I am using a query to create a recordset and when the recordset is empty (there was no match), any pointer movement on it fails.

In
Code: 
procedure TForm1.btnViewClick(Sender: TObject);
var i : integer;
begin
        GetActiveItems;
        clbxBatchList.Items.Clear;
        while not RS.EOF do begin
           //clbxBatchList.Items.Append(trim(RS.Fields['ITE_NAME'].Value));
           i := clbxBatchList.Items.Add('[' + trim(RS.Fields['USE_LOGIN'].Value) + ']' +
           '.[' + trim(RS.Fields['ITE_NAME'].Value) + ']');
           clbxBatchList.Checked[i]:=true;
           //clbxBatchList.State[i]:=cbChecked;
           RS.MoveNext;
       end;
       [COLOR=red]
       RS.MoveFirst;
       [/color]
end;
 
Upvote 0 Downvote
Sorry I posted while trying to preview. In the above code the line in red was replaced with if RS.RecordCount > 0 then RS.MoveFirst.

btnViewClick is invoked in FormShow.

 
Upvote 0 Downvote
lol,
I'll give you a star for solving your own bug [spin]

--------------------------------------
What You See Is What You Get
 
Upvote 0 Downvote
Well, don't give me the star yet. I just tried opening the program and it is happening again! No matter where I set the break point it never gets there! What to do?

Thanks.
 
Upvote 0 Downvote
I put a break point in the main program and the violation is taking place in the CreateForm procedure. Please see the red line in the code:
Code: 
procedure TApplication.CreateForm(InstanceClass: TComponentClass; var Reference);
var
  Instance: TComponent;
begin
  Instance := TComponent(InstanceClass.NewInstance);
  TComponent(Reference) := Instance;
  try
    [COLOR=red]Instance.Create(Self);[/color]
  except
    TComponent(Reference) := nil;
    raise;
  end;
  if (FMainForm = nil) and (Instance is TForm) then
  begin
    TForm(Instance).HandleNeeded;
    FMainForm := TForm(Instance);
  end;
end;

The line
Code: 
[COLOR=red]
if not InitInheritedComponent(Self, TForm) then
          raise EResNotFound.CreateFmt(SResNotFound, [ClassName]);
[/color]
of constructor TCustomForm.Create(AOwner: TComponent); is where it fails. In the call to create form, parameter InstanceClass = TForm1 and Reference = NO VALUE when it should have been 'Form1', can you tell me why?

Thanks again.
 
Upvote 0 Downvote
Why not just hardcode it?

[bobafett] BobbaFet [bobafett]

Everyone has a right to my opinion.
E-mail me at caswegkamp@hotmail.com
Great Delphi Websites faq102-5352
 
Upvote 0 Downvote
if not InitInheritedComponent(Form1, TForm) then
raise EResNotFound.CreateFmt(SResNotFound, [ClassName]);

[bobafett] BobbaFet [bobafett]

Everyone has a right to my opinion.
E-mail me at caswegkamp@hotmail.com
Great Delphi Websites faq102-5352
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

emailx45
  • Question
How to swap items between two or more TListBox?
Replies
1
Views
150
emailx45
emailx45
emailx45
  • Question
How to load DLL static and dynamically in Delphi?
Replies
1
Views
247
emailx45
emailx45
emailx45
  • Question
How to define the area of action of the Mouse Cursor?
Replies
1
Views
193
emailx45
emailx45
emailx45
  • Question
How to Dock / UnDock forms on TPanel / TPageControl or any other TWinControl
Replies
1
Views
149
emailx45
emailx45
emailx45
  • Question
How to create a simple and easy Splash Screen for VCL application?
Replies
1
Views
278
emailx45
emailx45

Part and Inventory Search

Sponsor

Back
Top