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

    {
    MULTI COPY

    This program will copy multiple files to a specified area. I
    hope that this shit works too.

    This program cannot copy files to a single file nor can it be
    expected to know the difference between a file and a directory;

    Therefore you must append a back-slash if copying
    into a directory.

    Example: To Copy COMMAND.COM into C:\tp7\code\work

    You'd use MCOPY COMMAND.COM C:\tp7\code\work\
    }

    Program Mcopy;

    Uses dos;

    {$R+}

    Procedure Usage;
    Begin
         Writeln;
         Writeln('Multiple File Copier  (C) 1995 Scott Tunstall. ');
         Writeln;
         Writeln('Usage :');
         Writeln;
         Writeln('MCOPY <FileSpec1> [..FileSpec2] [..FileSpec3 etc.]  <DestSpec>');
         Writeln;
         Writeln;
         Writeln('You can copy as many different types of file in one go as can');
         Writeln('fit on one line just as long as you specify a destination, ');
         Writeln('which must ALWAYS be the last parameter.');
         Writeln;
         Writeln('Also, make sure that if you are copying to a directory that a "\"');
         Writeln('is appended to the directory name otherwise the copy will FAIL !.');
         Writeln;
         Writeln('Example: C:\WORK should be C:\WORK\ with this program.');
         Writeln;
    End;

    Procedure Error;
    Begin
         Writeln;
         Writeln('You need to specify at least two parameters, a source and a');
         Writeln('destination! ');
         Writeln;
         Writeln('Type MCOPY ? for help.');
         Writeln;
    End;

    Function CopyFile(SourceFile, TargetFile : String): Byte;
    { Return codes:  0 successful
                     1 source and target the same
                     2 cannot open source
                     3 unable to create target
                     4 error during copy
    }
    Var
      Source,
      Target  : File;
      BRead,
      BWrite  : Word;
      FileBuf : Array[1..2048] of Char;
    begin
      If SourceFile = TargetFile then
      begin
        CopyFile := 1;
        Exit;
      end;

      Assign(Source,SourceFile);
      {$I-}
      Reset(Source,1);
      {$I+}
      If IOResult <> 0 then
      begin
        CopyFile := 2;
        Exit;
      end;

      Assign(Target,TargetFile);
      {$I-}
      ReWrite(Target,1);
      {$I+}
      If IOResult <> 0 then
      begin
        CopyFile := 3;
        Exit;
      end;

      Repeat
        BlockRead(Source,FileBuf,SizeOf(FileBuf),BRead);
        BlockWrite(Target,FileBuf,Bread,BWrite);
      Until (Bread = 0) or (Bread <> BWrite);
      Close(Source);
      Close(Target);
      If Bread <> BWrite then
        CopyFile := 4
      else
        CopyFile := 0;
    end; {of func CopyFile}

    Procedure BeginCopying;
    Var DestinationSpec: PathStr;
        SourceCount: byte;
        SourceFileSpec: PathStr;
        SearchRecord: SearchRec;
        Errorcode: byte;

    Begin
         DestinationSpec:=ParamStr(ParamCount);

         For SourceCount:=1 to ParamCount-1 do
             Begin
             SourceFileSpec:=ParamStr(SourceCount);
             FindFirst(SourceFileSpec,$27,SearchRecord);

             If DosError <>0 Then
                Begin
                Writeln;
                Writeln('Cannot open source file(s) !');
                Writeln;
                End
             Else
                 Begin
                 Repeat
                       Write(SearchRecord.Name,'..');
                       ErrorCode:=CopyFile(SearchRecord.Name,DestinationSpec+SearchRecord.Name);

                       If ErrorCode<>0 Then
                          Begin
                          Write('Error (',ErrorCode,') : ');
                          Case ErrorCode Of
                          1: Writeln('Source and destination are the same !');
                          2: Writeln('Cannot open source file(s) !');
                          3: Writeln('Unable to create destination file(s) !');
                          4: Writeln('Copying error. Check disk integrities !');
                          End;
                          End
                       Else
                           Writeln('copied.');

                       FindNext(SearchRecord);

                 Until DosError <>0;

                 Writeln;
                 Writeln('Operation Complete. ');
                 Writeln;
                 End;
         End;
    End;

    Begin
         If ParamStr(1)='?' Then
            Usage
         Else
             If ParamCount <2 Then
                Error
             Else
                 BeginCopying;
    End.

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