' ZV      BAS : A Quick Basic archive file viewer for MS-DOS machines
' author .....: Dick Dennison    [74270,3636]  914-374-3903 3/12/24 24 hrs
' supports ...: ZIP, LZH, ARC, PAK, ZOO archive formats
' syntax .....: ZV FILENAME
' returns ....: The member filespecs in the archive
' includes ...: DIXARC02.INC = contains archive structures
' notes ......: All output is thru dos
'             : This is to allow easy porting to comm port routines
' cost .......: Free = Credit where credit due
'             : Do not use as is for commercial use - may not be resold
'             : May not be rebundled without prior written consent
' trademarks .: ZIP is the property of Phil Katz
'             : ARC is the property of SEA
'             : ZOO is the property of Rahul Dhesi
'             : PAK is the property of NoGate Consulting
'             : Lharc is the property of Yoshi
'             : MS-DOS is the property of MicroSoft
' dated ......: 10/24/90

DECLARE SUB pakview (filestr$)
DECLARE SUB zooview (filestr$)
DECLARE SUB arcview (filestr$)
DECLARE SUB getname (filestr$)
DECLARE FUNCTION fixtime$ (parm%)
DECLARE FUNCTION fixdate$ (parm%)
DECLARE SUB viewlzh (filestr$)
DECLARE SUB showmsg (Msg$)
DECLARE SUB zipview (filestr$)

'$INCLUDE: 'dixarc02.inc'

DIM SHARED mon(13) AS STRING
mon$(1) = "-Jan-": mon$(2) = "-Feb-": mon$(3) = "-Mar-": mon$(4) = "-Apr-"
mon$(5) = "-May-": mon$(6) = "-Jun-": mon$(7) = "-Jul-": mon$(8) = "-Aug-":
mon$(9) = "-Sep-": mon$(10) = "-Oct-": mon$(11) = "-Nov-": mon$(12) = "-Dec-"
DIM SHARED banner$
banner$ = STRING$(75, "Í")

OPEN "cons:" FOR OUTPUT AS 5   'See showmsg for info on this
showmsg CHR$(10) + CHR$(13)

IF COMMAND$ = "" THEN
	showmsg "ZV filename   {where filename is a PAK,ARC,ZIP,ZOO,LZH file}"
	END
END IF
getname COMMAND$
END

SUB arcview (filestr$)
DIM arc AS header   'header is in include file

OPEN filestr$ FOR BINARY AS 1 LEN = LEN(arc)

'Display Banner
b$ = "DIX ARCview - Archive: " + filestr$ + STR$(LOF(1))
c$ = SPACE$((80 - LEN(b$)) \ 2 - 3)      'Center line
b$ = c$ + b$
showmsg b$
showmsg banner$

b$ = "Filename        Size    Old Size  Date       Time       Method    CRC"
showmsg b$
showmsg banner$

leng& = LOF(1)
FOR n% = 1 TO 100   'arbitrary number
	GET 1, , arc
	sig% = arc.arcid AND 255   'Low order of byte is ID signature
	meth% = arc.arcid \ 256    'Method of compression in high order
	IF sig% <> 26 THEN
		n% = n% - 1
		EXIT FOR
	END IF
	IF meth% < 1 THEN
		n% = n% - 1
		EXIT FOR
	END IF
	ntime$ = fixtime$(arc.atime)
	ndate$ = fixdate$(arc.adate)
	mark% = INSTR(arc.filename, ".")
	IF mark% < 2 THEN mark% = 9  'incase filename has no extension
   
	'Parse filename and format for printing
	filename$ = LEFT$(arc.filename, mark% - 1) + MID$(arc.filename, mark%, 4)
  SELECT CASE meth%        ' Select correct compression text
	CASE IS = 1
		met$ = "------  "  ' No compression used
	CASE IS = 2
		met$ = "Stored  "  ' Repeated running length encoding (RLE)
	CASE IS = 3
		met$ = "Packed  "  ' Huffman encoding
	CASE IS = 4
		met$ = "Squeezed"  ' LZW with 4K buffer, 12 bits codes
	CASE IS = 5
		met$ = "crunched"  ' First packing, then LZW 4K buffer with 12 bits
	CASE IS = 6
		met$ = "crunched"  ' Packing, LZW, 4K buffer, vari len (9-12 bits)
	CASE IS = 7
		met$ = "Crunched"  ' LZW, 8K buffer, variable length (9-13 bits)
	CASE IS = 8
		met$ = "Crunched"
	CASE IS = 9
		met$ = "Squashed"
	CASE IS = 10
		met$ = "Crushed "  ' Packing, then LZW 8K buffer, 2-13 bits (PAK 1.0)
	CASE IS = 11
		met$ = "Distill "  ' Dynamic Huffman with 8K buffer (PAK 2.0)
	CASE ELSE
		met$ = "--------"  ' usually -1
  END SELECT

  totcomp& = totcomp& + arc.newsize  'Get the totals for the archive
  totunc& = totunc& + arc.oldsize
 
  'Because the filesizes are different lengths we need to
  'Parse the display and add spacing
  c$ = SPACE$(15 - LEN(filename$))
  d$ = SPACE$(8 - LEN(STR$(arc.newsize)))
  e$ = SPACE$(11 - LEN(STR$(arc.oldsize)))

  b$ = filename$ + c$ + STR$(arc.newsize) + d$ + STR$(arc.oldsize) + e$ + ndate$ + "  " + ntime$ + "   " + met$ + "  " + HEX$(arc.CRC) + cr$
  showmsg b$
 
  where& = SEEK(1)
  IF totcomp& + n% * LEN(arc) >= leng& THEN EXIT FOR
  IF LEN(header) + where& + arc.newsize >= leng& THEN EXIT FOR 'At end yet?
  SEEK 1, where& + arc.newsize   'Position read/write head for next file get
NEXT n%
CLOSE 1
'Show trailer
showmsg banner$
b$ = STR$(n%) + " files" + SPACE$(7) + STR$(totcomp&) + "  " + STR$(totunc&) + cr$
showmsg b$

END SUB

FUNCTION fixdate$ (parm%)
'Date and time are in packed format - these are the breakouts
'bits 00h-04h = day (1-31)
'bits 05h-08h = month (1-12)
'bits 09h-0Fh = year (relative to 1980)

day% = parm% AND 31        'get bits 0-4
dayz$ = LTRIM$(STR$(day%))
IF LEN(dayz$) = 1 THEN dayz$ = "0" + (dayz$)  'Parse and add leading 0 if needed
parm% = parm% \ 32         'shift left 5
month% = parm% AND 15      'get bits 5-8
parm% = parm% \ 16         'shift left 4
year% = (parm% AND 255) + 80    'get bits 9-15 and add to 1980
moddate$ = dayz$ + mon$(month%) + LTRIM$(STR$(year%))  'Format is 20-Oct-90

fixdate$ = moddate$

END FUNCTION

FUNCTION fixtime$ (parm%)
'Date and time are in packed format - these are the breakouts
'bits 00h-04h = 2 second incs (0-29)
'bits 05h-0Ah = minutes (0-59)
'bits 0Bh-0Fh = hours (0-23)

Temp& = parm%
IF parm% < 0 THEN Temp& = Temp& + 65536  'Check for sign (+ -)
secs% = (Temp& AND 31) * 2  'get bits 0-4 and multiply by 2
Temp& = Temp& \ 32          'shift right 5
mins% = Temp& AND 63        'get bits 5-10
Temp& = Temp& \ 64          'shift right 6
hours% = Temp& AND 31       'get bits 11-15
sec$ = LTRIM$(STR$(secs%))
IF LEN(sec$) = 1 THEN sec$ = "0" + sec$    'Parse and add leading 0's
min$ = LTRIM$(STR$(mins%))
IF LEN(min$) = 1 THEN min$ = "0" + min$    'if needed
hour$ = LTRIM$(STR$(hours%))
IF LEN(hour$) = 1 THEN hour$ = "0" + hour$

modtime$ = hour$ + ":" + min$ + ":" + sec$  'Format is 01:30:46
fixtime$ = modtime$

END FUNCTION

SUB getname (filestr$)
OPEN filestr$ FOR APPEND AS 1
IF LOF(1) = 0 THEN              'If file exist continue
	CLOSE 1
	KILL filestr$
	showmsg "File not Found"
	END
END IF
CLOSE 1
								'Get file extension
mark% = INSTR(filestr$, ".")
a$ = MID$(filestr$, mark% + 1)

SELECT CASE UCASE$(a$)
	CASE "LZH"
		viewlzh filestr$
	CASE "ZIP"
		zipview filestr$
	CASE "ARC"
		arcview filestr$
	CASE "ZOO"
		zooview filestr$
	CASE "PAK"
		pakview filestr$
	CASE ELSE
		showmsg "Cannot view " + filestr$
		END
END SELECT
END SUB

SUB pakview (filestr$)
DIM pak AS paktype

OPEN filestr$ FOR BINARY AS 1

'Format and display banner
b$ = "DIX PAKview - Archive : " + filestr$ + "  " + STR$(LOF(1)) + " bytes"
c$ = SPACE$((80 - LEN(b$)) \ 2 - 3)      'Center line
b$ = c$ + b$
showmsg b$
showmsg banner$
b$ = "Filename       Old size   New size  Method     Date        Time     CRC"
showmsg b$
showmsg banner$

FOR n% = 1 TO 100    'arbitrary number
	
	GET 1, , pak
	SELECT CASE ASC(pak.version)
		CASE 0 '  End of file.  File header is only 2 bytes long (26 and 0).
			meth$ = "---------"
		CASE 1 ' No compression. File header lacks the Length field.
			meth$ = "---------"
		CASE 2 ' No compression.
			meth$ = "None     "
		CASE 3 ' Run-length encoding (RLE).
			meth$ = "REL      "
		CASE 4 ' Huffman squeezing.
			meth$ = "Huffman  "
		CASE 5 ' Fixed-length 12 bit LZW compression.
			meth$ = "12bit LZW"
		CASE 6 ' As above, with RLE.
			meth$ = "LZW w RLE"
		CASE 7 ' As above, but with a different hashing scheme.
			meth$ = "LZW w RLE"
		CASE 8 ' Variable-length 9-12 bit LZW compression with RLE.
			meth$ = "LZW w RLE"
		CASE 9 ' Variable-length 9-13 bit LZW compression without RLE.
			meth$ = "LZW n RLE"
		CASE 10' Crushing
			meth$ = "Crushing "
		CASE 11
			meth$ = "Distilled"
		CASE ELSE
			meth$ = "Unknown  "
	END SELECT
   
	mark% = INSTR(pak.filename, CHR$(0))
	filename$ = LEFT$(pak.filename, mark%)
	c$ = SPACE$(14 - LEN(filename$))
	pdate$ = fixdate$(pak.Date)
	ptime$ = fixtime$(pak.Time)
   
	i$ = SPACE$(11 - LEN(STR$(pak.length)))
	j$ = SPACE$(11 - LEN(STR$(pak.size)))

	b$ = filename$ + c$ + STR$(pak.length) + i$ + STR$(pak.size) + j$ + meth$ + "  " + pdate$ + "  " + ptime$ + "  " + HEX$(pak.CRC)
	showmsg b$
	size& = size& + pak.length
	nsize& = nsize& + pak.size
	place& = SEEK(1) + pak.size
	IF place& >= LOF(1) - ((n%) * 30) THEN EXIT FOR  'allow for extended
	SEEK 1, place&                                   'pak info before EOF
	

NEXT n%

'Format trailer
showmsg banner$
b$ = STR$(n%) + " files      " + STR$(size&) + "    " + STR$(nsize&)
showmsg b$
CLOSE 1
END SUB

SUB showmsg (Msg$)
'This routine is here because this whole module was originally
'written for my bbs program - DIXbbs  Print to console
'One caveat is that it keeps dos colors
PRINT #5, Msg$
END SUB

SUB viewlzh (filestr$)
DIM lz AS head1
DIM lzh AS Head2
DIM lzhc AS head3
OPEN filestr$ FOR BINARY AS 1 LEN = LEN(lzh)


b$ = "DIX Lharcview  -  Archive : " + filestr$ + "  " + STR$(LOF(1)) + " bytes"
c$ = SPACE$((80 - LEN(b$)) \ 2 - 3)      'Center line
b$ = c$ + b$
showmsg b$
showmsg banner$

b$ = "File            Size    Old size  Time       Date      Method   CRC" + cr$
showmsg b$
showmsg banner$
FOR n% = 1 TO 100     'arbitrary number

GET 1, , lz     'From include file
GET 1, , lzh    'Filename length is variable

ti$ = fixtime$(lzh.tim)   'Unpack date and time
da$ = fixdate$(lzh.dat)
fl% = ASC(lzh.fnl)        'This is the filename length
LzhName$ = INPUT$(fl%, 1) 'Get the number of chars in filename length
GET 1, , lzhc             'get the CRC value
tmp$ = HEX$(lzhc.CRC)     'format it for display

'Format the display with spaces
c$ = SPACE$(15 - LEN(LzhName$))
d$ = SPACE$(8 - LEN(STR$(lzh.nsz)))
e$ = SPACE$(11 - LEN(STR$(lzh.osz)))
old& = old& + lzh.osz          'retain the sizes
b$ = LzhName$ + c$ + STR$(lzh.nsz) + d$ + STR$(lzh.osz) + e$ + ti$ + "   " + da$ + " " + lzh.mtd + "    " + tmp$ + cr$
showmsg b$

place& = SEEK(1) + lzh.nsz    'Move file pointer for next file
SEEK 1, place&
IF place& >= LOF(1) THEN EXIT FOR    'At end yet?
NEXT n%

'Format and print trailer
b$ = STR$(n%) + " files      " + STR$(LOF(1)) + "  " + STR$(old&)
CLOSE 1
showmsg banner$
showmsg b$

END SUB

SUB zipview (filestr$)
DIM cent AS central

'dirsig$ = "2014B50"  'directory signature - don't really need this
enddirsig$ = "6054B50"  'end of directory sig

DIM buf AS buftype
DIM first AS dirrec

OPEN filestr$ FOR BINARY AS 1 LEN = LEN(cent)

b$ = "DIX Zipview - Archive : " + filestr$ + "   " + STR$(LOF(1)) + " bytes"
c$ = SPACE$((80 - LEN(b$)) \ 2 - 3)      'Center line
b$ = c$ + b$
showmsg b$
showmsg banner$
b$ = "Filename        Size    Old Size  Date       Time      Method   Dict Trees" + cr$
showmsg b$
showmsg banner$

' +++++++++++++++++++++++  NOTE  ++++++++++++++++++++++++++++++++++++++++
'The most difficult decision here is to decide where to start searching +
'ZIP banners are the problem  -  obviously a large offset will cover a  +
'greater number of banners but will be slower to find the signature     +
' +++++++++++++++++++++++  NOTE  ++++++++++++++++++++++++++++++++++++++++

offset% = 465   'this is the number to adjust

place& = LOF(1) - offset%      'covers most zipbanners
IF place& < 1 THEN place& = 1   'make sure place& is > 0
SEEK 1, place&    'Move file pointer near end of file and search for signature

FOR Z% = 1 TO offset%
	SEEK 1, place& + Z%
	IF place& + Z% >= LOF(1) THEN
		showmsg "ZIP signature not found"
		END
	END IF
	GET 1, , buf
	IF enddirsig$ = HEX$(buf.lin) THEN       'search for zip signature
		hit% = -1
		place& = SEEK(1)
		place& = place& - LEN(buf)  'reposition pointer to beginning of signature
		SEEK 1, place&
		EXIT FOR
	END IF
NEXT Z%
GET #1, , first             'get zip record
SEEK 1, first.offset + 1    'point to first record
FOR n% = 1 TO first.num     'first.num is # of files in archive
	GET #1, , cent          'get central directory record

	IF HEX$(cent.sig) = "6054B50" THEN EXIT FOR   'at end yet?
	filename$ = LEFT$(cent.filename, cent.fnamelen)
	SELECT CASE cent.compmeth   'Set text for compression method
		CASE IS = 0
			Method$ = "Stored"
		CASE IS = 1
			Method$ = "Shrunk"
		CASE IS = 2
			Method$ = "Reduced(1)"
		CASE IS = 3
			Method$ = "Reduced(2)"
		CASE IS = 4
			Method$ = "Reduced(3)"
		CASE IS = 5
			Method$ = "Reduced(4)"
		CASE IS = 6
			Method$ = "Imploded"
	END SELECT
	IF Method$ = "Imploded" THEN
		xz% = cent.bitflag AND 6
		IF xz% = 4 THEN Method$ = "Imploded 8K/d 2 SFano"
		IF xz% = 0 THEN Method$ = "Imploded 4K/d 2 SFano"
		IF xz% = 6 THEN Method$ = "Imploded 8K/D 3 SFano"
	END IF

  IF n% = 1 THEN              'retain oldest date and time
	oldest% = cent.moddate
	oldtime% = cent.modtime
  END IF
  IF oldest% < cent.moddate THEN
	oldest% = cent.moddate
	oldtime% = cent.modtime
  END IF

  'Unpack date and time
  moddate$ = fixdate$(cent.moddate)
  modtime$ = fixtime$(cent.modtime)

  'Format output with spaces
  h$ = SPACE$(15 - LEN(filename$))
  i$ = SPACE$(8 - LEN(STR$(cent.compsize)))
  j$ = SPACE$(11 - LEN(STR$(cent.uncompsize)))

  g$ = filename$ + h$ + STR$(cent.compsize) + i$ + STR$(cent.uncompsize) + j$ + moddate$ + "  " + modtime$ + "  " + Method$ + cr$
  showmsg g$

  total& = total& + cent.uncompsize      'retain size totals
  tot& = tot& + cent.compsize
  place& = SEEK(1)                       'Move file pointer
  place& = place& - ((12 - cent.fnamelen) - cent.extralen) 'check for extra field
  SEEK 1, place&
NEXT n%
CLOSE 1
showmsg banner$
olddate$ = fixdate$(oldest%)
oldtime$ = fixtime$(oldtime%)
g$ = STR$(first.num) + " files" + "       " + STR$(tot&) + " " + STR$(total&) + "     " + olddate$ + "  " + oldtime$
showmsg g$

END SUB

SUB zooview (filestr$)
DIM head AS zoomaster
DIM f AS zoofile
OPEN filestr$ FOR BINARY AS 1

'Display banner
b$ = "DIX ZOOview - Archive: " + filestr$ + STR$(LOF(1)) + " bytes"
c$ = SPACE$((80 - LEN(b$)) \ 2 - 3)      'Center line
b$ = c$ + b$
showmsg b$
showmsg banner$

b$ = "ZOO Filename    Old Size   New Size  Time      Date       CRC   Method"
showmsg b$
showmsg banner$

GET 1, , head    'Get central header and position file pointer to first file

FOR n% = 1 TO 100  'arbitrary number
   
	GET 1, , f
	ztime$ = fixtime$(f.zooftim)     'Unpack date and time
	zdate$ = fixdate$(f.zoofdat)
	IF f.zoofnxh = 0 OR f.zoofnxh > LOF(1) THEN EXIT FOR
	IF ASC(f.zoofcmp) = 1 THEN       'Set text for compression method
		meth$ = "LZW"
	ELSE meth$ = "---"
	END IF
	older& = older& + f.zoofosz  'save sizes
	newer& = newer& + f.zoofnsz
	'Format output with spaces
	d$ = STR$(f.zoofosz) + STRING$(11 - LEN(STR$(f.zoofosz)), " ")
	c$ = STR$(f.zoofnsz) + STRING$(11 - LEN(STR$(f.zoofnsz)), " ")
	b$ = UCASE$(f.zoofnam) + "  " + d$ + c$ + ztime$ + "  " + zdate$ + "  " + HEX$(f.zoofcrc) + "  " + meth$
	
	showmsg b$
	SEEK 1, f.zoofnxh - 3     'Move file pointer to next file Note:don't know what the '3' is for
	
NEXT n%

'Print trailer
showmsg banner$
b$ = " " + STR$(n% - 1) + " files      " + STR$(older&) + "     " + STR$(newer&)
CLOSE 1
showmsg b$
END SUB