home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / PASCAL / PARADIS1 / FINDFILE.PAS < prev    next >
Pascal/Delphi Source File  |  1992-02-26  |  4KB  |  139 lines
  1. (7477)  Sat 22 Feb 92  0:43
  2. By: Joy Mukherjee
  3. To: Todd Zabel
  4. Re: Finding A file
  5. St:
  6. ---------------------------------------------------------------------------
  7. @MSGID: 1:387/255 56b870b5
  8. TZ>I am fairly new to TP and would like to develope a procedure that will
  9. TZ>scan an entire drive for a file (something like NU Find File).
  10.  
  11. Program FindFile;
  12. { ========================================================================= }
  13. {                                                                           }
  14. { DESCRIPTION: This program locates all files matching FILENAME on the      }
  15. {              current drive. It is a modification of the REDFIL.PAS        }
  16. {              program written by James C. Walker (found on CompuServe      }
  17. {              BPROGA TP4 library). Thank you Mr. Walker.                   }
  18. {                                                                           }
  19. {      SYNTAX: FindFile FILENAME                                            }
  20. {              (note that FILENAME may include DOS wildcards * and ?)       }
  21. {                                                                           }
  22. {     HISTORY: 06/30/1988 Written by Paul L. Randall                        }
  23. {                                                                           }
  24. { ========================================================================= }
  25.  
  26. Uses
  27.   Crt, Dos;
  28. type
  29.   Str4 = string[4];
  30.   Str8 = string[8];
  31. Var
  32.   SearchDir    : String;
  33.   Found        : boolean;
  34.   CompareFiles : boolean;
  35.   LocateFile   : string;
  36.   Row          : byte;
  37.   DateTimeRec  : DateTime;
  38.  
  39. Function GetFileDate(Year  : word;
  40.                      Month : word;
  41.                      Day   : word) : Str8;
  42. var
  43.   Temp1    : string[2];
  44.   Temp2    : string[2];
  45.   Temp3    : string[4];
  46.  
  47. begin { GetFileDate }
  48.   Str(Month:2,Temp1);
  49.   Str(Day:2,Temp2);
  50.   if Temp2[1] = ' ' then Temp2[1] := '0';
  51.   Str(Year:4,Temp3);
  52.   GetFileDate := Temp1 + '-' + Temp2 + '-' + Copy(Temp3,3,2)
  53. end;  { GetFileDate }
  54.  
  55. Function GetFileAttr(var SRec : SearchRec) : Str4;
  56.   begin { GetFileAttr }
  57.     GetFileAttr := '    ';
  58.     with SRec do
  59.     begin
  60.       if Attr and ReadOnly = ReadOnly then
  61.         GetFileAttr[1] := 'R';
  62.       if Attr and Hidden = Hidden then
  63.         GetFileAttr[2] := 'H';
  64.       if Attr and SysFile = SysFile then
  65.         GetFileAttr[3] := 'S';
  66.       if Attr and Archive = Archive then
  67.         GetFileAttr[4] := 'A'
  68.     end
  69.   end;  { GetFileAttr }
  70.  
  71. Procedure ReadFiles(Dir : String);
  72.  Var
  73.     ch       : char;
  74.     FileInfo : SearchRec;
  75.  
  76.  begin
  77.    if CompareFiles then
  78.    begin
  79.      FindFirst(Dir + LocateFile,AnyFile,FileInfo);
  80.      While DosError = 0 do
  81.      begin
  82.        Found := TRUE;
  83.        UnPackTime(FileInfo.Time,DateTimeRec);
  84.        with DateTimeRec do
  85.          Writeln('Name : ', Dir + FileInfo.Name,
  86.                  '':(46 - (Length(FileInfo.Name) + Length(Dir))),
  87.                  ' Date: ',GetFileDate(Year,Month,Day),
  88.                  ' Attr: ', GetFileAttr(FileInfo));
  89.        Row := Row + 1;
  90.        if Row = 25 then
  91.        begin
  92.          Write('Press any key to continue . . . ');
  93.          Repeat until KeyPressed;
  94.          Ch := ReadKey;
  95.          WriteLn;
  96.          Row := 1
  97.        end;
  98.        FindNext(FileInfo)
  99.      end;
  100.      CompareFiles := FALSE
  101.    end;
  102.    FindFirst(Dir + '*.*', AnyFile, FileInfo);
  103.    While DosError = 0 do
  104.    begin
  105.      If (FileInfo.Attr = Directory) and
  106.         (FileInfo.Name <> '.') and
  107.         (FileInfo.Name <> '..') then
  108.      begin
  109.        CompareFiles := TRUE;
  110.        ReadFiles(Dir + FileInfo.Name + '\');
  111.        Writeln (FileInfo.Name);
  112.      end;
  113.      FindNext(FileInfo)
  114.    end
  115.  end;
  116.  
  117. begin
  118.   if ParamCount <> 0 then
  119.   begin
  120.     Row := 1;
  121.     Found := FALSE;
  122.     LocateFile := ParamStr(1);
  123.     SearchDir := '\';
  124.     CompareFiles := TRUE;
  125.     ReadFiles(SearchDir);
  126.     if not Found then WriteLn('No such file !')
  127.   end else WriteLn('FINDFILE correct syntax is:  FINDFILE FILENAME')
  128. end.
  129.  
  130. Hope it helps...
  131.  
  132.  
  133.  * SLMR 2.1a # * Read Error : go back to school!
  134.  
  135. --- MsgToss 2.0  (r)
  136.  * Origin: Nul 512-615-NUL1 HST/V32b,615-NUL2, NUL3, 1.2Gig (1:387/255)
  137.  
  138. @PATH: 387/255 823 170/400 512/0 1007 
  139.