'===========================================================================
' Subject: LZH VIEWER FOR PB                  Date: 12-10-97 (14:44)       
'  Author: The ABC Programmer                 Code: PB                     
'  Origin: Check MISC.ABC for QB version    Packet: PB.ABC
'===========================================================================
'=============================[ .LZH Viewer ]===============================
' Simple .LZH Viewer for PowerBASIC programmed by William Yu (12-10-97)
' Special thanks to the SWAG SUPPORT TEAM for posting the Pascal equivalent.
' Donated to the Public Domain, please give credit where due.
' (The QuickBASIC equivalent of this code is also available).
'
' Author can be e-mailed at: voxel@freenet.edmonton.ab.ca
' Or visit his ABC Homepage: http://www.freenet.edmonton.ab.ca/~voxel/
'===========================================================================
DEFINT A-Z

%False = 0
%True = NOT %False

TYPE LZHHead
     HSize       AS Byte
     Fill1       AS Byte
     Method      AS STRING*5
     CompSize    AS Long
     UCompSize   AS Long
     DateTime    AS Long
     Fill2       AS Word
     FileNameLen AS Byte
     FileName    AS STRING*12
END TYPE

DIM LZH1  AS SHARED LZHHead
DIM FSize AS SHARED LONG
DIM QUIT  AS SHARED INTEGER

ClS
do_LZH "whatever.lzh"   '<-- place Filename here

SUB GET_LZH_ENTRY (C AS LONG)
  GET #1,C,LZH1
    IF LZH1.HSize > 0 then
      FSize = LZH1.CompSize
    ELSE
      QUIT = %True
    END IF
END SUB  ' GET_LZH_ENTRY

SUB DO_LZH (FileN AS String)
 DIM C AS LONG
 DIM filenstr as STRING*12
 DIM LZHMeth as String
 DIM fls as Long,totu as Long, totc as Long
 DIM Year AS LONG
 DIM Month AS LONG
 DIM Day AS LONG
 DIM Hour AS WORD      ' We don't need the upper 2 bytes anymore.
 DIM Minute AS WORD    ' Works both ways.
 DIM Secs AS WORD

  totu=0: totc=0: fls=0
  OPEN FileN FOR BINARY AS #1
  FSize = LOF(1)
  IF FSize=0 THEN
    CLOSE #1
    KILL FileN
    ?FileN+" does not exist!"
    EXIT SUB
  END IF
  C = 0: QUIT = %False
  ?"LZH File : ";FileN
  ?
  ?"  Filename    OrigSize  CompSize  Ratio    Method     Date      Time"
  ?"------------  --------  --------  ------  --------  --------  --------"
  DO
    GET_LZH_ENTRY C
    IF not QUIT then
      Year=LZH1.DateTime:Shift Right Year, 25:Year=Year AND &H7F
      Month=LZH1.DateTime:Shift Right Month, 21:Month=Month AND &H0F
      Day=LZH1.DateTime:Shift Right Day, 16: Day=Day AND &H1F
      Hour=LZH1.DateTime:Shift Right Hour, 11: Hour=Hour AND &H1F
      Minute=LZH1.DateTime:Shift Right Minute, 5:Minute=Minute AND &H3F
      Secs=LZH1.DateTime AND &H1F
      M$=LTRIM$(STR$(Month))
      D$=LTRIM$(STR$(Day))
      IF LEN(M$)=1 THEN M$="0"+M$
      IF LEN(D$)=1 THEN D$="0"+D$
      A$=M$+"-"+D$+"-"+LTRIM$(STR$(Year+80))  ' Year starts at 1980
      H$=LTRIM$(STR$(Hour))
      M$=LTRIM$(STR$(Minute))
      S$=LTRIM$(STR$(Secs))
      IF LEN(H$)=1 THEN H$="0"+H$
      IF LEN(M$)=1 THEN M$="0"+M$
      IF LEN(S$)=1 THEN S$="0"+S$
      B$=H$+":"+M$+":"+S$
        incr totu,lzh1.ucompsize
        incr totc,lzh1.compsize
        incr fls
        SELECT Case MID$(LZH1.Method,4,1)       'normally only 0,1 or 5
          CASE "0" : LZHMeth="Stored  "
          CASE "1" : LZHMeth="Frozen 1"
          CASE "2" : LZHMeth="Frozen 2"
          CASE "3" : LZHMeth="Frozen 3"
          CASE "4" : LZHMeth="Frozen 4"
          CASE "5" : LZHMeth="Frozen 5"
        CASE else
          LZHMeth=" Unknown"
        END SELECT
        ?USING "\          \  \      \  \      \  \   \%  \      \  \       \ \      \";_
         LEFT$(LZH1.FileName,LZH1.FileNameLen);_
         STR$(LZH1.UCompsize);STR$(LZH1.Compsize);_
         STR$(LZH1.Compsize/LZH1.UCompsize*100);_
         LZHMeth;A$;B$
    END IF
    Incr C,FSize+LZH1.HSize+2
  LOOP Until QUIT
  Close #1
  ?"------------  --------  --------  ------  --------  --------  --------"
  ?USING "\          \  \      \  \      \  \   \%";str$(fls)+" files";_
   str$(totu);str$(totc);str$(totc/totu*100)
END SUB  ' DO_LZH

