home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
C!T ROM 2
/
ctrom_ii_b.zip
/
ctrom_ii_b
/
PROGRAM
/
BASIC
/
ZV25
/
ZV25.BAS
< prev
next >
Wrap
BASIC Source File
|
1992-09-29
|
32KB
|
1,119 lines
'$INCLUDE: 'zv07.inc' 'contains archive structures and declares
' ZV BAS : A Quick Basic archive dir viewer for MS-DOS machines
' author .....: Dick Dennison [74270,3636] 914-374-3903 3-9600 24 hrs
' : 1:272/34@fido 100:900/9@Magnet
' supports ...: ZIP, LZH, ARC, PAK, ZOO, ARJ, SQZ, sfx archive formats,
' : PKLite, Diet, LZE shrinkers
' syntax .....: ZV FILENAME [options]
' returns ....: The member filespecs in the archive
' includes ...: ZV07.INC = contains archive structures
' : EXTRNSxx.lib = external routines for linking
' notes ......: All output is thru screen now for speed
' : This used to go thru dos
' : This used to allow easy porting to comm port routines
' cost .......: Free with credit
' : Do not use for commercial use - may not be resold
' : May not be rebundled without prior written consent
' trademarks .: ZIP and PKLite are 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 and LHA are the property of Yoshi
' : ARJ is the property of Robert K. Jung
' : SQZ is the property of J I Hammarberg
' : MS-DOS is the property of MicroSoft
' : DIET is the property of Teddy Matsumoto
' : LZE is the property of Fabrice Bellard
' : etc., etc., et.al.
' dated ......: 10/24/90 - QBNews edition
' : 03/10/91 - support for LHA files added
' : 04/16/91 - guss functs, find first VERS 2.0
' : 05/10/91 - ARJ file support
' : 06/01/91 - EXE files support zip, pak, lzh, lha, arj
' : 08/07/91 - cleanup pause
' : 09/15/91 - redid ARJ code to allow for file comments
' : 01/15/92 - Put CRC into ZIP display
' : 01/16/92 - Bounce bar and wildcards
' : 02/29/92 - Fix in LZH for 0 length file
' : 06/07/92 - Cleaned display, extrns.obj added
' : 06/08/92 - Added Diet, Pklite, Lze
' : 06/21/92 - Rewrote LZH section for SFX files
' : 06/23/92 - Allowed for nonstd Arj sfx header
' : 09/27/92 - Squeeze support
' : 09/29/92 - Fixed Arj and Pak sfx bugs
' link info : BC zv25.bas/T/C:512; and then Link with Extrns25.lib:
' : LINK
' : /EX /NOE /NOD:BCOM45.LIB ZV25
' : BRUN45.LIB+
' : QB.LIB+
' : EXTRNS25.LIB
DECLARE SUB sqzvu (filestr$)
DECLARE SUB getname (filestr$)
DECLARE SUB center (text$)
DECLARE SUB arjvu (filestr$)
DECLARE SUB pakview (filestr$)
DECLARE SUB zooview (filestr$)
DECLARE SUB arcview (filestr$)
DECLARE SUB lzhview (filestr$)
DECLARE SUB showmsg (Msg$)
DECLARE SUB zipview (filestr$)
DECLARE SUB Update (oldate%, oldtime%, FileName$)
DECLARE SUB Switches ()
DECLARE FUNCTION fixtime$ (parm%)
DECLARE FUNCTION fixdate$ (parm%)
DECLARE FUNCTION FileStru$ (filespec$)
DECLARE SUB ExitWithErrLvl ALIAS "_exit" (BYVAL ErrorLevel%)
'End declares
TYPE filestruct
res AS STRING * 20
Attr AS INTEGER
Timef AS INTEGER
Datef AS INTEGER
size AS LONG
nameff AS STRING * 14
END TYPE
COMMON SHARED exeflag%, count%, pause%, redate%, oldtype%, namef$, errlevel%, SpecSeek%
CLEAR , , 20000 'needed some extra stack space
DIM SHARED mon(12) 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 banner1$
CONST headban$ = "Filename Length Size SF% Time Date Method CRC"
'--5---10---15---20---25---30---35---40---45---50---55---60---65---70---75
banner1$ = STRING$(75, "═")
COLOR 15, 0
Switches
END
SUB arcview (filestr$)
DIM dummy AS STRING * 20
DIM arc AS header 'header is in include file
OPEN filestr$ FOR BINARY AS 1 LEN = LEN(arc)
'Display Banner
a$ = FileStru$(filestr$)
b$ = "ZV Archive : " + a$
center b$
showmsg banner1$
showmsg headban$
showmsg banner1$
leng& = LOF(1)
FOR n% = 1 TO 32767 '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
IF n% = 1 THEN olddate% = arc.adate
IF olddate% <= arc.adate THEN
olddate% = arc.adate
oldtime% = arc.atime
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
FOR x% = 1 TO 13
IF MID$(arc.FileName, x%, 1) = CHR$(0) THEN EXIT FOR
FileName$ = FileName$ + MID$(arc.FileName, x%, 1)
NEXT x%
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$(12 - LEN(FileName$))
f$ = factor$(arc.NewSize, arc.OldSize)
D$ = Long2str$(arc.NewSize, 8)
e$ = Long2str$(arc.OldSize, 8)
PadCrc$ = HEX$(arc.CRC)
PadCrc$ = PadNum$(PadCrc$, 4)
g$ = FileName$ + C$ + D$ + e$ + f$ + ntime$ + ndate$ + met$ + PadCrc$
showmsg g$
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
FileName$ = ""
NEXT n%
SEEK 1, LOF(1) - 20
GET 1, , dummy$
CLOSE 1
IF INSTR(dummy$, "PK") THEN comp$ = "PAK3.6" ELSE comp$ = "ARC"
'Show trailer
IF redate% THEN CALL Update(olddate%, oldtime%, filestr$)
oldate$ = fixdate$(olddate%)
oldtime$ = fixtime$(oldtime%)
showmsg banner1$
g$ = Numfix$(n%) + Long2str$(totcomp&, 8) + Long2str$(totunc&, 8) + factor$(totcomp&, totunc&) + oldtime$ + oldate$ + comp$
showmsg g$
END SUB
SUB arjvu (filestr$)
'EA 60 header ID
OPEN filestr$ FOR BINARY AS 1
IF exeflag% THEN SEEK 1, SpecSeek%
DIM head AS arjheader
DIM extra AS arjextra
DIM one AS STRING * 1
'Display Banner
a$ = FileStru$(filestr$)
b$ = "ZV Archive : " + a$
center b$
showmsg banner1$
showmsg headban$
showmsg banner1$
leng& = LOF(1)
'This first get gets the archive name
GET 1, , head
FOR p% = 0 TO 13
a$ = INPUT$(1, 1) 'Search for ASCIIZ(0)
IF a$ = "/" THEN p% = p% - 1
IF a$ = CHR$(0) THEN EXIT FOR
namefile$ = namefile$ + a$
NEXT p%
version$ = STR$(ASC(head.vers))
IF exeflag% THEN version$ = " SFX"
DO
GET 1, , one 'Testing for comments
IF one = CHR$(0) THEN EXIT DO
' PRINT #5, one; 'Prints the comments
LOOP
SEEK 1, SEEK(1) + 6 'I don't know why??
namefile$ = ""
'This is the root of the program
DO WHILE NOT EOF(1)
GET 1, , head
IF exeflag% AND NOT head.id = -5536 THEN
showmsg "Non-standard ARJ-SFX header - not supported"
CLOSE 1
EXIT SUB
END IF
IF head.HeadSz = 0 THEN EXIT DO
n% = n% + 1 'count number of files
FOR p% = 0 TO 13
a$ = INPUT$(1, 1)
IF a$ = "/" THEN
p% = p% - 4 'I don't know why???
subd$ = subd$ + namefile$ + a$
namefile$ = ""
subdir% = -1
a$ = ""
END IF
IF a$ = CHR$(0) THEN EXIT FOR 'file name is ASCIIZ
namefile$ = namefile$ + a$
NEXT p%
b$ = namefile$ + SPACE$(12 - (LEN(namefile$))) 'Centers the display
GET 1, , extra
namefile$ = ""
fulsize& = fulsize& + head.origsize 'for synopsis line
totarc& = totarc& + head.sizenow
origsize$ = Long2str$(head.origsize, 8)
sizenow$ = Long2str$(head.sizenow, 8)
IF n% = 1 THEN olddate% = head.date
IF olddate% <= head.date THEN
olddate% = head.date
oldtime% = head.time
END IF
b$ = b$ + sizenow$ + origsize$ + factor$(head.sizenow, head.origsize) + fixtime$(head.time) + fixdate$(head.date)
SELECT CASE ASC(head.meth)
CASE 0
meth$ = "Comp-0 "
CASE 1
meth$ = "Comp-1 "
CASE 2
meth$ = "Comp-2 "
CASE 3
meth$ = "Comp-3 "
CASE 4
meth$ = "Comp-4 "
END SELECT
CRC$ = HEX$(head.origcrc) 'format CRC for display
CRC$ = PadNum$(CRC$, 8)
IF subdir% THEN 'show path
IF NOT C$ = subd$ THEN 'show path again if changed
showmsg subd$
C$ = subd$
subdir% = 0
END IF
END IF
subd$ = ""
b$ = b$ + meth$ + CRC$
showmsg b$
a& = SEEK(1)
a& = a& + head.sizenow - 3 'Admitted kludge
IF a& < 1 THEN EXIT DO
SEEK 1, a&
LOOP
CLOSE 1
showmsg banner1$
IF redate% THEN CALL Update(olddate%, oldtime%, filestr$)
oldate$ = fixdate$(olddate%)
oldtime$ = fixtime$(oldtime%)
showmsg banner1$
g$ = Numfix$(n%) + Long2str$(totarc&, 8) + Long2str$(fulsize&, 8) + factor$(totarc&, fulsize&) + oldtime$ + oldate$ + "Arj" + version$
showmsg g$
END SUB
SUB center (text$)
C$ = SPACE$((80 - LEN(text$)) \ 2 - 3) 'Center line
text$ = C$ + text$
showmsg text$
showmsg banner1$
END SUB
FUNCTION FileStru$ (filespec$)
DIM regs AS RegTypeX
'File structures
DIM fi AS filestruct
temp$ = filespec$ + CHR$(0)
regs.ax = &H1A00 'DOS service to set DTA
regs.ds = VARSEG(fi)
regs.dx = VARPTR(fi)
CALL INTERRUPTX(&H21, regs, regs)
regs.ax = &H4E00 'Find first matching file
regs.cx = 0 'reg files
regs.ds = VARSEG(temp$)
regs.dx = SADD(temp$)
CALL INTERRUPTX(&H21, regs, regs)
IF regs.flags AND 1 THEN
a$ = filespec$ + " File not Found"
FileStru$ = a$
EXIT FUNCTION
END IF
' PRINT fixdate$(fi.datef),
' PRINT fixtime$(fi.timef),
' PRINT fi.size,
' PRINT fi.nameff 'parse for AsciiZ
a$ = fi.nameff + Long2str$(fi.size, 8) + " " + fixtime(fi.Timef) + fixdate(fi.Datef)
FileStru$ = a$
END FUNCTION
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$)
SHARED pause%
IF filestr$ = "" THEN
CLS
PRINT #5, "Filename: ";
LINE INPUT filestr$
END IF
IF INSTR(filestr$, "?") THEN wild% = -1
IF INSTR(filestr$, "*") THEN wild% = -1
mark% = INSTR(filestr$, ".")
IF mark% = 0 THEN 'temp is left part of filename
temp$ = filestr$
filestr$ = filestr$ + ".*"
ELSE temp$ = LEFT$(filestr$, mark% - 1)
END IF
markstar% = INSTR(filestr$, "*")
IF markstar% THEN wild% = -1
IF markstar% THEN markstar2% = INSTR(markstar% + 1, filestr$, "*")
IF markstar2% THEN dwild% = -1 '*.*
IF markstar% AND markstar% < mark% THEN dwild% = -1
'PRINT markstar%, mark%, markstar2%, wild%, dwild%
IF mark% AND NOT markstar% THEN ext$ = UCASE$(MID$(filestr$, mark% + 1)) 'full filename
IF ext$ = "COM" THEN exeflag% = -1
IF ext$ = "EXE" THEN exeflag% = -1
IF INSTR("PAKARCARJZIPZOOLZH", ext$) AND NOT wild% THEN
namef$ = filestr$
GOTO gotit
END IF
again:
ext$ = guss$(filestr$)
IF exeflag% THEN filestr$ = temp$ + ".EXE" ELSE filestr$ = temp$ + "." + ext$
IF dwild% THEN filestr$ = namef$
gotit:
IF errlevel% GOTO again
'pakview namef$
'END
SELECT CASE ext$
CASE "LZH"
lzhview namef$
CASE "ZIP"
zipview namef$
CASE "ARC"
arcview namef$
CASE "ZOO"
zooview namef$
CASE "PAK"
pakview namef$
CASE "ARJ"
arjvu namef$
CASE "COM"
exeflag% = -1
lzhview namef$
CASE "EXE"
exeflag% = -1
ext$ = guss$(filestr$)
GOTO again
CASE "SQZ"
sqzvu namef$
CASE "PKLITE"
showmsg filestr$ + " is compressed by PKLite"
CASE "DIET"
showmsg filestr$ + " is compressed by DIET"
CASE "LZE"
showmsg filestr$ + " is compressed by LZE"
CASE ELSE
'showmsg "Cannot view " + filestr$
CLOSE 1
' END
END SELECT
IF wild% THEN
'IF ready% THEN
showmsg banner1$
showmsg banner1$
PRINT #5, " "
IF wild% THEN filestr$ = temp$ + ".*"
IF pause% THEN
PRINT #5, "-=MORE=-[ESC] to end";
IF count% < 23 THEN
DO
aa$ = INKEY$
LOOP WHILE aa$ = ""
END IF
cursor
LOCATE , 1: PRINT #5, " "
IF aa$ = CHR$(27) THEN END
END IF
count% = 1
exeflag% = 0
GOTO again
END IF
END SUB
SUB lzhview (filestr$)
DIM buf AS STRING * 40
DIM lz AS head1
DIM lzh AS Head2
DIM lzhc AS head3
DIM abcd AS STRING * 3 'this is the diff from lh113b
'd% = (LEN(lz) + LEN(lzh))
OPEN filestr$ FOR BINARY AS 1 LEN = LEN(lzh)
IF exeflag% THEN
DIM m AS STRING * 80
GET 1, , m$
mark% = INSTR(m$, "LH")
comp$ = MID$(m$, mark%, 17)
IF INSTR(comp$, "LHarc") THEN oldtype% = -1
IF NOT oldtype% THEN comp$ = LEFT$(comp$, 15)
'PRINT comp$
IF RIGHT$(comp$, 1) = "L" THEN lmodel% = -1
IF NOT lmodel% THEN plac% = &H665
IF lmodel% THEN plac% = &H795
IF oldtype% AND lmodel% THEN plac% = &H750
IF oldtype% AND NOT lmodel% THEN plac% = &H4F1
SEEK 1, plac%
GET 1, , buf$
'PRINT buf$
mark% = INSTR(buf$, "-lh")
SEEK 1, plac% + (mark% - 3)
END IF
a$ = FileStru$(filestr$)
b$ = "ZV Archive : " + a$
center b$
showmsg banner1$
showmsg headban$
showmsg banner1$
FOR n% = 1 TO 32767 'arbitrary number
GET 1, , lz 'From include file
GET 1, , lzh 'Filename length is variable
IF n% = 1 THEN olddate% = lzh.dat 'save newest date:time
IF olddate% <= lzh.dat THEN
olddate% = lzh.dat
oldtime% = lzh.tim
END IF
ti$ = fixtime$(lzh.tim) 'Unpack date and time
da$ = fixdate$(lzh.dat)
fl% = ASC(lzh.fnl) 'This is the filename length
IF fl% = 0 THEN EXIT FOR 'If len is 0 then exit
LzhName$ = INPUT$(fl%, 1) 'Get the number of chars in filename length
GET 1, , lzhc 'get the CRC value
'this is the difference from LHArc/LHA
IF INSTR("-lh4-lh5-", lzh.mtd) AND NOT exeflag% THEN GET 1, , abcd$
PadCrc$ = HEX$(lzhc.CRC)
PadCrc$ = PadNum$(PadCrc$, 4)
TotSize& = TotSize& + lzh.nsz
OldSize& = OldSize& + lzh.osz 'retain the file sizes
'Format the display with spaces
C$ = SPACE$(12 - LEN(LzhName$))
D$ = Long2str$(lzh.nsz, 8)
e$ = Long2str$(lzh.osz, 8)
b$ = LzhName$ + C$ + D$ + e$ + factor$(lzh.nsz, lzh.osz) + ti$ + da$ + lzh.mtd + " " + PadCrc$
showmsg b$
'PRINT lzh.mtd
place& = SEEK(1) + lzh.nsz 'Move file pointer for next file
SEEK 1, place& '- 3
IF place& >= LOF(1) THEN EXIT FOR 'At end yet?
NEXT n%
CLOSE 1
'Format and print trailer
IF lzh.mtd = "-lh1-" THEN oldtype% = -1
IF NOT exeflag% AND oldtype% THEN comp$ = "LHarc.113"
IF NOT oldtype% AND NOT exeflag% THEN comp$ = "LHA.2+"
IF redate% THEN CALL Update(olddate%, oldtime%, filestr$)
oldate$ = fixdate$(olddate%)
oldtime$ = fixtime$(oldtime%)
showmsg banner1$
g$ = Numfix$(n%) + Long2str$(TotSize&, 8) + Long2str$(OldSize&, 8) + factor$(TotSize&, OldSize&) + oldtime$ + oldate$ + comp$
showmsg g$
END SUB
SUB pakview (filestr$)
DIM pak AS paktype
'2199h
OPEN filestr$ FOR BINARY AS 1
IF exeflag% THEN SEEK 1, &H219A 'Where did this come from ???
'Format and display banner
a$ = FileStru$(filestr$)
b$ = "ZV Archive : " + a$
center b$
showmsg banner1$
showmsg headban$
showmsg banner1$
IF exeflag% THEN SEEK 1, SpecSeek% '&H219A '1AD4
FOR n% = 1 TO 32767 'largest integer
GET 1, , pak
SELECT CASE ASC(pak.version)
CASE 0 ' End of file. File header is only 2 bytes long (26 and 0).
meth$ = "---------"
EXIT FOR
CASE 1 ' No compression. File header lacks the Length field.
meth$ = "--------- "
CASE 2 ' No compression.
meth$ = "None "
CASE 3 ' Run-length encoding (RLE).
meth$ = "RLE "
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
IF n% = 1 THEN olddate% = pak.date
IF olddate% <= pak.date THEN
olddate% = pak.date
oldtime% = pak.time
END IF
IF ASC(pak.version) < 7 THEN comp$ = "ARC/ARCA"
IF ASC(pak.version) = 7 THEN comp$ = "PAK 1.0 "
IF ASC(pak.version) > 8 THEN comp$ = "PAK 2.0 "
mark% = INSTR(pak.FileName, CHR$(0))
FileName$ = LEFT$(pak.FileName, mark% - 1)
C$ = SPACE$(12 - LEN(FileName$))
pdate$ = fixdate$(pak.date)
ptime$ = fixtime$(pak.time)
i$ = Long2str$(pak.length, 8)
j$ = Long2str$(pak.size, 8)
PadCrc$ = HEX$(pak.CRC)
PadCrc$ = PadNum$(PadCrc$, 4)
b$ = FileName$ + C$ + i$ + j$ + factor$(pak.length, pak.size) + ptime$ + pdate$ + meth$ + PadCrc$
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%
CLOSE 1
IF redate% THEN CALL Update(olddate%, oldtime%, filestr$)
oldtime$ = fixtime$(oldtime%)
oldate$ = fixdate$(olddate%)
'Format trailer
showmsg banner1$
g$ = Numfix$(n%) + Long2str$(size&, 8) + Long2str$(nsize&, 8) + factor$(size&, nsize&) + oldtime$ + oldate$ + comp$
showmsg g$
END SUB
SUB showmsg (Msg$)
SHARED cr$
count% = count% + 1
PRINT #5, Msg$ + cr$
IF count% MOD 23 = 0 THEN
IF pause% THEN
PRINT #5, "-=MORE=-[ESC] to end";
DO
aa$ = INKEY$
LOOP WHILE aa$ = ""
cursor
x% = CSRLIN
IF x% > 1 THEN LOCATE x% - 1, 1
IF aa$ = CHR$(27) THEN END
END IF
END IF
END SUB
SUB sqzvu (filestr$)
DIM dummy AS STRING * 1
DIM extraword AS INTEGER
DIM sqh AS Sqheader
DIM sq AS Sqfheader
'if exeflag% then compressed with PKLite
'Display Banner
a$ = FileStru$(filestr$)
b$ = "ZV Archive : " + a$
center b$
showmsg banner1$
showmsg headban$
showmsg banner1$
'TYPE Sqheader
' sig AS STRING * 5
' vers as string * 1
' os AS STRING * 1
' flag AS STRING * 1
'END TYPE
'TYPE Sqfheader
' HeadSz AS STRING * 1
' Alg AS STRING * 1
' flag AS STRING * 1
' NewSize AS LONG
' OldSize AS LONG
' DateTime AS LONG
' Attr AS STRING * 1
' CRC AS LONG
'END TYPE
OPEN filestr$ FOR BINARY AS 1
GET 1, , sqh
comp$ = "Sqeeze V." + sqh.vers
FOR n% = 1 TO 4096 'Max # of file members
GET 1, , sq
length% = ASC(sq.HeadSz) - 20
IF length% < 0 THEN EXIT FOR
FOR x% = 1 TO length%
GET 1, , dummy$
FileName$ = FileName$ + dummy$
NEXT x%
GET 1, , extraword%
IF n% = 1 THEN olddate% = sq.Datef
IF olddate% <= sq.Datef THEN
olddate% = sq.Datef
oldtime% = sq.Timef
END IF
method$ = STR$(ASC(sq.flag)) + " "
modtime$ = fixtime$(sq.Timef)
moddate$ = fixdate$(sq.Datef)
CRC$ = HEX$(sq.CRC)
h$ = SPACE$(12 - LEN(FileName$))
i$ = Long2str$(sq.NewSize, 8)
j$ = Long2str$(sq.OldSize, 8)
k$ = factor$(sq.NewSize, sq.OldSize)
g$ = FileName$ + h$ + i$ + j$ + k$ + modtime$ + moddate$ + method$ + CRC$
showmsg g$
'PRINT extraword%
total& = total& + sq.OldSize
tot& = tot& + sq.NewSize
FileName$ = ""
place& = SEEK(1)
SEEK 1, place& + sq.NewSize
NEXT n%
CLOSE 1
'File header:
' offset Size Comment
' 0 1 Header size and type
' 0 -> End of archive
' 1 -> Comment
' 2 -> Password
' 3 -> Security envelope
' 4..18 -> future use
' 19.. -> normal file header
' if normal file
' 1 1 Header algebraic sum & 0FFh
' 0 1:76543210
' xxxxXXXX Method 0..4(15)
' xxx1xxxx Security envelope should follow
' XXXxxxxx Future use
' 1 4 Compressed size
' 5 4 Original size
' 9 4 Last DateTime
' 13 1 Attributes
' 14 4 CRC
' 18.. (size-18) filename, w/o \0.
'
'
'If End of archive, done
'If > 18 normal file
' Read HeaderSum(1 byte)
' Read size bytes
' Calculate headersum
' {short i; unsigned short s = 0U;
' for(i = 0; i < size; i++)
' s += header[i];
' if(headersum != (unsigned char)s) WRONG HEADERSUM
' header[size] = '\0'; // just to makes things easier to handle, ie.
' // zero terminate filename
' <= 18
' Next word gives number of bytes which are used, excluding this word
' COMMENT:
' 0 2 Number of bytes in comment
' Uncompressed size = this field - 7
' 2 2 Number of bytes compressed
' 4 1:76543210
' xxxxXXXX Method 0..4(15)
' xxx1xxxx Security envelope should follow
' XXXxxxxx Future use
' 5 4 CRC
' 9 size-9 Comment
' PASSWORD:
' 0 2 4
' 2 4 CRC for password
'
' **************************************************************
' I'm not done thinking about this one yet, so I'll be in touch.
' **************************************************************
' SECURITY ENVELOPE:
' 0 2 n
' n 1 None of your buisness (to be honest, I'm not done yet)
' OTHERWISE:
' 0 2 Number of bytes to skip
'
oldate$ = fixdate$(olddate%)
oldtime$ = fixtime$(oldtime%)
showmsg banner1$
g$ = Numfix$(n% - 1) + Long2str$(tot&, 8) + Long2str$(total&, 8) + factor$(tot&, total&) + oldtime$ + oldate$ + comp$
showmsg g$
END SUB
SUB Switches 'parse the command line
'can have:
' -N (nopause), x
' -O (outfile redirection),
' -D (redate),
' -E (errorlevel),
' filename$.
SHARED redate%, cr$
IF online% THEN cr$ = CHR$(13) + CHR$(10) 'for bbs use
pause% = -1
CmdLine$ = COMMAND$
IF INSTR(CmdLine$, "-E") THEN
errlevel% = -1
cmd$ = CmdLine$
END IF
IF INSTR(CmdLine$, "-O") THEN
pause% = 0
cmd$ = CmdLine$
top:
mark% = INSTR(cmd$, "-")
IF MID$(cmd$, mark% + 1, 1) = "O" THEN
FOR x% = 2 TO 13
IF MID$(cmd$, x% + mark%, 1) = " " THEN EXIT FOR
FileName$ = FileName$ + MID$(cmd$, x% + mark%, 1)
NEXT x%
ELSE
cmd$ = MID$(cmd$, mark% + 1)
GOTO top
END IF
OPEN FileName$ FOR APPEND AS 5
a$ = CHR$(10) + DATE$ + " " + TIME$ + " Dix Archive Directory Viewer V.23 "
center a$
ELSE
'OPEN "cons:" FOR OUTPUT AS 5 'See showmsg for info on this
OPEN "scrn:" FOR OUTPUT AS 5 'See showmsg for info on this
END IF
showmsg CHR$(10) + CHR$(13)
IF CmdLine$ = "?" THEN
showmsg "ZV filename [options: -N -D -Ofilename]"
showmsg "ARC,ARJ,LZH,PAK,ZIP,ZOO,PKLite,Diet,LZE or sfx files"
showmsg "ZV - archive directory list - Dick Dennison C.1990,1992."
showmsg ""
showmsg "Options : "
showmsg "-N (nopause)"
showmsg "-Ofilename (outputfile redirection - implies -N)"
showmsg "-D (redate)"
showmsg "-E (exit with errorlevel as to flavor of archive : "
showmsg " 1 = ARC"
showmsg " 2 = ARJ"
showmsg " 3 = LZH" 'Must compile as standalone to
showmsg " 4 = PAK" 'exit with errorlevel with QB45
showmsg " 5 = ZIP"
showmsg " 6 = ZOO"
showmsg " 7 = PKLite"
showmsg " 8 = DIET"
showmsg " 9 = LZE"
END
END IF
IF INSTR(CmdLine$, "-N") THEN pause% = 0
IF INSTR(CmdLine$, "-D") THEN redate% = -1
mark% = INSTR(CmdLine$, " ")
IF mark% THEN
cmd$ = LEFT$(CmdLine$, mark% - 1)
ELSE
cmd$ = CmdLine$
END IF
IF cmd$ = "" THEN cmd$ = getdir$
getname cmd$
END SUB
SUB zipview (filestr$)
DIM cent AS central
'PRINT filestr$
'dirsig$ = "02014B50" '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)
a$ = FileStru$(filestr$)
b$ = "ZV Archive : " + a$
center b$
showmsg banner1$
showmsg headban$
showmsg banner1$
place& = LOF(1) - LEN(buf)
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 LOF(1)
IF place& - Z& < 1 THEN 'searching backwards
showmsg "ZIP signature not found"
END
END IF
SEEK 1, place& - Z&
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
IF cent.extralen THEN SEEK 1, SEEK(1) + cent.extralen
IF cent.commentlen THEN SEEK 1, SEEK(1) + cent.commentlen
GET #1, , cent 'get central directory record
IF HEX$(cent.sig) = "6054B50" THEN EXIT FOR 'at end yet?
FileName$ = INPUT$(cent.namelen, 1)
'subdirectory pathname?
mark% = linstr%(FileName$, "/")
IF mark% THEN
subd$ = LEFT$(FileName$, mark%)
showmsg subd$
FileName$ = MID$(FileName$, mark% + 1)
mark% = 0
END IF
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 "
CASE IS = 7
method$ = "Tokenized "
CASE IS = 9
method$ = "Deflated "
CASE ELSE
method$ = "Unknown "
END SELECT
IF method$ = "Imploded " THEN
xz% = cent.bitflag AND 6
IF xz% = 4 THEN method$ = "Implode-8 "
IF xz% = 0 THEN method$ = "Implode-4 "
IF xz% = 6 THEN method$ = "Implode-8 "
END IF
IF n% = 1 THEN
temp$ = STR$(cent.vers \ 10)
comp$ = "PKZ" + temp$ + "." + LTRIM$(STR$(cent.vers MOD 10))
END IF
CRC$ = HEX$(cent.CRC)
IF LEN(CRC$) < 8 THEN CRC$ = STRING$(8 - LEN(CRC$), "0") + CRC$
IF n% = 1 THEN olddate% = cent.moddate
IF olddate% <= cent.moddate THEN
olddate% = 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$(12 - LEN(FileName$))
i$ = Long2str$(cent.compsize, 8)
j$ = Long2str$(cent.uncompsize, 8)
k$ = factor$(cent.compsize, cent.uncompsize)
g$ = FileName$ + h$ + i$ + j$ + k$ + modtime$ + moddate$ + method$ + CRC$
showmsg g$
total& = total& + cent.uncompsize 'retain size totals
tot& = tot& + cent.compsize
NEXT n%
CLOSE 1
IF redate% THEN CALL Update(olddate%, oldtime%, filestr$)
oldate$ = fixdate$(olddate%)
oldtime$ = fixtime$(oldtime%)
showmsg banner1$
g$ = Numfix$(n% - 1) + Long2str$(tot&, 8) + Long2str$(total&, 8) + factor$(tot&, total&) + oldtime$ + oldate$ + comp$
showmsg g$
END SUB
SUB zooview (filestr$)
DIM head AS zoomaster
DIM zoo AS zoofile
OPEN filestr$ FOR BINARY AS 1
'Display banner
a$ = FileStru$(filestr$)
b$ = "ZV Archive : " + a$
center b$
showmsg banner1$
showmsg headban$
showmsg banner1$
GET 1, , head 'Get central header and position file pointer to first file
comp$ = LEFT$(head.zoohead, 8)
FOR n% = 1 TO 32767 'arbitrary number
GET 1, , zoo
IF n% = 1 THEN olddate% = zoo.zoofdat
IF olddate% <= zoo.zoofdat THEN
olddate% = zoo.zoofdat
oldtime% = zoo.zooftim
END IF
ztime$ = fixtime$(zoo.zooftim) 'Unpack date and time
zdate$ = fixdate$(zoo.zoofdat)
IF zoo.zoofnxh = 0 OR zoo.zoofnxh > LOF(1) THEN EXIT FOR
IF ASC(zoo.zoofcmp) = 1 THEN 'Set text for compression method
meth$ = "-LZW- "
ELSE meth$ = "----- "
END IF
OldSize& = OldSize& + zoo.zoofosz 'save sizes
Newer& = Newer& + zoo.zoofnsz
'Format output with spaces
'Parse filename and format for printing
FOR x% = 1 TO 13
IF MID$(zoo.zoofnam, x%, 1) = CHR$(0) THEN EXIT FOR
FileName$ = FileName$ + MID$(zoo.zoofnam, x%, 1)
NEXT x%
'===
C$ = Long2str$(zoo.zoofosz, 8)
D$ = Long2str$(zoo.zoofnsz, 8)
b$ = FileName$ + C$ + D$ + factor$(zoo.zoofosz, zoo.zoofnsz) + ztime$ + zdate$ + meth$ + HEX$(zoo.zoofcrc)
'ucase$(zoo.zoofnam)
showmsg b$
SEEK 1, zoo.zoofnxh - 3 'Move file pointer to next file Note:don't know what the '3' is for
NEXT n%
CLOSE 1
IF redate% THEN CALL Update(olddate%, oldtime%, filestr$)
'Print trailer
showmsg banner1$
g$ = Numfix$(n% - 1) + Long2str$(OldSize&, 8) + Long2str$(Newer&, 8) + factor$(OldSize&, Newer&) + fixtime$(oldtime%) + fixdate$(olddate%) + comp$
showmsg g$
END SUB