Category : BASIC Source Code
Archive   : ZIPVIEW.ZIP
Filename : ZV.BAS

 
Output of file : ZV.BAS contained in archive : ZIPVIEW.ZIP

' 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