'===========================================================================
' Subject: LZH VIEWER FOR QB                 Date: 12-10-97 (14:44)       
' Author:  The ABC Programmer                Code: QB, QBasic, PDS        
' Origin:  Check PB.ABC for PB version     Packet: MISC.ABC
'===========================================================================
'=============================[ .LZH Viewer ]===============================
' Simple .LZH Viewer for QuickBASIC 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 PowerBASIC 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/
'===========================================================================
DECLARE SUB DO.LZH (FileN AS STRING)
DECLARE SUB GET.LZH.ENTRY (C AS LONG)
DEFINT A-Z

CONST False = 0
CONST True = NOT False

TYPE LZHHead
     HSize       AS STRING * 1
     Fill1       AS STRING * 1
     Method      AS STRING * 5
     Compsize    AS LONG
     UCompsize   AS LONG
     DateTime    AS LONG
     Fill2       AS INTEGER     'WORD
     FileNameLen AS STRING * 1
     FileName    AS STRING * 12
END TYPE

DIM SHARED LZH1  AS LZHHead
DIM SHARED FSize AS LONG
DIM SHARED QUIT  AS INTEGER

CLS
DO.LZH "whatever.lzh"   '<-- place Filename here

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 LONG
 DIM Minute AS LONG
 DIM Secs AS LONG

  totu = 0: totc = 0: fls = 0
  OPEN FileN FOR BINARY AS #1
  FSize = LOF(1)
  IF FSize = 0 THEN
    CLOSE #1
    KILL FileN
    PRINT FileN + " does not exist!"
    EXIT SUB
  END IF
  C = 1: QUIT = False
  PRINT "LZH File : "; FileN
  PRINT
  PRINT "  Filename    OrigSize  CompSize  Ratio    Method     Date      Time"
  PRINT "------------  --------  --------  ------  --------  --------  --------"
  DO
    GET.LZH.ENTRY C
    IF NOT QUIT THEN
      Year = LZH1.DateTime: Year = Year \ (2 ^ 25) AND &H7F
      Month = LZH1.DateTime: Month = Month \ (2 ^ 21) AND &HF
      Day = LZH1.DateTime: Day = Day \ (2 ^ 16) AND &H1F
      Hour = LZH1.DateTime: Hour = Hour \ (2 ^ 11) AND &H1F
      Minute = LZH1.DateTime: Minute = Minute \ (2 ^ 5) 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$
        totu = totu + LZH1.UCompsize
        totc = totc + LZH1.Compsize
        fls = fls + 1
        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
        PRINT USING "\          \  \      \  \      \  \   \%  \      \  \       \ \      \"; LEFT$(LZH1.FileName, ASC(LZH1.FileNameLen)); STR$(LZH1.UCompsize); STR$(LZH1.Compsize); STR$(LZH1.Compsize / LZH1.UCompsize * 100); LZHMeth; A$; B$
    END IF
    C = C + FSize + ASC(LZH1.HSize) + 2
  LOOP UNTIL QUIT
  CLOSE #1
  PRINT "------------  --------  --------  ------  --------  --------  --------"
  PRINT USING "\          \  \      \  \      \  \   \%"; STR$(fls) + " files"; STR$(totu); STR$(totc); STR$(totc / totu * 100)
END SUB  ' DO.LZH

SUB GET.LZH.ENTRY (C AS LONG)
  GET #1, C, LZH1
    IF ASC(LZH1.HSize) > 0 THEN
      FSize = LZH1.Compsize
    ELSE
      QUIT = True
    END IF
END SUB  ' GET.LZH.ENTRY