home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / HTMIX20.ZIP / FF.ZIP / TFF.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1992-07-12  |  9.2 KB  |  344 lines
  1. program TurboFileFind;
  2. {┌──────────────────────────────── INFO ────────────────────────────────────┐}
  3. {│ File    : TFF.PAS                                                        │}
  4. {│ Author  : Harald Thunem                                                  │}
  5. {│ Purpose : Another File Find clone.                                       │}
  6. {│ Updated : July 10 1992                                                   │}
  7. {└──────────────────────────────────────────────────────────────────────────┘}
  8.  
  9. {────────────────────────── Compiler directives ─────────────────────────────}
  10. {$A+   Word align data                                                       }
  11. {$B-   Short-circuit Boolean expression evaluation                           }
  12. {$E-   Disable linking with 8087-emulating run-time library                  }
  13. {$G+   Enable 80286 code generation                                          }
  14. {$R-   Disable generation of range-checking code                             }
  15. {$S-   Disable generation of stack-overflow checking code                    }
  16. {$V-   String variable checking                                              }
  17. {$X-   Disable Turbo Pascal's extended syntax                                }
  18. {$N+   80x87 code generation                                                 }
  19. {$D-   Disable generation of debug information                               }
  20. {────────────────────────────────────────────────────────────────────────────}
  21.  
  22. uses  Dos,
  23.       Crt,
  24.       Strings;
  25.  
  26. const StartNum    = 4;
  27.  
  28. var   DeleteList,
  29.       ScreenPause,
  30.       SaveList,
  31.       CopyList    : boolean;
  32.       MainDir,Dir : DirStr;
  33.       Name        : NameStr;
  34.       Ext         : ExtStr;
  35.       SearchFile,
  36.       SaveFilename: string;
  37.       TargetDrive : char;
  38.       NumItems    : word;
  39.       TotalSize   : longint;
  40.       f           : text;
  41.  
  42.  
  43. procedure ShowOptions;
  44. begin
  45.   WriteLn;
  46.   WriteLn('Program : TFF  --  Turbo File Finder');
  47.   WriteLn('Author  : Harald Thunem');
  48.   WriteLn('Purpose : Find files and optionally copy or erase them');
  49.   WriteLn('Updated : July 10 1992');
  50.   WriteLn;
  51.   WriteLn('Usage   : TFF [D:]SearchFile [/h /? /p /d /cDrive /fSavefile');
  52.   WriteLn;
  53.   WriteLn('          SearchFile may contain wildcards ("*.pas","nu*.?xe")');
  54.   WriteLn('          /h,/? - Shows this help');
  55.   WriteLn('          /p    - Pause for each screen');
  56.   WriteLn('          /d    - Delete all found files');
  57.   WriteLn('          /c    - Copy files to Drive');
  58.   WriteLn('          /f    - Save search info to file Savefile');
  59.   WriteLn;
  60.   WriteLn('Returns : Directory             Name  Size  Date  [Co  Er  XX  YY]');
  61.   WriteLn('          Directory - Where the file was found');
  62.   WriteLn('          Name      - File name');
  63.   WriteLn('          Size      - File size');
  64.   WriteLn('          Date      - File date');
  65.   WriteLn('          Co        - If file was copied successfully');
  66.   WriteLn('          XX        - If file was not copied');
  67.   WriteLn('          Er        - If file was erased successfully');
  68.   WriteLn('          YY        - If file was not erased');
  69.   Halt(1);
  70. end;
  71.  
  72.  
  73. procedure GetCommands;
  74. var i: byte;
  75.     s: string;
  76.     s2: string[2];
  77. begin
  78.   CopyList := false;
  79.   SaveList := false;
  80.   DeleteList := false;
  81.   ScreenPause := false;
  82.   SearchFile := '';
  83.   SaveFilename := '';
  84.   TargetDrive := 'C';
  85.   SearchFile := '*.*';
  86.   GetDir(0,MainDir);
  87.   MainDir := Copy(MainDir,1,2);
  88.   if ParamCount=0 then
  89.     ShowOptions;
  90.   if ParamCount>0 then
  91.   for i := 1 to ParamCount do
  92.   begin
  93.     s := UpcaseStr(ParamStr(i));
  94.     s2 := Copy(s,1,2);
  95.     if (s='/?') or (s='/H') then ShowOptions
  96.     else if s='/D' then DeleteList:=true
  97.     else if s='/P' then ScreenPause:=true
  98.     else if s2='/F' then
  99.     begin
  100.       SaveList := true;
  101.       SaveFilename := Copy(s,3,Length(s)-2);
  102.       if SaveFilename = '' then
  103.         SaveList := false;
  104.     end
  105.     else if s2='/C' then
  106.     begin
  107.       CopyList := true;
  108.       TargetDrive := s[3];
  109.     end
  110.     else SearchFile := s;
  111.   end;
  112.   if Pos(':',SearchFile)>0 then
  113.   begin
  114.     MainDir := SearchFile[1]+':';
  115.     Delete(SearchFile,1,2);
  116.   end;
  117.   if SearchFile[1]='\' then Delete(SearchFile,1,1);
  118. end;
  119.  
  120.  
  121. function AddDots(s: string): string;
  122. begin
  123.   if Length(s)>3 then
  124.     Insert('.',s,Length(s)-2);
  125.   if Length(s)>7 then
  126.     Insert('.',s,Length(s)-6);
  127.   AddDots := s;
  128. end;
  129.  
  130.  
  131. function DateStr(Time: longint): string;
  132. var DT: DateTime;
  133.     s1,s2: string;
  134. begin
  135.   s1 := '';
  136.   s2 := '';
  137.   UnpackTime(Time,DT);
  138.   s1 := StrL(DT.Month);
  139.   if Length(s1)=1 then s1:='0'+s1;
  140.   s2 := StrL(Dt.Day);
  141.   if Length(s2)=1 then s2:='0'+s2;
  142.   s1 := s1 + '.' + s2;
  143.   s2 := StrL(Dt.Year);
  144.   s1 := s1 + '.' + s2;
  145.   DateStr := s1;
  146. end;
  147.  
  148.  
  149. procedure QuitProgram;
  150. begin
  151.   GoToXY(1,WhereY);
  152.   ClrEol;
  153.   WriteLn('─────────────────────────────────────────────────────────────────────────');
  154.   WriteLn(NumItems-StartNum,' matches found, occupying ',AddDots(StrL(TotalSize)),' bytes');
  155.   if SaveList then
  156.   begin
  157.     WriteLn(f);
  158.     WriteLn(f,'─────────────────────────────────────────────────────────────────────────');
  159.     WriteLn(f,NumItems-StartNum,' matches found, occupying ',AddDots(StrL(TotalSize)),' bytes');
  160.     Close(f);
  161.   end;
  162.   Halt(1);
  163. end;
  164.  
  165.  
  166. function DeleteFile(Name: PathStr): boolean;
  167. var DF: file;
  168.     B : boolean;
  169. begin
  170.   {$I-}
  171.   Assign(DF,Name);
  172.   Reset(DF);
  173.   {$I+}
  174.   B := IOResult=0;
  175.   if B then
  176.   begin
  177.     Close(DF);
  178.     Erase(DF);
  179.   end;
  180.   DeleteFile := B;
  181. end;
  182.  
  183.  
  184. function CopyFile(FromName: PathStr; Size: longint; TargetDrive: char): boolean;
  185. var FromF,ToF : file;
  186.     ToName    : PathStr;
  187.     NumRead,
  188.     NumWritten: word;
  189.     Buffer    : array[1..2048] of char;
  190.     DriveSize : longint;
  191.     DriveNum  : byte;
  192.     CopyOK    : boolean;
  193. begin
  194.   DriveNum := Ord(TargetDrive)-64;
  195.   DriveSize := DiskSize(DriveNum);
  196.   if DriveSize<Size then
  197.   begin
  198.     CopyFile := false;
  199.     Exit;
  200.   end;
  201.   FSplit(FromName,Dir,Name,Ext);
  202.   ToName := TargetDrive+':\'+Name+Ext;
  203.   {$I-}
  204.   Assign(FromF,FromName);
  205.   Reset(FromF,1);
  206.   {$I+}
  207.   CopyOK := IOResult=0;
  208.   if CopyOK then
  209.   begin
  210.     Assign(ToF,ToName);
  211.     ReWrite(ToF,1);
  212.     repeat
  213.       BlockRead(FromF,Buffer,
  214.                 SizeOf(Buffer),NumRead);
  215.       BlockWrite(ToF,Buffer,NumRead,NumWritten);
  216.     until (NumRead = 0) or
  217.           (NumWritten <> NumRead);
  218.     Close(FromF);
  219.     Close(ToF);
  220.   end;
  221.   CopyFile := CopyOK;
  222. end;
  223.  
  224.  
  225. procedure ProceedItem(MainDir: DirStr;  S: SearchRec);
  226. var s1,s2: string;
  227.     Ch : char;
  228.     CopyOK: boolean;
  229. begin
  230.   { Write directory }
  231.   if S.Attr and Directory=Directory then
  232.   begin
  233.     GoToXY(1,WhereY);
  234.     ClrEol;
  235.     Write(MainDir+S.Name);
  236.     Exit;
  237.   end;
  238.  
  239.   { Write files }
  240.   Inc(NumItems);
  241.   TotalSize := TotalSize + S.Size;
  242.   FSplit(S.Name,Dir,Name,Ext);
  243.   while Length(Name)<8 do
  244.     Name := Name+' ';
  245.   while Length(Ext)<4 do
  246.     Ext := Ext+' ';
  247.   s1 := Name+Ext;
  248.  
  249.   s2 := StrL(S.Size);
  250.   s2 := AddDots(s2);
  251.   while Length(s2)<11 do
  252.     s2 := ' '+s2;
  253.   s1 := s1 + s2;
  254.   s2 := ' '+DateStr(S.Time);
  255.   s1 := s1 + s2;
  256.  
  257.   CopyOK := true;
  258.   if CopyList then
  259.   if CopyFile(MainDir+S.Name,S.Size,TargetDrive) then
  260.     s1 := s1 + ' Co'
  261.   else begin
  262.     s1 := s1 + ' YY';
  263.     CopyOK := false;
  264.   end;
  265.  
  266.   if DeleteList then
  267.   if CopyOK then
  268.     if DeleteFile(MainDir+S.Name) then
  269.       s1 := s1 + ' Er'
  270.     else s1 := s1 + ' XX';
  271.  
  272.   GoToXY(40,WhereY);
  273.   WriteLn(s1);
  274.   if SaveList then
  275.   begin
  276.     while Length(s1)<76 do
  277.       s1 := ' '+s1;
  278.       Delete(s1,1,Length(MainDir));
  279.       s1 := MainDir+s1;
  280.     WriteLn(f,s1);
  281.   end;
  282.   if NumItems mod 24 = 0 then
  283.   if ScreenPause then
  284.   begin
  285.     Write('Press any key...[Esc to quit]');
  286.     Ch := ReadKey;
  287.     GoToXY(1,WhereY);
  288.     ClrEol;
  289.     if Ch=#27 then QuitProgram;
  290.   end;
  291. end;
  292.  
  293.  
  294. procedure Search(MainDir: DirStr;  SearchFile: string);
  295. var S: SearchRec;
  296.     Attr: byte;
  297.     FoundFile: boolean;
  298. begin
  299.   FoundFile := false;
  300.   MainDir := MainDir + '\';
  301.  
  302.   { Search for files }
  303.   Attr := Hidden+SysFile+ReadOnly+Archive;
  304.   FindFirst(MainDir+SearchFile,Attr,S);
  305.   while DosError = 0 do
  306.   begin
  307.     ProceedItem(MainDir,S);
  308.     FindNext(S);
  309.   end;
  310.  
  311.   { Search for sub-directories }
  312.   Attr := Directory;
  313.   FindFirst(MainDir+'*.*',Attr,S);
  314.   while DosError = 0 do
  315.   begin
  316.     if (S.Attr and Attr <>0) and (S.Name[1]<>'.') and (S.Name[1]<>'..') then
  317.     begin
  318.       ProceedItem(MainDir,S);
  319.       Search(MainDir+S.Name,SearchFile);
  320.     end;
  321.     FindNext(S);
  322.   end;
  323. end;
  324.  
  325.  
  326. begin
  327.   NumItems := StartNum;
  328.   TotalSize := 0;
  329.   WriteLn('TFF 2.0                                                      Written by H.Thunem');
  330.   GetCommands;
  331.   WriteLn('Directory                                  File           Size       Date');
  332.   WriteLn('─────────────────────────────────────────────────────────────────────────');
  333.   if SaveList then
  334.   begin
  335.     Assign(f,SaveFilename);
  336.     ReWrite(f);
  337.     WriteLn(f,'TFF 2.0                                                      Written by H.Thunem');
  338.     WriteLn(f,'Directory                                  File           Size       Date');
  339.     WriteLn(f,'─────────────────────────────────────────────────────────────────────────');
  340.   end;
  341.   Search(MainDir,SearchFile);
  342.   QuitProgram;
  343. end.
  344.