home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
World of Shareware - Software Farm 2
/
wosw_2.zip
/
wosw_2
/
QBAS
/
QBZIPDIR.ZIP
/
ZIPTEST2.BAS
< prev
Wrap
BASIC Source File
|
1989-10-28
|
5KB
|
150 lines
DEFINT A-Z
DECLARE SUB zipdir (f$, z() AS ANY)
DECLARE FUNCTION Seekit& (name$, search$, ptr&)
'you should use these declarations
' in your application
TYPE zipdir
zby AS INTEGER ' version zipped by
needed AS INTEGER 'version needed to extract
flag AS INTEGER ' general purpose flag
compress AS INTEGER ' compression method
tim AS INTEGER ' time stamp
dat AS INTEGER ' date stamp
crc AS LONG ' crc-32
zsize AS LONG ' zipped size
nsize AS LONG ' unzipped size
fnlen AS INTEGER ' file name length
extralen AS INTEGER ' extra field length
commentlen AS INTEGER ' length of file comment
startdisk AS INTEGER ' starting disk #
intattr AS INTEGER ' internal attributes
extattr AS LONG ' file attribute flags
offset AS LONG ' offset into zip
buff AS STRING * 72 ' holds file name and comment
END TYPE
REM $DYNAMIC
DIM z(1) AS zipdir 'MUST be DIM'd as a dynamic
'array, since it is re-dimmed
'to the number of files
'in the ZIP
LINE INPUT "File to zip view?:"; f$
ON ERROR GOTO handler
OPEN f$ FOR INPUT AS #1: CLOSE #1 'phony check for existence of
' zip file
CALL zipdir(f$, z())
IF z(0).zby = -1 THEN 'zipdir sets this to a -1 if
PRINT "Not a ZIP" 'it can't find any zip file
END 'headers
END IF
PRINT STRING$(80, "-") 'show what we found
PRINT "Number of entries in ZIP: "; UBOUND(z)
PRINT STRING$(80, "-")
PRINT " Filename Attr Length Size Date Time CRC-32 Method"
FOR count = 1 TO UBOUND(z)
n = z(count).dat 'since the date is packed into
day = n AND &H1F '2 bytes, we need to unpack it
n = n \ 32
mnth = n AND &HF
n = z(count).dat
n = n \ 512
year = n + 1980
'pretty up the date a bit for display
dt$ = LTRIM$(RTRIM$(STR$(mnth))) + "-" + LTRIM$(RTRIM$(STR$(day))) + "-" + LTRIM$(RTRIM$(STR$(year)))
x = LEN(dt$): IF x < 10 THEN dt$ = dt$ + SPACE$(10 - x)
n = z(count).tim 'unpack the time
sec = n AND &H1F
n = n \ 32
min = n AND &H3F
hour = z(count).tim
hour = (hour \ 2048) AND &H1F
tm$ = LTRIM$(RTRIM$(STR$(hour))) + ":" + LTRIM$(RTRIM$(STR$(min))) + "." + LTRIM$(RTRIM$(STR$(sec)))
x = LEN(tm$): IF x < 8 THEN tm$ = tm$ + SPACE$(8 - x)
fil$ = MID$(z(count).buff, 1, z(count).fnlen)
x = LEN(fil$): IF x < 12 THEN fil$ = fil$ + SPACE$(12 - x)
PRINT fil$; " "; 'determine the file attributes
fattr = z(count).extattr AND &HF
SELECT CASE fattr
CASE 0
attr$ = "--w" 'normal
CASE 1
attr$ = "--r" 'read only
CASE 2
attr$ = "--h" ' hidden
CASE 3
attr$ = "-rh" ' hidden and read only
CASE IS >= 4
attr$ = "--s" 'shortcut... (check DOS technical manual)
END SELECT
crypt = z(count).flag AND &H1
IF crypt > 0 THEN 'is it an encrypted file?
attr$ = attr$ + "*"
ELSE
attr$ = attr$ + " "
END IF
PRINT attr$; " ";
PRINT USING "######"; z(count).nsize; 'uncompressed size
PRINT " ";
PRINT USING "######"; z(count).zsize; 'compressed size
PRINT " ";
PRINT dt$; " "; tm$; " "; HEX$(z(count).crc); " "; 'crc
SELECT CASE z(count).compress 'show method of compression
CASE 0
method$ = "Stored"
CASE 1
method$ = "Shrunk"
CASE 2
method$ = "Reduce-1"
CASE 3
method$ = "Reduce-2"
CASE 4
method$ = "Reduce-3"
CASE 5
method$ = "Reduce-4"
CASE 6
method$ = "Imploded"
CASE ELSE
method$ = "Unknown"
END SELECT
PRINT method$
'get the file comment
fcom$ = MID$(z(count).buff, z(count).fnlen + 1, z(count).commentlen)
' PRINT "File Comment: "; fcom$
NEXT
'print the zipfile comment
PRINT "Zip Comment: "; MID$(z(0).buff, 1, 60)
END
handler:
PRINT "File does not exist"
END