home *** CD-ROM | disk | FTP | other *** search
/ Media Share 9 / MEDIASHARE_09.ISO / 4dos / 4utils.zip / 4FF.PAS < prev    next >
Pascal/Delphi Source File  |  1993-10-31  |  15KB  |  440 lines
  1. PROGRAM FileFind;
  2. {$A+,B-,D-,E-,F-,G+,I-,L+,N-,O-,R-,S-,V-,X-}
  3. {$M 16384,0,65530}
  4. (* ----------------------------------------------------------------------
  5.    A 4DOS-aware file finder. It searches in .LZH archives too.
  6.  
  7.    (c) 1992, 1993 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.    ----------------------------------------------------------------------- *)
  41.  
  42. USES {$IFOPT G+} Test286, {$ENDIF}
  43.      Objects, Drivers,
  44.      Crt, Dos, StringDateHandling, HandleINIFile,
  45.      ScanLZHFiles, ScanZIPFiles, ScanARJFiles, Globals;
  46.  
  47. CONST Header= '4FF 4DOS File Find 1.7 -- (c) David Frey 1992, 1993';
  48.  
  49. VAR   DescBuffer: ARRAY[0..512] OF CHAR;
  50.  
  51. VAR   ActDir, StartDir            : STRING;
  52.  
  53.       DescArray                   : DescArrayType;
  54.       FileSpecArray               : FileSpecArrayType;
  55.  
  56.       DescFile                    : TEXT;
  57.       DescLine                    : STRING;
  58.       DescLineNr                  : WORD;
  59.       Desc                        : DescStr;
  60.       DescStart                   : BYTE;
  61.       DescEnd                     : BYTE;
  62.       DescFound                   : BOOLEAN;
  63.  
  64.       i,l                         : WORD;
  65.       k                           : BYTE;
  66.       FileSpecs                   : BYTE;
  67.       ps,fs                       : STRING;
  68.       IORes                       : INTEGER;
  69.  
  70.       Templ                       : STRING;
  71.  
  72.       OldCtrlBreakHandler         : POINTER;
  73.       OldCtrlBreakState           : BOOLEAN;
  74.       BrokeOut                    : BOOLEAN;
  75.  
  76. PROCEDURE MyCtrlBreakHandler; FAR;
  77.  
  78. BEGIN
  79.  ExitProc := OldCtrlBreakHandler; SetCBreak(OldCtrlBreakState);
  80.  {$I-}
  81.  ChDir(ActDir); IORes := IOResult;
  82.  IF BrokeOut THEN
  83.   BEGIN
  84.    WriteLn(Output);
  85.    WriteLn(Output,' EXITING - User broke out of program.');
  86.    WriteLn(Output);
  87.   END;
  88.  Close(Output);
  89.  IF NOT Redirected THEN NormVideo;
  90. END;
  91.  
  92. PROCEDURE ShowFileData(VAR search: SearchRec;VAR Path: PathStr;VAR Desc: DescStr);
  93.  
  94. VAR i       : INTEGER;
  95.  
  96. BEGIN
  97.  IF BareOutput THEN
  98.   Write(Output,Path,Search.Name,' ')
  99.  ELSE
  100.   BEGIN
  101.    IF FileCount = 0 THEN
  102.     BEGIN
  103.      WriteLn(Output); IF DoPage THEN TestForMoreMsg;
  104.      WriteLn(Output,Path); IF DoPage THEN TestForMoreMsg;
  105.     END;
  106.  
  107.    InfoArray[0] := LONGINT(@search.Name);
  108.  
  109.    SizeStr := FormattedLongIntStr(search.Size,7);
  110.    InfoArray[1] := LONGINT(@SizeStr);
  111.  
  112.    UnpackTime(search.Time,DateRec);
  113.    Date := FormDate(DateRec); Time := FormTime(DateRec);
  114.    InfoArray[2] := LONGINT(@Date);
  115.    InfoArray[3] := LONGINT(@Time);
  116.  
  117.    AttrStr := '....';
  118.    IF search.Attr AND ReadOnly = ReadOnly THEN AttrStr[1] := 'r';
  119.    IF search.Attr AND Hidden   = Hidden   THEN AttrStr[2] := 'h';
  120.    IF search.Attr AND SysFile  = SysFile  THEN AttrStr[3] := 's';
  121.    IF search.Attr AND Archive  = Archive  THEN AttrStr[4] := 'a';
  122.    InfoArray[4] := LONGINT(@AttrStr);
  123.    InfoArray[5] := LONGINT(@Desc);
  124.  
  125.    FormatStr(s,'%-12s    %8s '+DateTempl+' '+TimeTempl+' %4s '+DescTempl,InfoArray);
  126.    WriteLn(Output,s); IF DoPage THEN TestForMoreMsg;
  127.  
  128.    INC(TotalSize,Search.Size); INC(DirSize,Search.Size);
  129.    INC(TotalFileCount); INC(FileCount);
  130.   END;
  131. END; (* ShowFileData *)
  132.  
  133. PROCEDURE BuildList(Dir: DirStr; VAR FileSpec: FileSpecArrayType; FileSpecs: BYTE;
  134.                     Attr: BYTE);
  135.  
  136. VAR Search: SearchRec;
  137.     DescFileExists: BOOLEAN;
  138.     l,i,k         : BYTE;
  139.  
  140. BEGIN (* BuildList *)
  141.  FileCount := 0; DirSize := 0;
  142.  Attr := Attr AND NOT Directory AND NOT VolumeId;
  143.  OldLHFileName := ''; OldZipFileName := '';
  144.  
  145.  l := Length(Dir); s := Dir;
  146.  IF (l>3) AND (s[l] = '\') THEN Delete(s,l,1);
  147.  ChDir(s);
  148.  
  149.  {$I-}
  150.  Assign(DescFile,'DESCRIPT.ION'); SetTextBuf(DescFile,DescBuffer);
  151.  Reset(DescFile);
  152.  DescFileExists := (IOResult = 0);
  153.  IF DescFileExists THEN
  154.   BEGIN
  155.    DescLineNr := 1;
  156.    WHILE NOT Eof(DescFile) AND (DescLineNr <= MaxComments) DO
  157.     BEGIN
  158.      ReadLn(DescFile,DescLine); DescStart := Pos(' ',DescLine);
  159.      DescEnd := Pos(#4,DescLine); IF DescEnd = 0 THEN DescEnd := Length(DescLine)+1;
  160.      Desc := Copy(DescLine,DescStart+1,DescEnd-1);
  161.      StripLeadingSpaces(Desc);
  162.      i := 1; l := Length(DescLine);
  163.      REPEAT
  164.       IF (DescLine[i] >= 'A') AND (DescLine[i] <= 'Z') THEN
  165.        BEGIN DescLine[i] := Char(Ord(DescLine[i])+32); END;
  166.       INC(i);
  167.      UNTIL (i=l) OR (DescLine[i] = ' ');
  168.      DescArray[DescLineNr] := DescLine; INC(DescLineNr);
  169.     END;
  170.    DEC(DescLineNr);
  171.    IF DescLineNr = MaxComments THEN
  172.     BEGIN
  173.      WriteLn(Output); IF DoPage THEN TestForMoreMsg;
  174.      WriteLn(Output,'WARNING: description line buffer full, some comments may not appear.'); IF DoPage THEN TestForMoreMsg;
  175.      WriteLn(Output); IF DoPage THEN TestForMoreMsg;
  176.     END;
  177.    {$I-}
  178.    Close(DescFile); IORes := IOResult;
  179.   END;
  180.  
  181.  IF DoScanLZHArchives THEN
  182.   BEGIN
  183.    FindFirst('????????.LZH',ReadOnly+Archive,Search);
  184.    WHILE DosError = 0 DO
  185.     BEGIN
  186.      SearchInLZHFile(FileSpec,FileSpecs,Dir,Search);
  187.      FindNext(Search);
  188.     END;
  189.   END;
  190.  IF DoScanZIPArchives THEN
  191.   BEGIN
  192.    FindFirst('????????.ZIP',ReadOnly+Archive,Search);
  193.    WHILE DosError = 0 DO
  194.     BEGIN
  195.      SearchInZIPFile(FileSpec,FileSpecs,Dir,Search);
  196.      FindNext(Search);
  197.     END;
  198.   END;
  199.  IF DoScanARJArchives THEN
  200.   BEGIN
  201.    FindFirst('????????.ARJ',ReadOnly+Archive,Search);
  202.    WHILE DosError = 0 DO
  203.     BEGIN
  204.      SearchInARJFile(FileSpec,FileSpecs,Dir,Search);
  205.      FindNext(Search);
  206.     END;
  207.   END;
  208.  
  209.  FOR k := 1 TO FileSpecs DO
  210.   BEGIN
  211.    FindFirst(FileSpec[k], Attr, Search);
  212.    WHILE DosError = 0 DO
  213.     BEGIN
  214.      IF NOT ExactAttr OR (ExactAttr AND (Search.Attr = Attr)) THEN
  215.       BEGIN
  216.        DownString(Search.Name);
  217.        Desc := '';
  218.        IF (NOT DescFileExists OR (Search.Name = 'descript.ion')) THEN
  219.         ShowFileData(search,Dir,Desc)
  220.        ELSE
  221.         BEGIN
  222.          i := 1;
  223.          REPEAT
  224.           DescStart := Pos(' ',DescArray[i]);
  225.           DescFound := (Copy(DescArray[i],1,DescStart-1) = Search.Name);
  226.           IF NOT DescFound THEN INC(i);
  227.          UNTIL  DescFound OR (i>DescLineNr);
  228.          IF NOT DescFound THEN Desc := ''
  229.                           ELSE Desc := Copy(DescArray[i],DescStart+1,255);
  230.          ShowFileData(search,Dir,Desc);
  231.         END;
  232.       END;
  233.      FindNext(Search);
  234.     END;
  235.   END;
  236.  
  237.  IF NOT BareOutput AND (FileCount > 0) THEN
  238.   BEGIN
  239.    Templ := '%-4s entr';
  240.    IF FileCount = 1 THEN Templ := Templ + 'y,  '
  241.                     ELSE Templ := Templ + 'ies,';
  242.    Templ := Templ+' %10s Bytes';
  243.  
  244.    FileStr := FormattedIntStr(FileCount,4);  InfoArray[0] := LONGINT(@FileStr);
  245.    SizeStr := FormattedLongIntStr(DirSize,10);InfoArray[1] := LONGINT(@SizeStr);
  246.    FormatStr(s,Templ,InfoArray);
  247.    WriteLn(Output,s); IF DoPage THEN TestForMoreMsg;
  248.   END;
  249.  
  250.  FindFirst('????????. ',Directory+ReadOnly+Hidden,Search);
  251.  WHILE DosError = 0 DO
  252.   BEGIN
  253.    IF (Search.Attr = Directory) AND
  254.       (Search.Name <> '.') AND (Search.Name <> '..') THEN
  255.     BuildList(Dir+Search.Name+'\',FileSpec,FileSpecs,Attr);
  256.    FindNext(Search);
  257.   END;
  258.  {$I-}
  259.  ChDir('..'); IORes := IOResult;
  260. END; (* BuildList *)
  261.  
  262.  
  263. FUNCTION DriveValid(C: CHAR): BOOLEAN; ASSEMBLER;
  264. ASM
  265.   MOV   DL,C
  266.   MOV   AH,36H
  267.   SUB   DL,'A'-1
  268.   Int   21H
  269.   INC   AX
  270.   JE    @@2
  271. @@1:
  272.   MOV   AL,1
  273. @@2:
  274. END; (* DriveValid *)
  275.  
  276. PROCEDURE GiveHelp;
  277.  
  278. BEGIN
  279.  WriteLn(Output);
  280.  WriteLn(Output,Header);
  281.  WriteLn(Output);
  282.  WriteLn(Output,'This program is freeware: you are allowed to use, copy it free');
  283.  WriteLn(Output,'of charge, but you may not sell or hire 4FF.');
  284.  WriteLn(Output);
  285.  WriteLn(Output,'usage: 4FF [/a:[-]rash][/l][/z][/s][/b][/d][/m:nn][/?] [start dir\]{filenames}');
  286.  WriteLn(Output);
  287.  WriteLn(Output,' /a:rash search for files with these attributes set.');
  288.  WriteLn(Output,' /l      do not search in .lzh archive files.');
  289.  WriteLn(Output,' /z      do not search in .zip archive files.');
  290.  WriteLn(Output,' /j      do not search in .arj archive files.');
  291.  WriteLn(Output,' /s      scan only subdirectories of given path `start-dir''');
  292.  WriteLn(Output,' /b      bare listing (omits size, date, and descriptions)');
  293.  WriteLn(Output,' /d      scan all hard disks (address floppy drives explicitely)');
  294.  WriteLn(Output,' /m:nn   set right margin to nn');
  295.  WriteLn(Output,' /p      page output');
  296.  WriteLn(Output,' /?      this help display.');
  297.  HALT;
  298. END; (* GiveHelp *)
  299.  
  300. BEGIN
  301.  GetCBreak(OldCtrlBreakState); SetCBreak(FALSE);
  302.  OldCtrlBreakHandler := ExitProc; ExitProc := @MyCtrlBreakHandler;
  303.  BrokeOut := FALSE;
  304.  
  305.  GetDir(0,ActDir);
  306.  
  307.  IF (ParamStr(1) = '/?') OR (ParamStr(1) = '-?') THEN GiveHelp;
  308.  
  309.  IF TextRec(Output).Name[0] <> #0 THEN
  310.   BEGIN
  311.    Str(DescLen,DescTempl); DescTempl := '%-'+DescTempl+'s';
  312.   END;
  313.  
  314.  BareOutput     := FALSE; ExactAttr  := FALSE;
  315.  SubDirectories := FALSE; AllDrives  := FALSE;
  316.  DoScanLZHArchives := TRUE; DoScanZIPArchives := TRUE;
  317.  DoScanARJArchives := TRUE;
  318.  FileSpecArray[1] := '*.*'; FileSpecs := 1; StartDir := '';
  319.  
  320.  i := 1; l := 0;
  321.  REPEAT
  322.   ps := ParamStr(i);
  323.   IF ps[1] = '/' THEN ps[1] := '-';
  324.   IF ps[1] = '-' THEN
  325.    BEGIN
  326.     s := Copy(ps,2,255); DownString(s);
  327.  
  328.     IF DoScanLZHArchives     THEN DoScanLZHArchives := (s <>'l');
  329.     IF DoScanZIPArchives     THEN DoScanZIPArchives := (s <>'z');
  330.     IF DoScanARJArchives     THEN DoScanARJArchives := (s <>'j');
  331.     IF NOT SubDirectories    THEN SubDirectories    := (s='s');
  332.     IF NOT BareOutput        THEN BareOutput        := (s='b');
  333.     IF NOT AllDrives         THEN AllDrives         := (s='d');
  334.     IF NOT DoPage AND NOT Redirected THEN DoPage    := (s='p');
  335.  
  336.     IF s[1] = 'a' THEN
  337.      BEGIN
  338.       s := Copy(s,Pos(':',s)+1,255);
  339.       Attr := 0; AttrStr := '....'; ExactAttr := TRUE;
  340.  
  341.       IF (Pos('r',s) > 0) AND (Pos('-r',s) = 0) THEN BEGIN INC(Attr,ReadOnly); AttrStr[1] := 'r'; END;
  342.       IF (Pos('h',s) > 0) AND (Pos('-h',s) = 0) THEN BEGIN INC(Attr,Hidden  ); AttrStr[2] := 'h'; END;
  343.       IF (Pos('s',s) > 0) AND (Pos('-s',s) = 0) THEN BEGIN INC(Attr,SysFile ); AttrStr[3] := 's'; END;
  344.       IF (Pos('a',s) > 0) AND (Pos('-a',s) = 0) THEN BEGIN INC(Attr,Archive ); AttrStr[4] := 'a'; END;
  345.      END;
  346.  
  347.     IF ps[2] = 'm' THEN
  348.      BEGIN
  349.       Delete(ps,1,3); Val(ps,k,IORes);
  350.       MaxViewLength := k-31-Length(DateFormat)-Length(TimeFormat);
  351.       Str(MaxViewLength,DescTempl); DescTempl := '%-'+DescTempl+'s';
  352.      END;
  353.     INC(l);
  354.    END;
  355.    INC(i);
  356.   UNTIL (i>ParamCount) OR (ps[1] <> '-');
  357.  
  358.  IF l < ParamCount THEN
  359.   BEGIN
  360.    FOR i := l+1 TO ParamCount DO
  361.     BEGIN
  362.      FSplit(FExpand(ParamStr(i)),Path,Name,Ext);
  363.      IF (Path <> '') AND (StartDir = '') THEN StartDir := Path;
  364.      IF Name = '' THEN Name := '*';
  365.      IF Ext  = '' THEN Ext  := '.*';
  366.  
  367.      FileSpecArray[i-l] := Name+Ext; DownString(FileSpecArray[i-l]);
  368.     END;
  369.     FileSpecs := ParamCount-l;
  370.   END;
  371.  
  372.  IF StartDir = ''  THEN StartDir := ActDir;
  373.  IF SubDirectories THEN Path := StartDir
  374.                    ELSE Path := Copy(StartDir,1,3);
  375.  
  376.  IF NOT BareOutput THEN
  377.   BEGIN
  378.    WriteLn(Output,Header);
  379.    WriteLn(Output);
  380.    WriteLn(Output,'This program is freeware: you are allowed to use,');
  381.    WriteLn(Output,'copy it free of charge, but you may not sell or hire 4FF.');
  382.    WriteLn(Output);
  383.    IF FileSpecs = 1 THEN WriteLn(Output,'Filename  = ',FileSpecArray[1],'.')
  384.    ELSE
  385.     BEGIN
  386.      Write(Output, 'Filenames = ');
  387.      FOR i := 1 TO FileSpecs DO
  388.       BEGIN
  389.        Write(Output,FileSpecArray[i]);
  390.        IF i < FileSpecs THEN Write(Output,', ')
  391.                         ELSE WriteLn(Output,'.');
  392.       END;
  393.     END;
  394.    IF AllDrives THEN WriteLn(Output,'Scanning all drives.')
  395.                 ELSE WriteLn(Output,'Path      = ',Path);
  396.    Line := 7;
  397.    IF ExactAttr THEN
  398.     BEGIN
  399.      WriteLn(Output,'Attributes= ',AttrStr); INC(Line);
  400.     END;
  401.   END;
  402.  
  403.  IF DoScanLZHArchives OR DoScanZIPArchives OR DoScanARJArchives THEN InstallBuffer;
  404.  
  405.  TotalFileCount := 0; TotalSize := 0; BrokeOut := TRUE;
  406.  
  407.  IF NOT AllDrives THEN
  408.   BEGIN
  409.    s := Path; l := Length(s);
  410.    IF (l > 3) AND (s[l] = '\') THEN Delete(s,l,1);
  411.    BuildList(Path,FileSpecArray,FileSpecs,Attr)
  412.   END
  413.  ELSE
  414.   FOR Drive := 'C' TO 'Z' DO
  415.    IF DriveValid(Drive) THEN BuildList(Drive+':\',FileSpecArray,FileSpecs,Attr);
  416.  BrokeOut := FALSE;
  417.  
  418.  IF NOT BareOutput THEN
  419.   BEGIN
  420.    IF TotalFileCount = 0 THEN s := 'no files found.'
  421.    ELSE
  422.     BEGIN
  423.      Templ := '%s file';
  424.      IF TotalFileCount = 1 THEN Templ := Templ +', '
  425.                            ELSE Templ := Templ +'s,';
  426.      Templ := Templ+'   %10s Bytes';
  427.  
  428.      FileStr := FormattedIntStr(TotalFileCount,4); InfoArray[0] := LONGINT(@FileStr);
  429.      SizeStr := FormattedLongIntStr(TotalSize,10); InfoArray[1] := LONGINT(@SizeStr);
  430.      FormatStr(s,Templ,InfoArray);
  431.     END;
  432.  
  433.    WriteLn(Output,'------------------------------------------------'); IF DoPage THEN TestForMoreMsg;
  434.    WriteLn(Output,s); IF DoPage THEN TestForMoreMsg;
  435.   END
  436.  ELSE WriteLn(Output);
  437.  
  438.  IF DoScanLZHArchives OR DoScanZIPArchives OR DoScanARJArchives THEN FreeBuffer;
  439. END.
  440.