[Back to COPYMOVE SWAG index] [Back to Main SWAG index] [Original]

    {I am having a bit of a problem in Pascal.  I am writing a routine to
    copy Files.  The Program is to be used in an area where anything at
    all can happen, so it has to be totally bullet-proof.  All is well,
    except one little thing.  Should the Program encounter a major disk
    error (for example, the user removes the disk While the copy is taking
    place), the Program breaks into Dos after an 'Abort, Retry, Fail'
    prompt.  Now comes the weird part.  This crash to Dos only occurs only
    once the Program terminates.  It processes the error perfectly, and only
    gives the error once my entire Program is at an end!  Following is the
    source code in question:
    }
    Program FileTest;

    Uses
      Dos;

    Procedure FileCopy(SrcPath, DstPath, FSpec : String; Var ExStat : Integer);
    Var
      DirInfo : SearchRec;
      Done    : Boolean;

    Procedure Process(X : String);
    Var
      Source,
      Dest     : File;
      Buffer   : Array[1..4096] of Byte;
      ReadCnt,
      WriteCnt : Word;

    begin
      {$I-}
      ExStat:=0;
      Assign(Source,SrcPath+X);
      Reset(Source,1);
      If IOResult <> 0 then
        ExStat := 1;
      If ExStat = 0 then
      begin
        Assign(Dest,DstPath+X);
        ReWrite(Dest,1);
        If IOResult <> 0 then
          ExStat := 2;
        If ExStat = 0 then
        begin
          Repeat
            BlockRead(Source,Buffer,Sizeof(Buffer),ReadCnt);
            BlockWrite(Dest,Buffer,ReadCnt,WriteCnt);
            If IOResult <> 0 then
              ExStat := 3;
          Until (ReadCnt = 0) or (WriteCnt <> ReadCnt) or (ExStat <> 0);
          Close(Dest);
        end;
        Close(Source);
      end;
      {$I+}
    end;

    begin
      {$I-}
        ExStat := 0;
        FindFirst(SrcPath + FSpec, Archive, DirInfo);
        Done := False;
        While Not Done do
        begin
          Write('Copying ',DirInfo.Name,' ');
          Process(DirInfo.Name);
          If (ExStat = 0) then
          begin
            FindNext(DirInfo);
            If (DosError<>0) then
              Done := True;
          end
          else
            Done := True;
        end;
      {$I+}
    end;

    Procedure Main;
    Var
      ExC : Integer;
    begin
      FileCopy('C:\Dos\','A:\','*.BAS',ExC);
      Writeln('Exit Code:',ExC);
    end;

    begin
      Main;
      Writeln('Program is Complete');
    end.
    {
    That's it.  All errors get logged normally, and right after 'Program is
    Complete', I get an 'Abort, Retry, Fail'.  It must be a File left open,
    and TP tries to close it once the Program terminates, but I can't
    imagine which File it might be!
    }

[Back to COPYMOVE SWAG index] [Back to Main SWAG index] [Original]