home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 15 / CD_ASCQ_15_070894.iso / vrac / 4utils83.zip / SCANLZHF.PAS < prev    next >
Pascal/Delphi Source File  |  1994-04-28  |  6KB  |  191 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. PROCEDURE SearchInLZHFile(FileSpec: FileSpecArrayType; FileSpecs: BYTE;
  44.                           VAR Dir: PathStr; VAR lhsearch: SearchRec);
  45.  
  46. VAR i        : WORD;
  47.     k, Dummy : BYTE;
  48.     LHAFile  : NameExtStr;
  49.  
  50. BEGIN (* SearchInLZHFile *)
  51.  Assign(f,lhsearch.Name); Reset(f,1);
  52.  
  53.  BlockRead(f,Buffer^,BufSize,BytesRead); BufPtr := 2; FilePtr := 2;
  54.  (* first 2 unknown bytes skipped *)
  55.  REPEAT
  56.   s := '';
  57.   REPEAT
  58.    s := s+Chr(ReadByte);
  59.   UNTIL (Pos('-lh',s) > 0) OR (BufPtr > BytesRead);
  60.   Dummy := ReadByte; Dummy := ReadByte; (* overread Method *)
  61.  
  62.   IF BufPtr < BytesRead THEN
  63.    BEGIN
  64.     csize       := LONGINT(ReadByte) SHL 24 + LONGINT(ReadByte) SHL 16 + LONGINT(ReadByte) SHL 8 + ReadByte;
  65.     Search.size := LONGINT(ReadByte) SHL 24 + LONGINT(ReadByte) SHL 16 + LONGINT(ReadByte) SHL 8 + ReadByte;
  66.     Search.time := LONGINT(ReadByte) SHL 24 + LONGINT(ReadByte) SHL 16 + LONGINT(ReadByte) SHL 8 + ReadByte;
  67.     Search.attr := ReadByte;
  68.     Dummy := ReadByte; (* unknown 2 *)
  69.  
  70.     WITH Search DO
  71.      BEGIN
  72.       name  := ''; FOR i := 1 TO ReadByte DO name := name+DownCase(Chr(ReadByte));
  73.      END;
  74.  
  75.     FOR k := 1 TO FileSpecs DO
  76.      BEGIN
  77.       FSplit(FileSpec[k],Path,name,ext);
  78.       WHILE Length(name) < 8 DO name := name+' ';
  79.       IF Ext = '' THEN Ext := '.   '
  80.       ELSE
  81.        WHILE Length(ext)      < 4 DO ext := ext+' ';
  82.  
  83.       i := Pos('*',name);
  84.       IF  i > 0 THEN
  85.        WHILE i <= 8 DO
  86.         BEGIN
  87.          name[i] := '?'; INC(i);
  88.         END;
  89.  
  90.       i := Pos('*',ext);
  91.       IF  i > 0 THEN
  92.        WHILE i <= 4 DO
  93.         BEGIN
  94.          ext[i] := '?'; INC(i);
  95.         END;
  96.       FileSpec[k] := Path+name+ext;
  97.  
  98.       FSplit(Search.Name,Path,name,ext);
  99.       WHILE Length(name) < 8 DO name := name +' ';
  100.       IF Ext = '' THEN Ext := '.   '
  101.       ELSE
  102.        WHILE Length(ext)      < 4 DO ext := ext+' ';
  103.       LHAFile:= Path+name+ext;
  104.  
  105.       i := 1;
  106.       WHILE ((FileSpec[k][i] = '?') OR (FileSpec[k][i] = LHAFile[i])) AND
  107.              (i<12) DO
  108.        INC(i);
  109.  
  110.       IF ((ExactAttr AND (Search.Attr = Attr)) OR (NOT ExactAttr)) AND
  111.           (FileSpec[k][i] = '?') OR (FileSpec[k][i] = LHAFile[i]) THEN
  112.        ShowCompLZHFileData(search,lhsearch,Dir,csize);
  113.      END;
  114.  
  115.     INC(BufPtr,csize); INC(FilePtr,csize);
  116.     IF BufPtr >= BufSize THEN
  117.      BEGIN
  118.       Seek(f,FilePtr);
  119.       BlockRead(f,Buffer^,BufSize,BytesRead); BufPtr := 0;
  120.      END;
  121.    END;
  122.  UNTIL BufPtr >= BytesRead;
  123.  
  124.  Close(f);
  125. END; (* SearchInLZHFile *)
  126.  
  127. PROCEDURE ShowCompLZHFileData(VAR search,lhsearch: SearchRec;VAR Path: PathStr;
  128.                               csize: LONGINT);
  129.  
  130. BEGIN
  131.  IF NOT BareOutput THEN
  132.   BEGIN
  133.    IF FileCount = 0 THEN
  134.     BEGIN
  135.      WriteLn(Output); IF DoPage THEN TestForMoreMsg;
  136.      WriteLn(Output,Path); IF DoPage THEN TestForMoreMsg;
  137.     END;
  138.  
  139.    IF lhsearch.Name <> OldLHFileName THEN
  140.     BEGIN
  141.      DownString(lhsearch.Name); OldLHFileName := lhsearch.Name;
  142.  
  143.      InfoArray[0] := @lhsearch.Name;
  144.  
  145.      SizeStr := FormattedLongIntStr(lhsearch.Size,8);
  146.      InfoArray[1] := @SizeStr;
  147.  
  148.      UnpackTime(lhsearch.Time,DateRec);
  149.      Date := FormDate(DateRec); Time := FormTime(DateRec);
  150.      InfoArray[2] := @Date;
  151.      InfoArray[3] := @Time;
  152.  
  153.      AttrStr := '....';
  154.      IF lhSearch.Attr AND Archive  = Archive  THEN AttrStr[1] := 'a';
  155.      IF lhSearch.Attr AND Hidden   = Hidden   THEN AttrStr[2] := 'h';
  156.      IF lhSearch.Attr AND SysFile  = SysFile  THEN AttrStr[3] := 's';
  157.      IF lhSearch.Attr AND ReadOnly = ReadOnly THEN AttrStr[4] := 'r';
  158.      InfoArray[4] := @AttrStr;
  159.  
  160.      FormatStr(s,'(%-12s   %8s '+DateTempl+' '+TimeTempl+' %4s)',InfoArray);
  161.      WriteLn(Output,s); IF DoPage THEN TestForMoreMsg;
  162.     END;
  163.  
  164.    InfoArray[0] := @search.Name;
  165.  
  166.    SizeStr := FormattedLongIntStr(search.Size,8);
  167.    InfoArray[1] := @SizeStr;
  168.  
  169.    UnpackTime(search.Time,DateRec);
  170.    Date := FormDate(DateRec); Time := FormTime(DateRec);
  171.    InfoArray[2] := @Date;
  172.    InfoArray[3] := @Time;
  173.  
  174. (*   AttrStr := '----';
  175.    IF Search.Attr AND Archive  = Archive  THEN AttrStr[1] := 'a';
  176.    IF Search.Attr AND Hidden   = Hidden   THEN AttrStr[2] := 'h';
  177.    IF Search.Attr AND SysFile  = SysFile  THEN AttrStr[3] := 's';
  178.    IF Search.Attr AND ReadOnly = ReadOnly THEN AttrStr[4] := 'o'
  179.                                           ELSE AttrStr[4] := 'w';
  180.    InfoArray[4] := LONGINT(@AttrStr);
  181.  
  182.    FormatStr(s,'+ %-12s  %8s '+DateTempl+' '+TimeTempl+' %4s',InfoArray); *)
  183.    FormatStr(s,'+ %-12s  %8s '+DateTempl+' '+TimeTempl,InfoArray);
  184.    WriteLn(Output,s); IF DoPage THEN TestForMoreMsg;
  185.  
  186.    INC(TotalSize,csize); INC(DirSize,csize);
  187.    INC(TotalFileCount);  INC(FileCount);
  188.   END;
  189. END; (* ShowFileData *)
  190.  
  191. END.