home *** CD-ROM | disk | FTP | other *** search
/ Bila Vrana / BILA_VRANA.iso / 005A / 4UTILS85.ZIP / 4FF.PAS < prev    next >
Pascal/Delphi Source File  |  1995-05-07  |  18KB  |  555 lines
  1. PROGRAM FileFind;
  2. {$A+,B-,D-,E-,F-,G+,I-,L+,N-,O-,R-,S-,V-,X-}
  3. {$M 16384,0,655360}
  4. (* ----------------------------------------------------------------------
  5.    A 4DOS-aware file finder. It searches in various archives too.
  6.  
  7.    (c) 1992, 1994 Copyright by David Frey,
  8.                                Urdorferstrasse 30
  9.                                8952 Schlieren ZH
  10.                                Switzerland
  11.  
  12.        Code created using Turbo Pascal 6.0 (c) Borland International 1990
  13.  
  14.    DISCLAIMER:   This program is freeware: you are allowed to use, copy
  15.                  and change it free of charge, but you may not sell or hire
  16.                  4FF. The copyright remains in my hands.
  17.  
  18.                  If you make any (considerable) changes to the source code,
  19.                  please let me know. (send me a copy or a listing).
  20.                  I would like to see what you have done.
  21.  
  22.                  I, David Frey, the author, provide absolutely no warranty of
  23.                  any kind. The user of this software takes the entire risk of
  24.                  damages, failures, data losses or other incidents.
  25.  
  26.    NOTES:        Turbo Pascal 6.0 required for compiling. (sorry, but I'm
  27.                  using FormatStr for output)
  28.  
  29.    ENHANCEMENTS: adapted to 4DOS 4.01 - when redirecting into files,
  30.                  full descriptions will be shown, otherwise the
  31.                  descriptions will be truncated at the right screen margin.
  32.  
  33.                  paging switch (/p) added.
  34.                  Fast screen output when no redirected output has been used.
  35.  
  36.                  Searches for Read Only / Hidden directories, too.
  37.  
  38.                  ARJ File scanning added.
  39.  
  40.                  Supports now 4DOS 5.0, i.e. 200 characters description
  41.                  length.
  42.  
  43.                  Old /d switch renamed to /f. /d stands now for description.
  44.    ----------------------------------------------------------------------- *)
  45.  
  46. USES {$IFOPT G+} Test286, {$ENDIF}
  47.      Fix, Crt, Dos, Objects, Memory, Drivers,
  48.      StringDateHandling, DisplayKeyboardAndCursor, DescriptionHandling,
  49.      HandleINIFile,
  50.      ScanLZHFiles, ScanZIPFiles, ScanARJFiles, Globals;
  51.  
  52. CONST Header= '4FF 4DOS File Find 1.85 -- (c) David Frey 1992, 1995';
  53.  
  54. VAR   ActDir, StartDir            : STRING;
  55.       FileSpecArray               : FileSpecArrayType;
  56.  
  57.       DescFile                    : TEXT;
  58.       DescLine                    : STRING;
  59.       DescLineNr                  : WORD;
  60.       Desc                        : DescStr;
  61.       DescStart                   : BYTE;
  62.       DescEnd                     : BYTE;
  63.       DescFound                   : BOOLEAN;
  64.  
  65.       i,l                         : WORD;
  66.       k                           : BYTE;
  67.       FileSpecs                   : BYTE;
  68.       ps,fs                       : STRING;
  69.       IORes                       : INTEGER;
  70.  
  71.       Templ                       : STRING;
  72.       FormatTemplate              : STRING;
  73.  
  74.       OldCtrlBreakHandler         : POINTER;
  75.       OldCtrlBreakState           : BOOLEAN;
  76.       BrokeOut                    : BOOLEAN;
  77.  
  78. PROCEDURE MyCtrlBreakHandler; FAR;
  79.  
  80. BEGIN
  81.  ExitProc := OldCtrlBreakHandler; SetCBreak(OldCtrlBreakState);
  82.  {$I-}
  83.  ChDir(ActDir); IORes := IOResult;
  84.  IF BrokeOut THEN
  85.   BEGIN
  86.    WriteLn(Output);
  87.    WriteLn(Output,' EXITING - User broke out of program.');
  88.    WriteLn(Output);
  89.   END;
  90.  Close(Output);
  91.  IF NOT Redirected THEN NormVideo;
  92. END;
  93.  
  94. PROCEDURE ShowFileData(Item: PFileData; VAR Path: PathStr);
  95.  
  96. VAR Index: INTEGER;
  97.     Date : DateStr;
  98.     Time : TimeStr;
  99.  
  100. BEGIN
  101.  IF BareOutput THEN
  102.   WriteLn(Output,Path,'\',Item^.Name)
  103.  ELSE
  104.   BEGIN
  105.    IF FileCount = 0 THEN
  106.     BEGIN
  107.      WriteLn(Output); IF DoPage THEN TestForMoreMsg;
  108.      WriteLn(Output,Path,'\'); IF DoPage THEN TestForMoreMsg;
  109.     END;
  110.  
  111.    InfoArray[0] := @Item^.Name;
  112.    InfoArray[1] := @Item^.Ext;
  113.    IF Item^.Attr AND Directory = Directory THEN SizeStr := '<DIR>'
  114.    ELSE
  115.     SizeStr := FormattedLongIntStr(Item^.Size,10);
  116.                                                   InfoArray[2] := @SizeStr;
  117.    Date := FormDate(Item^.DateRec);               InfoArray[3] := @Date;
  118.    Time := FormTime(Item^.DateRec);               InfoArray[4] := @Time;
  119.  
  120.    AttrStr := '....';
  121.    IF Item^.Attr AND ReadOnly = ReadOnly THEN AttrStr[1] := 'r';
  122.    IF Item^.Attr AND Hidden   = Hidden   THEN AttrStr[2] := 'h';
  123.    IF Item^.Attr AND SysFile  = SysFile  THEN AttrStr[3] := 's';
  124.    IF Item^.Attr AND Archive  = Archive  THEN AttrStr[4] := 'a';
  125.    InfoArray[5] := @AttrStr;
  126.  
  127.    InfoArray[6] := Item^.Desc;
  128.  
  129.    FormatStr(s,FormatTemplate,InfoArray);
  130.    WriteLn(Output,s); IF DoPage THEN TestForMoreMsg;
  131.  
  132.    INC(TotalSize,Item^.Size); INC(DirSize,Item^.Size);
  133.    INC(TotalFileCount); INC(FileCount);
  134.   END;
  135. END; (* ShowFileData *)
  136.  
  137. PROCEDURE BuildList(Dir: DirStr; VAR FileSpec: FileSpecArrayType; FileSpecs: BYTE;
  138.                     Attr: BYTE);
  139. (* The starting point, dir, includes the drive *)
  140.  
  141.  
  142. VAR Search: SearchRec;
  143.     DescFileExists: BOOLEAN;
  144.     DescFileList  : PFileList;
  145.     l,i,k         : BYTE;
  146.  
  147.     PROCEDURE ExamineFile(Item: POINTER); FAR;
  148.     (* Print the file data, if the Attributes match *)
  149.  
  150.     BEGIN
  151.      IF (((searchdesc = '') AND
  152.            (NOT ExactAttr  OR
  153.             (ExactAttr AND (PFileData(Item)^.Attr = Attr)))) OR
  154.         (Pos(searchdesc,PFileData(Item)^.Desc^) > 0)) THEN
  155.       ShowFileData(PFileData(Item),Dir);
  156.     END;
  157.  
  158. BEGIN (* BuildList *)
  159.  FileCount := 0; DirSize := 0;
  160.  Attr := Attr AND NOT Directory AND NOT VolumeId;
  161.  OldLHFileName := ''; OldZipFileName := '';
  162.  
  163.  s := Dir; l := Length(s);
  164.  IF (l>3) AND (s[l] = '\') THEN Delete(s,l,1);
  165.  
  166.  l := Length(Dir); IF (s[l] = '\') THEN Delete(Dir,l,1);
  167.  
  168.  {$I-}
  169.  ChDir(s); IORes := IOResult;
  170.  {$I+}
  171.  
  172.  FOR k := 1 TO FileSpecs DO
  173.   BEGIN
  174.    DescFileList := NIL; DescFileList := New(PFileList,Init(Dir,FileSpec[k],0));
  175.    IF DescFileList = NIL THEN Abort('Unable to allocate DescFileList');
  176.  
  177.    IF (FileList^.Status = ListTooManyFiles) OR
  178.       (FileList^.Status = ListOutofMem) THEN
  179.     BEGIN
  180.      IF FileList^.Status = ListTooManyFiles THEN
  181.       WriteLn('Warning! Too many files in directory, description file will be truncated!')
  182.      ELSE
  183.       WriteLn('Warning! Out of memory, description file will be truncated!');
  184.     END;
  185.  
  186.    IF DescLong THEN
  187.     WriteLn('Warning! Some descriptions are too long; they will be truncated.');
  188.  
  189.    DescFileList^.ForEach(@ExamineFile);
  190.    Dispose(DescFileList,Done);
  191.   END;
  192.  
  193.  IF ScanLZHArchives THEN
  194.   BEGIN
  195.    FindFirst('????????.LZH',ReadOnly+Archive,Search);
  196.    WHILE DosError = 0 DO
  197.     BEGIN
  198.      SearchInLZHFile(FileSpec,FileSpecs,Dir,Search);
  199.      FindNext(Search);
  200.     END;
  201.   END;
  202.  
  203.  IF ScanZIPArchives THEN
  204.   BEGIN
  205.    FindFirst('????????.ZIP',ReadOnly+Archive,Search);
  206.    WHILE DosError = 0 DO
  207.     BEGIN
  208.      SearchInZIPFile(FileSpec,FileSpecs,Dir,Search);
  209.      FindNext(Search);
  210.     END;
  211.   END;
  212.  
  213.  IF ScanARJArchives THEN
  214.   BEGIN
  215.    FindFirst('????????.ARJ',ReadOnly+Archive,Search);
  216.    WHILE DosError = 0 DO
  217.     BEGIN
  218.      SearchInARJFile(FileSpec,FileSpecs,Dir,Search);
  219.      FindNext(Search);
  220.     END;
  221.   END;
  222.  
  223.  IF NOT BareOutput AND (FileCount > 0) THEN
  224.   BEGIN
  225.    Templ := '%-4s entr';
  226.    IF FileCount = 1 THEN Templ := Templ + 'y,  '
  227.                     ELSE Templ := Templ + 'ies,';
  228.    Templ := Templ+' %10s Bytes';
  229.  
  230.    FileStr := FormattedIntStr(FileCount,4);    InfoArray[0] := @FileStr;
  231.    SizeStr := FormattedLongIntStr(DirSize,10); InfoArray[1] := @SizeStr;
  232.    FormatStr(s,Templ,InfoArray);
  233.    WriteLn(Output,s); IF DoPage THEN TestForMoreMsg;
  234.   END;
  235.  
  236.  FindFirst('????????.???',Directory+ReadOnly+Hidden+SysFile,Search);
  237.  WHILE DosError = 0 DO
  238.   BEGIN
  239.    IF (Search.Attr AND Directory = Directory) AND
  240.       (Search.Name <> '.') AND (Search.Name <> '..') THEN
  241.     BuildList(Dir+'\'+Search.Name+'\',FileSpec,FileSpecs,Attr);
  242.    FindNext(Search);
  243.   END;
  244.  {$I-}
  245.  ChDir('..'); IORes := IOResult;
  246.  {$I+}
  247. END; (* BuildList *)
  248.  
  249.  
  250. FUNCTION DriveValid(C: CHAR): BOOLEAN; ASSEMBLER;
  251. ASM
  252.   M