home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / DOS / 4DOS / UTILS / 4UTILS / SCANLZHF.PAS < prev    next >
Pascal/Delphi Source File  |  1993-12-17  |  7KB  |  195 lines
  1. UNIT ScanLZHFiles;
  2. {$V-}
  3. (* ----------------------------------------------------------------------
  4.    Part of 4DESC - A Simple 4DOS File Description Editor
  5.        and 4FF   - 4DOS File Finder
  6.  
  7.    (c) 1992, 1993 Copyright by David Frey,
  8.                                Urdorferstrasse 30
  9.                                8952 Schlieren ZH
  10.                                Switzerland
  11.  
  12.    DISCLAIMER: This unit is freeware: you are allowed to use, copy
  13.                and change it free of charge, but you may not sell or hire
  14.                this part of 4DESC. The copyright remains in our hands.
  15.  
  16.                If you make any (considerable) changes to the source code,
  17.                please let us know. (send a copy or a listing).
  18.                We would like to see what you have done.
  19.  
  20.                We, David Frey and Tom Bowden, the authors, provide absolutely
  21.                no warranty of any kind. The user of this software takes the
  22.                entire risk of damages, failures, data losses or other
  23.                incidents.
  24.  
  25.  
  26.        Code created using Turbo Pascal 6.0 (c) Borland International 1990
  27.  
  28.    This unit provides the extraction of file names in .LZH files.
  29.  
  30.    ----------------------------------------------------------------------- *)
  31.  
  32. INTERFACE USES Dos, Globals;
  33.  
  34. PROCEDURE SearchInLZHFile(FileSpec: FileSpecArrayType; FileSpecs: BYTE;
  35.                           VAR Dir: PathStr; VAR lhsearch: SearchRec);
  36. PROCEDURE ShowCompLZHFileData(VAR search,lhsearch: SearchRec;VAR Path: PathStr;
  37.                               csize: LONGINT);
  38.  
  39. VAR OldLHFileName: PathStr;
  40.  
  41. IMPLEMENTATION USES Objects, Drivers, StringDateHandling;
  42.  
  43. VAR LHFile       : FILE;
  44.  
  45. PROCEDURE SearchInLZHFile(FileSpec: FileSpecArrayType; FileSpecs: BYTE;
  46.                           VAR Dir: PathStr; VAR lhsearch: SearchRec);
  47.  
  48. VAR i        : WORD;
  49.     k, Dummy : BYTE;
  50.     LHAFile  : NameExtStr;
  51.  
  52. BEGIN (* SearchInLZHFile *)
  53.  Assign(LHFile,lhsearch.Name); Reset(LHFile,1);
  54.  
  55.  BlockRead(LHFile,Buffer^,BufSize,BytesRead); BufPtr := 2; FilePtr := 2;
  56.  (* first 2 unknown bytes skipped *)
  57.  REPEAT
  58.   s := '';
  59.   REPEAT
  60.    s := s+Chr(ReadByte);
  61.   UNTIL (Pos('-lh',s) > 0) OR (BufPtr > BytesRead);
  62.   Dummy := ReadByte; Dummy := ReadByte; (* overread Method *)
  63.  
  64.   IF BufPtr <= BytesRead THEN
  65.    BEGIN
  66.     csize       := LONGINT(ReadByte) SHL 24 + LONGINT(ReadByte) SHL 16 + LONGINT(ReadByte) SHL 8 + ReadByte;
  67.     Search.size := LONGINT(ReadByte) SHL 24 + LONGINT(ReadByte) SHL 16 + LONGINT(ReadByte) SHL 8 + ReadByte;
  68.     Search.time := LONGINT(ReadByte) SHL 24 + LONGINT(ReadByte) SHL 16 + LONGINT(ReadByte) SHL 8 + ReadByte;
  69.     Search.attr := ReadByte;
  70.     Dummy := ReadByte; (* unknown 2 *)
  71.  
  72.     WITH Search DO
  73.      BEGIN
  74.       name  := ''; FOR i := 1 TO ReadByte DO name := name+DownCase(Chr(ReadByte));
  75.      END;
  76.  
  77.     FOR k := 1 TO FileSpecs DO
  78.      BEGIN
  79.       FSplit(FileSpec[k],Path,name,ext);
  80.       WHILE Length(name) < 8 DO name := name+' ';
  81.       IF Ext = '' THEN Ext := '.   '
  82.       ELSE
  83.        WHILE Length(ext)      < 4 DO ext := ext+' ';
  84.  
  85.       i := Pos('*',name);
  86.       IF  i > 0 THEN
  87.        WHILE i <= 8 DO
  88.         BEGIN
  89.          name[i] := '?'; INC(i);
  90.         END;
  91.  
  92.       i := Pos('*',ext);
  93.       IF  i > 0 THEN
  94.        WHILE i <= 4 DO
  95.         BEGIN
  96.          ext[i] := '?'; INC(i);
  97.         END;
  98.       FileSpec[k] := Path+name+ext;
  99.  
  100.       FSplit(Search.Name,Path,name,ext);
  101.       WHILE Length(name) < 8 DO name := name +' ';
  102.       IF Ext = '' THEN Ext := '.   '
  103.       ELSE
  104.        WHILE Length(ext)      < 4 DO ext := ext+' ';
  105.       LHAFile:= Path+name+ext;
  106.  
  107.       i := 1;
  108.       WHILE ((FileSpec[k][i] = '?') OR (FileSpec[k][i] = LHAFile[i])) AND
  109.              (i<12) DO
  110.        INC(i);
  111.  
  112.       IF ((ExactAttr AND (Search.Attr = Attr)) OR (NOT ExactAttr)) AND
  113.           (FileSpec[k][i] = '?') OR (FileSpec[k][i] = LHAFile[i]) THEN
  114.        ShowCompLZHFileData(search,lhsearch,Dir,csize);
  115.      END;
  116.  
  117.     INC(BufPtr,csize); INC(FilePtr,csize);
  118.     IF BufPtr > BufSize THEN
  119.      BEGIN
  120.       Seek(LHFile,FilePtr);
  121.       BlockRead(LHFile,Buffer^,BufSize,BytesRead); BufPtr := 0;
  122.      END;
  123.    END;
  124.  UNTIL BufPtr > BytesRead;
  125.  
  126.  Close(LHFile);
  127. END; (* SearchInLZHFile *)
  128.  
  129. PROCEDURE ShowCompLZHFileData(VAR search,lhsearch: SearchRec;VAR Path: PathStr;
  130.                               csize: LONGINT);
  131.  
  132. BEGIN
  133.  IF BareOutput THEN
  134.   Write(Output,Path,lhsearch.Name,' ')
  135.  ELSE
  136.   BEGIN
  137.    IF FileCount = 0 THEN
  138.     BEGIN
  139.      WriteLn(Output); IF DoPage THEN TestForMoreMsg;
  140.      WriteLn(Output,Path); IF DoPage THEN TestForMoreMsg;
  141.     END;
  142.  
  143.    IF lhsearch.Name <> OldLHFileName THEN
  144.     BEGIN
  145.      DownString(lhsearch.Name); OldLHFileName := lhsearch.Name;
  146.  
  147.      InfoArray[0] := LONGINT(@lhsearch.Name);
  148.  
  149.      SizeStr := FormattedLongIntStr(lhsearch.Size,8);
  150.      InfoArray[1] := LONGINT(@SizeStr);
  151.  
  152.      UnpackTime(lhsearch.Time,DateRec);
  153.      Date := FormDate(DateRec); Time := FormTime(DateRec);
  154.      InfoArray[2] := LONGINT(@Date);
  155.      InfoArray[3] := LONGINT(@Time);
  156.  
  157.      AttrStr := '....';
  158.      IF lhSearch.Attr AND Archive  = Archive  THEN AttrStr[1] := 'a';
  159.      IF lhSearch.Attr AND Hidden   = Hidden   THEN AttrStr[2] := 'h';
  160.      IF lhSearch.Attr AND SysFile  = SysFile  THEN AttrStr[3] := 's';
  161.      IF lhSearch.Attr AND ReadOnly = ReadOnly THEN AttrStr[4] := 'r';
  162.      InfoArray[4] := LONGINT(@AttrStr);
  163.  
  164.      FormatStr(s,'(%-12s   %8s '+DateTempl+' '+TimeTempl+' %4s)',InfoArray);
  165.      WriteLn(Output,s); IF DoPage THEN TestForMoreMsg;
  166.     END;
  167.  
  168.    InfoArray[0] := LONGINT(@search.Name);
  169.  
  170.    SizeStr := FormattedLongIntStr(search.Size,8);
  171.    InfoArray[1] := LONGINT(@SizeStr);
  172.  
  173.    UnpackTime(search.Time,DateRec);
  174.    Date := FormDate(DateRec); Time := FormTime(DateRec);
  175.    InfoArray[2] := LONGINT(@Date);
  176.    InfoArray[3] := LONGINT(@Time);
  177.  
  178. (*   AttrStr := '----';
  179.    IF Search.Attr AND Archive  = Archive  THEN AttrStr[1] := 'a';
  180.    IF Search.Attr AND Hidden   = Hidden   THEN AttrStr[2] := 'h';
  181.    IF Search.Attr AND SysFile  = SysFile  THEN AttrStr[3] := 's';
  182.    IF Search.Attr AND ReadOnly = ReadOnly THEN AttrStr[4] := 'o'
  183.                                           ELSE AttrStr[4] := 'w';
  184.    InfoArray[4] := LONGINT(@AttrStr);
  185.  
  186.    FormatStr(s,'+ %-12s  %8s '+DateTempl+' '+TimeTempl+' %4s',InfoArray); *)
  187.    FormatStr(s,'+ %-12s  %8s '+DateTempl+' '+TimeTempl,InfoArray);
  188.    WriteLn(Output,s); IF DoPage THEN TestForMoreMsg;
  189.  
  190.    INC(TotalSize,csize); INC(DirSize,csize);
  191.    INC(TotalFileCount);  INC(FileCount);
  192.   END;
  193. END; (* ShowFileData *)
  194.  
  195. END.