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

    { Here are programs for Copying and Deleting directories. }

    }

    {****************************************************************************}

    {                               Copy Directory                               }

    {****************************************************************************}
    {$S+}

    {for large directories alocate some mem true $M compiler directive}
    PROGRAM CopyDirectory;
    USES DOS,CRT;
    VAR DI: SearchRec;
        N1,WWW: string;

    Procedure Coppy(Source, Target : String);

    Var InFile, OutFile : File;
        Buffer          : Array[ 1..8192 ] Of Char;
        NumberRead,
        NumberWritten   : Word;
        Attr: Word;
        Time: LongInt;

    begin

       Assign( InFile, Source );
       Reset ( InFile, 1 );     {This is Reset For unTyped Files}
       Assign  ( OutFile, Target );
       ReWrite ( OutFile, 1 );  {This is ReWrite For unTyped Files}
       Repeat
          BlockRead ( InFile, Buffer, Sizeof( Buffer ), NumberRead );
          BlockWrite( OutFile, Buffer, NumberRead, NumberWritten );
       Until (NumberRead = 0) or (NumberRead <> NumberWritten);
       Close( InFile );
       Close( OutFile );
       Assign( InFile, Source);
       GetFAttr(InFile, Attr);
       GetFTime(InFile, Time);
       Assign( OutFile, Target);
       SetFAttr( OutFile, Attr);
       SetFTime( OutFile, Time);

    end;

    FUNCTION FileExist(FileName: String) : Boolean;
    VAR DirInfo: SearchRec;
    BEGIN
         FindFirst(FileName, AnyFile, DirInfo);
         IF (DosError=0) THEN FileExist:=True
                         ELSE FileExist:=False;
    END;

    PROCEDURE CopyDir(Name1,Name2 : String);
    VAR GR,GD: SearchRec;
        k,j: Integer;
    BEGIN
         k:=0;
         MkDir(Name2);
         Name2:=FExpand(Name2);
         ChDir(Name1);
         FindFirst('*.*',AnyFile,GR);
         WHILE DosError = 0 DO
         BEGIN
              IF GR.Attr AND Directory <> 0 THEN k:=k+1
              ELSE Coppy(Name1+'\'+GR.Name, Name2+'\'+GR.Name);
              FindNext(GR);
         END;
         IF k>2 THEN
         BEGIN
              FindFirst('*.*', AnyFile, GR);
              WHILE DosError = 0 DO
              BEGIN
                   j:=2;
                   REPEAT
                         IF (GR.Name <> '.') AND (GR.Name <> '..') THEN
                         IF GR.Attr AND Directory <> 0 THEN
                         CopyDir(Name1+'\'+GR.Name, Name2+'\'+GR.Name);
                         FindNext(GR);
                         j:=j+1;
                   UNTIL (j=k+1) OR (DosError <> 0);
              END;
         END;
    END;

    BEGIN
         WRITELN('                   CopyDir Version 1.0 by AMATRIX Software');
         Writeln;
         Writeln('     This is a freeware, you  can use it  and  distribute it as  you  wish.');
         Writeln('     CopyDir is part of Data Master Version 1.0 which is not yet releasted.');
         Writeln;
         Writeln('                            Programed by Kresimir Mihalj,  august, 1994.');
         Writeln('                            E-Mail:      piko@cromath.math.hr');
         Writeln;
         GetDir(0,www);
         www:=FExpand(www);
         IF (ParamStr(1)='/h') OR (ParamStr(1)='/H') THEN
         BEGIN
              Writeln('  USAGE:');
              Writeln;
              WRITELN('     You mut enter name of directory you copying and  name  of  nonexist');
              WRITELN('     directory where you copy.');
              Writeln('     Example:      CopyDir source target');
         END
         ELSE
         IF (ParamStr(1)='') OR (ParamStr(2)='') THEN
         BEGIN
              Writeln('  ERROR:');
              Writeln;
              WRITELN('     Enter /h switch for help.');
         END
         ELSE
         IF (ParamStr(1)<>'') AND ((ParamStr(1)<>'/h') OR (ParamStr(1)<>'/H')) AND (ParamStr(2)='') THEN
         BEGIN
              Writeln('  ERROR:');
              Writeln;
              WRITELN('     Enter /h switch for help.');
         END
         ELSE
         BEGIN
              IF FileExist(ParamStr(1)) THEN
              BEGIN
                   FindFirst(ParamStr(1), AnyFile, DI);
                   IF DI.Attr AND Directory <> 0 THEN
                   BEGIN
                        IF FileExist(ParamStr(2)) THEN
                        BEGIN
                             Writeln('  ERROR:');
                             WRITELN;
                             Writeln('     ',ParamStr(2),' already exist.');
                        END
                        ELSE
                        BEGIN
                              N1:=FExpand(ParamStr(1));
                              CopyDir(N1,ParamStr(2));
                        END;
                   END
                   ELSE
                   BEGIN
                        Writeln('  ERROR:');
                        Writeln;
                        Writeln('     ',ParamStr(1),' is not a directory')
                   END;
              END
              ELSE
              BEGIN
                   Writeln('  ERROR:');
                   Writeln;
                   Writeln('     ',ParamStr(1),' does not exist.');
              END;
         END;
         ChDir(www);
    END.

    {****************************************************************************}

    {                               Delete Directory                             }

    {****************************************************************************}

    PROGRAM DeleteDirectory;
    {for large directories alocate some mem true $M compiler directive}
    USES DOS,CRT;
    VAR DI: SearchRec;

    FUNCTION FileExist(FileName: String) : Boolean;
    VAR DirInfo: SearchRec;
    BEGIN
         FindFirst(FileName, AnyFile, DirInfo);
         IF (DosError=0) THEN FileExist:=True
                         ELSE FileExist:=False;
    END;

    PROCEDURE DelDir(Name: String);
    VAR k: Integer;
        DD: SearchRec;
        m,w: File;
        s: String;
    BEGIN
         REPEAT
               ChDir(Name);
               k:=0;
               FindFirst('*.*', AnyFile, DD);
               While DosError=0 Do
               BEGIN
                    IF DD.Attr AND ReadOnly <> 0 THEN
                    BEGIN
                         Assign(m, DD.Name);
                         SetFAttr(m, Archive);
                    END;
                    IF DD.Attr AND Hidden <> 0 THEN
                    BEGIN
                         Assign(m, DD.Name);
                         SetFAttr(m, Archive);
                    END;
                    IF DD.Attr AND SysFile <> 0 THEN
                    BEGIN
                         Assign(m, DD.Name);
                         SetFAttr(m, Archive);
                    END;
                    IF DD.Attr <> Directory THEN
                    BEGIN
                         Assign(m, DD.Name);
                         Rename(m, '$$$$$$$$.$$$');
                         REWRITE(m);
                         Close(m);
                         Erase(m);
                         Delay(100);
                    END;
                    FindNext(DD);
               END;
               FindFirst('*.*', AnyFile, DD);
               WHILE DosError = 0 DO
               BEGIN
                    IF (DD.Name <> '.') AND (DD.Name <> '..') THEN
                    BEGIN
                         IF DD.Attr AND Directory <> 0 THEN
                         BEGIN
                              DelDir(DD.Name);
                         END;
                    END;
                    FindNext(DD);
               END;
               FindFirst('*.*', AnyFile, DD);
               WHILE DosError = 0 DO
               BEGIN
                    FindNext(DD);
                    k:=k+1;
               END;
               IF k=2 THEN ChDir('..');
               RmDir(Name);
               GetDir(0, s);
         UNTIL (k=2);
    END;

    BEGIN
         WRITELN('                   DelDir Version 1.0 by AMATRIX Software');
         Writeln;
         Writeln('     This is a freeware, you  can use it  and  distribute it as you  wish.');
         Writeln('     DelDir is part of Data Master Version 1.0 which is not yet releasted.');
         Writeln;
         Writeln('                                WARNING !!!');
         Writeln('     DelDir erase & wipe ALL files in specified directory and all subdirs,');
         WRITELN('     no metter on attribute sets, so you cannot undelete erased files.');
         Writeln;
         Writeln('                            Programed by Kresimir Mihalj,  august, 1994.');
         Writeln('                            E-Mail:      piko@cromath.math.hr');
         Writeln;
         IF ParamStr(1)='' THEN
         BEGIN
              Writeln('  ERROR:');
              Writeln;
              Writeln('     Enter /h switch for help.');
         END
         ELSE
         IF (ParamStr(1)='.') OR (ParamStr(1)='..') THEN
         BEGIN
              Writeln('  ERROR:');
              Writeln;
              Writeln('     Cannot erase courent directory.');
         END
         ELSE
         IF (ParamStr(1)='/h') OR (ParamStr(1)='/H') THEN
         BEGIN
              Writeln('  USAGE: ');
              Writeln('     You must specify directory name which you wonna erase.');
              Writeln('     EXAMPLE:     DelDir batfiles');
         END
         ELSE
         IF FileExist(ParamStr(1)) THEN
         BEGIN
              FindFirst(ParamStr(1), AnyFile, DI);
              IF DI.Attr AND Directory <> 0 THEN DelDir(ParamStr(1)) ELSE
              BEGIN
                    Writeln('  ERROR:');
                    Writeln;
                    Writeln('     ',ParamStr(1),' is not a directory.')
              END;
         END
         ELSE WRITELN('     ',ParamStr(1),' does not exist.');
    END.

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