home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / magazine / qbnewsl / qbnws105 / zv / zv.bas < prev   
BASIC Source File  |  1990-10-24  |  15KB  |  501 lines
  1. ' ZV      BAS : A Quick Basic archive file viewer for MS-DOS machines
  2. ' author .....: Dick Dennison    [74270,3636]  914-374-3903 3/12/24 24 hrs
  3. ' supports ...: ZIP, LZH, ARC, PAK, ZOO archive formats
  4. ' syntax .....: ZV FILENAME
  5. ' returns ....: The member filespecs in the archive
  6. ' includes ...: DIXARC02.INC = contains archive structures
  7. ' notes ......: All output is thru dos
  8. '             : This is to allow easy porting to comm port routines
  9. ' cost .......: Free = Credit where credit due
  10. '             : Do not use as is for commercial use - may not be resold
  11. '             : May not be rebundled without prior written consent
  12. ' trademarks .: ZIP is the property of Phil Katz
  13. '             : ARC is the property of SEA
  14. '             : ZOO is the property of Rahul Dhesi
  15. '             : PAK is the property of NoGate Consulting
  16. '             : Lharc is the property of Yoshi
  17. '             : MS-DOS is the property of MicroSoft
  18. ' dated ......: 10/24/90
  19.  
  20. DECLARE SUB pakview (filestr$)
  21. DECLARE SUB zooview (filestr$)
  22. DECLARE SUB arcview (filestr$)
  23. DECLARE SUB getname (filestr$)
  24. DECLARE FUNCTION fixtime$ (parm%)
  25. DECLARE FUNCTION fixdate$ (parm%)
  26. DECLARE SUB viewlzh (filestr$)
  27. DECLARE SUB showmsg (Msg$)
  28. DECLARE SUB zipview (filestr$)
  29.  
  30. '$INCLUDE: 'dixarc02.inc'
  31.  
  32. DIM SHARED mon(13) AS STRING
  33. mon$(1) = "-Jan-": mon$(2) = "-Feb-": mon$(3) = "-Mar-": mon$(4) = "-Apr-"
  34. mon$(5) = "-May-": mon$(6) = "-Jun-": mon$(7) = "-Jul-": mon$(8) = "-Aug-":
  35. mon$(9) = "-Sep-": mon$(10) = "-Oct-": mon$(11) = "-Nov-": mon$(12) = "-Dec-"
  36. DIM SHARED banner$
  37. banner$ = STRING$(75, "═")
  38.  
  39. OPEN "cons:" FOR OUTPUT AS 5   'See showmsg for info on this
  40. showmsg CHR$(10) + CHR$(13)
  41.  
  42. IF COMMAND$ = "" THEN
  43.     showmsg "ZV filename   {where filename is a PAK,ARC,ZIP,ZOO,LZH file}"
  44.     END
  45. END IF
  46. getname COMMAND$
  47. END
  48.  
  49. SUB arcview (filestr$)
  50. DIM arc AS header   'header is in include file
  51.  
  52. OPEN filestr$ FOR BINARY AS 1 LEN = LEN(arc)
  53.  
  54. 'Display Banner
  55. b$ = "DIX ARCview - Archive: " + filestr$ + STR$(LOF(1))
  56. c$ = SPACE$((80 - LEN(b$)) \ 2 - 3)      'Center line
  57. b$ = c$ + b$
  58. showmsg b$
  59. showmsg banner$
  60.  
  61. b$ = "Filename        Size    Old Size  Date       Time       Method    CRC"
  62. showmsg b$
  63. showmsg banner$
  64.  
  65. leng& = LOF(1)
  66. FOR n% = 1 TO 100   'arbitrary number
  67.     GET 1, , arc
  68.     sig% = arc.arcid AND 255   'Low order of byte is ID signature
  69.     meth% = arc.arcid \ 256    'Method of compression in high order
  70.     IF sig% <> 26 THEN
  71.         n% = n% - 1
  72.         EXIT FOR
  73.     END IF
  74.     IF meth% < 1 THEN
  75.         n% = n% - 1
  76.         EXIT FOR
  77.     END IF
  78.     ntime$ = fixtime$(arc.atime)
  79.     ndate$ = fixdate$(arc.adate)
  80.     mark% = INSTR(arc.filename, ".")
  81.     IF mark% < 2 THEN mark% = 9  'incase filename has no extension
  82.    
  83.     'Parse filename and format for printing
  84.     filename$ = LEFT$(arc.filename, mark% - 1) + MID$(arc.filename, mark%, 4)
  85.   SELECT CASE meth%        ' Select correct compression text
  86.     CASE IS = 1
  87.         met$ = "------  "  ' No compression used
  88.     CASE IS = 2
  89.         met$ = "Stored  "  ' Repeated running length encoding (RLE)
  90.     CASE IS = 3
  91.         met$ = "Packed  "  ' Huffman encoding
  92.     CASE IS = 4
  93.         met$ = "Squeezed"  ' LZW with 4K buffer, 12 bits codes
  94.     CASE IS = 5
  95.         met$ = "crunched"  ' First packing, then LZW 4K buffer with 12 bits
  96.     CASE IS = 6
  97.         met$ = "crunched"  ' Packing, LZW, 4K buffer, vari len (9-12 bits)
  98.     CASE IS = 7
  99.         met$ = "Crunched"  ' LZW, 8K buffer, variable length (9-13 bits)
  100.     CASE IS = 8
  101.         met$ = "Crunched"
  102.     CASE IS = 9
  103.         met$ = "Squashed"
  104.     CASE IS = 10
  105.         met$ = "Crushed "  ' Packing, then LZW 8K buffer, 2-13 bits (PAK 1.0)
  106.     CASE IS = 11
  107.         met$ = "Distill "  ' Dynamic Huffman with 8K buffer (PAK 2.0)
  108.     CASE ELSE
  109.         met$ = "--------"  ' usually -1
  110.   END SELECT
  111.  
  112.   totcomp& = totcomp& + arc.newsize  'Get the totals for the archive
  113.   totunc& = totunc& + arc.oldsize
  114.  
  115.   'Because the filesizes are different lengths we need to
  116.   'Parse the display and add spacing
  117.   c$ = SPACE$(15 - LEN(filename$))
  118.   d$ = SPACE$(8 - LEN(STR$(arc.newsize)))
  119.   e$ = SPACE$(11 - LEN(STR$(arc.oldsize)))
  120.  
  121.   b$ = filename$ + c$ + STR$(arc.newsize) + d$ + STR$(arc.oldsize) + e$ + ndate$ + "  " + ntime$ + "   " + met$ + "  " + HEX$(arc.CRC) + cr$
  122.   showmsg b$
  123.  
  124.   where& = SEEK(1)
  125.   IF totcomp& + n% * LEN(arc) >= leng& THEN EXIT FOR
  126.   IF LEN(header) + where& + arc.newsize >= leng& THEN EXIT FOR 'At end yet?
  127.   SEEK 1, where& + arc.newsize   'Position read/write head for next file get
  128. NEXT n%
  129. CLOSE 1
  130. 'Show trailer
  131. showmsg banner$
  132. b$ = STR$(n%) + " files" + SPACE$(7) + STR$(totcomp&) + "  " + STR$(totunc&) + cr$
  133. showmsg b$
  134.  
  135. END SUB
  136.  
  137. FUNCTION fixdate$ (parm%)
  138. 'Date and time are in packed format - these are the breakouts
  139. 'bits 00h-04h = day (1-31)
  140. 'bits 05h-08h = month (1-12)
  141. 'bits 09h-0Fh = year (relative to 1980)
  142.  
  143. day% = parm% AND 31        'get bits 0-4
  144. dayz$ = LTRIM$(STR$(day%))
  145. IF LEN(dayz$) = 1 THEN dayz$ = "0" + (dayz$)  'Parse and add leading 0 if needed
  146. parm% = parm% \ 32         'shift left 5
  147. month% = parm% AND 15      'get bits 5-8
  148. parm% = parm% \ 16         'shift left 4
  149. year% = (parm% AND 255) + 80    'get bits 9-15 and add to 1980
  150. moddate$ = dayz$ + mon$(month%) + LTRIM$(STR$(year%))  'Format is 20-Oct-90
  151.  
  152. fixdate$ = moddate$
  153.  
  154. END FUNCTION
  155.  
  156. FUNCTION fixtime$ (parm%)
  157. 'Date and time are in packed format - these are the breakouts
  158. 'bits 00h-04h = 2 second incs (0-29)
  159. 'bits 05h-0Ah = minutes (0-59)
  160. 'bits 0Bh-0Fh = hours (0-23)
  161.  
  162. Temp& = parm%
  163. IF parm% < 0 THEN Temp& = Temp& + 65536  'Check for sign (+ -)
  164. secs% = (Temp& AND 31) * 2  'get bits 0-4 and multiply by 2
  165. Temp& = Temp& \ 32          'shift right 5
  166. mins% = Temp& AND 63        'get bits 5-10
  167. Temp& = Temp& \ 64          'shift right 6
  168. hours% = Temp& AND 31       'get bits 11-15
  169. sec$ = LTRIM$(STR$(secs%))
  170. IF LEN(sec$) = 1 THEN sec$ = "0" + sec$    'Parse and add leading 0's
  171. min$ = LTRIM$(STR$(mins%))
  172. IF LEN(min$) = 1 THEN min$ = "0" + min$    'if needed
  173. hour$ = LTRIM$(STR$(hours%))
  174. IF LEN(hour$) = 1 THEN hour$ = "0" + hour$
  175.  
  176. modtime$ = hour$ + ":" + min$ + ":" + sec$  'Format is 01:30:46
  177. fixtime$ = modtime$
  178.  
  179. END FUNCTION
  180.  
  181. SUB getname (filestr$)
  182. OPEN filestr$ FOR APPEND AS 1
  183. IF LOF(1) = 0 THEN              'If file exist continue
  184.     CLOSE 1
  185.     KILL filestr$
  186.     showmsg "File not Found"
  187.     END
  188. END IF
  189. CLOSE 1
  190.                                 'Get file extension
  191. mark% = INSTR(filestr$, ".")
  192. a$ = MID$(filestr$, mark% + 1)
  193.  
  194. SELECT CASE UCASE$(a$)
  195.     CASE "LZH"
  196.         viewlzh filestr$
  197.     CASE "ZIP"
  198.         zipview filestr$
  199.     CASE "ARC"
  200.         arcview filestr$
  201.     CASE "ZOO"
  202.         zooview filestr$
  203.     CASE "PAK"
  204.         pakview filestr$
  205.     CASE ELSE
  206.         showmsg "Cannot view " + filestr$
  207.         END
  208. END SELECT
  209. END SUB
  210.  
  211. SUB pakview (filestr$)
  212. DIM pak AS paktype
  213.  
  214. OPEN filestr$ FOR BINARY AS 1
  215.  
  216. 'Format and display banner
  217. b$ = "DIX PAKview - Archive : " + filestr$ + "  " + STR$(LOF(1)) + " bytes"
  218. c$ = SPACE$((80 - LEN(b$)) \ 2 - 3)      'Center line
  219. b$ = c$ + b$
  220. showmsg b$
  221. showmsg banner$
  222. b$ = "Filename       Old size   New size  Method     Date        Time     CRC"
  223. showmsg b$
  224. showmsg banner$
  225.  
  226. FOR n% = 1 TO 100    'arbitrary number
  227.     
  228.     GET 1, , pak
  229.     SELECT CASE ASC(pak.version)
  230.         CASE 0 '  End of file.  File header is only 2 bytes long (26 and 0).
  231.             meth$ = "---------"
  232.         CASE 1 ' No compression. File header lacks the Length field.
  233.             meth$ = "---------"
  234.         CASE 2 ' No compression.
  235.             meth$ = "None     "
  236.         CASE 3 ' Run-length encoding (RLE).
  237.             meth$ = "REL      "
  238.         CASE 4 ' Huffman squeezing.
  239.             meth$ = "Huffman  "
  240.         CASE 5 ' Fixed-length 12 bit LZW compression.
  241.             meth$ = "12bit LZW"
  242.         CASE 6 ' As above, with RLE.
  243.             meth$ = "LZW w RLE"
  244.         CASE 7 ' As above, but with a different hashing scheme.
  245.             meth$ = "LZW w RLE"
  246.         CASE 8 ' Variable-length 9-12 bit LZW compression with RLE.
  247.             meth$ = "LZW w RLE"
  248.         CASE 9 ' Variable-length 9-13 bit LZW compression without RLE.
  249.             meth$ = "LZW n RLE"
  250.         CASE 10' Crushing
  251.             meth$ = "Crushing "
  252.         CASE 11
  253.             meth$ = "Distilled"
  254.         CASE ELSE
  255.             meth$ = "Unknown  "
  256.     END SELECT
  257.    
  258.     mark% = INSTR(pak.filename, CHR$(0))
  259.     filename$ = LEFT$(pak.filename, mark%)
  260.     c$ = SPACE$(14 - LEN(filename$))
  261.     pdate$ = fixdate$(pak.Date)
  262.     ptime$ = fixtime$(pak.Time)
  263.    
  264.     i$ = SPACE$(11 - LEN(STR$(pak.length)))
  265.     j$ = SPACE$(11 - LEN(STR$(pak.size)))
  266.  
  267.     b$ = filename$ + c$ + STR$(pak.length) + i$ + STR$(pak.size) + j$ + meth$ + "  " + pdate$ + "  " + ptime$ + "  " + HEX$(pak.CRC)
  268.     showmsg b$
  269.     size& = size& + pak.length
  270.     nsize& = nsize& + pak.size
  271.     place& = SEEK(1) + pak.size
  272.     IF place& >= LOF(1) - ((n%) * 30) THEN EXIT FOR  'allow for extended
  273.     SEEK 1, place&                                   'pak info before EOF
  274.     
  275.  
  276. NEXT n%
  277.  
  278. 'Format trailer
  279. showmsg banner$
  280. b$ = STR$(n%) + " files      " + STR$(size&) + "    " + STR$(nsize&)
  281. showmsg b$
  282. CLOSE 1
  283. END SUB
  284.  
  285. SUB showmsg (Msg$)
  286. 'This routine is here because this whole module was originally
  287. 'written for my bbs program - DIXbbs  Print to console
  288. 'One caveat is that it keeps dos colors
  289. PRINT #5, Msg$
  290. END SUB
  291.  
  292. SUB viewlzh (filestr$)
  293. DIM lz AS head1
  294. DIM lzh AS Head2
  295. DIM lzhc AS head3
  296. OPEN filestr$ FOR BINARY AS 1 LEN = LEN(lzh)
  297.  
  298.  
  299. b$ = "DIX Lharcview  -  Archive : " + filestr$ + "  " + STR$(LOF(1)) + " bytes"
  300. c$ = SPACE$((80 - LEN(b$)) \ 2 - 3)      'Center line
  301. b$ = c$ + b$
  302. showmsg b$
  303. showmsg banner$
  304.  
  305. b$ = "File            Size    Old size  Time       Date      Method   CRC" + cr$
  306. showmsg b$
  307. showmsg banner$
  308. FOR n% = 1 TO 100     'arbitrary number
  309.  
  310. GET 1, , lz     'From include file
  311. GET 1, , lzh    'Filename length is variable
  312.  
  313. ti$ = fixtime$(lzh.tim)   'Unpack date and time
  314. da$ = fixdate$(lzh.dat)
  315. fl% = ASC(lzh.fnl)        'This is the filename length
  316. LzhName$ = INPUT$(fl%, 1) 'Get the number of chars in filename length
  317. GET 1, , lzhc             'get the CRC value
  318. tmp$ = HEX$(lzhc.CRC)     'format it for display
  319.  
  320. 'Format the display with spaces
  321. c$ = SPACE$(15 - LEN(LzhName$))
  322. d$ = SPACE$(8 - LEN(STR$(lzh.nsz)))
  323. e$ = SPACE$(11 - LEN(STR$(lzh.osz)))
  324. old& = old& + lzh.osz          'retain the sizes
  325. b$ = LzhName$ + c$ + STR$(lzh.nsz) + d$ + STR$(lzh.osz) + e$ + ti$ + "   " + da$ + " " + lzh.mtd + "    " + tmp$ + cr$
  326. showmsg b$
  327.  
  328. place& = SEEK(1) + lzh.nsz    'Move file pointer for next file
  329. SEEK 1, place&
  330. IF place& >= LOF(1) THEN EXIT FOR    'At end yet?
  331. NEXT n%
  332.  
  333. 'Format and print trailer
  334. b$ = STR$(n%) + " files      " + STR$(LOF(1)) + "  " + STR$(old&)
  335. CLOSE 1
  336. showmsg banner$
  337. showmsg b$
  338.  
  339. END SUB
  340.  
  341. SUB zipview (filestr$)
  342. DIM cent AS central
  343.  
  344. 'dirsig$ = "2014B50"  'directory signature - don't really need this
  345. enddirsig$ = "6054B50"  'end of directory sig
  346.  
  347. DIM buf AS buftype
  348. DIM first AS dirrec
  349.  
  350. OPEN filestr$ FOR BINARY AS 1 LEN = LEN(cent)
  351.  
  352. b$ = "DIX Zipview - Archive : " + filestr$ + "   " + STR$(LOF(1)) + " bytes"
  353. c$ = SPACE$((80 - LEN(b$)) \ 2 - 3)      'Center line
  354. b$ = c$ + b$
  355. showmsg b$
  356. showmsg banner$
  357. b$ = "Filename        Size    Old Size  Date       Time      Method   Dict Trees" + cr$
  358. showmsg b$
  359. showmsg banner$
  360.  
  361. ' +++++++++++++++++++++++  NOTE  ++++++++++++++++++++++++++++++++++++++++
  362. 'The most difficult decision here is to decide where to start searching +
  363. 'ZIP banners are the problem  -  obviously a large offset will cover a  +
  364. 'greater number of banners but will be slower to find the signature     +
  365. ' +++++++++++++++++++++++  NOTE  ++++++++++++++++++++++++++++++++++++++++
  366.  
  367. offset% = 465   'this is the number to adjust
  368.  
  369. place& = LOF(1) - offset%      'covers most zipbanners
  370. IF place& < 1 THEN place& = 1   'make sure place& is > 0
  371. SEEK 1, place&    'Move file pointer near end of file and search for signature
  372.  
  373. FOR Z% = 1 TO offset%
  374.     SEEK 1, place& + Z%
  375.     IF place& + Z% >= LOF(1) THEN
  376.         showmsg "ZIP signature not found"
  377.         END
  378.     END IF
  379.     GET 1, , buf
  380.     IF enddirsig$ = HEX$(buf.lin) THEN       'search for zip signature
  381.         hit% = -1
  382.         place& = SEEK(1)
  383.         place& = place& - LEN(buf)  'reposition pointer to beginning of signature
  384.         SEEK 1, place&
  385.         EXIT FOR
  386.     END IF
  387. NEXT Z%
  388. GET #1, , first             'get zip record
  389. SEEK 1, first.offset + 1    'point to first record
  390. FOR n% = 1 TO first.num     'first.num is # of files in archive
  391.     GET #1, , cent          'get central directory record
  392.  
  393.     IF HEX$(cent.sig) = "6054B50" THEN EXIT FOR   'at end yet?
  394.     filename$ = LEFT$(cent.filename, cent.fnamelen)
  395.     SELECT CASE cent.compmeth   'Set text for compression method
  396.         CASE IS = 0
  397.             Method$ = "Stored"
  398.         CASE IS = 1
  399.             Method$ = "Shrunk"
  400.         CASE IS = 2
  401.             Method$ = "Reduced(1)"
  402.         CASE IS = 3
  403.             Method$ = "Reduced(2)"
  404.         CASE IS = 4
  405.             Method$ = "Reduced(3)"
  406.         CASE IS = 5
  407.             Method$ = "Reduced(4)"
  408.         CASE IS = 6
  409.             Method$ = "Imploded"
  410.     END SELECT
  411.     IF Method$ = "Imploded" THEN
  412.         xz% = cent.bitflag AND 6
  413.         IF xz% = 4 THEN Method$ = "Imploded 8K/d 2 SFano"
  414.         IF xz% = 0 THEN Method$ = "Imploded 4K/d 2 SFano"
  415.         IF xz% = 6 THEN Method$ = "Imploded 8K/D 3 SFano"
  416.     END IF
  417.  
  418.   IF n% = 1 THEN              'retain oldest date and time
  419.     oldest% = cent.moddate
  420.     oldtime% = cent.modtime
  421.   END IF
  422.   IF oldest% < cent.moddate THEN
  423.     oldest% = cent.moddate
  424.     oldtime% = cent.modtime
  425.   END IF
  426.  
  427.   'Unpack date and time
  428.   moddate$ = fixdate$(cent.moddate)
  429.   modtime$ = fixtime$(cent.modtime)
  430.  
  431.   'Format output with spaces
  432.   h$ = SPACE$(15 - LEN(filename$))
  433.   i$ = SPACE$(8 - LEN(STR$(cent.compsize)))
  434.   j$ = SPACE$(11 - LEN(STR$(cent.uncompsize)))
  435.  
  436.   g$ = filename$ + h$ + STR$(cent.compsize) + i$ + STR$(cent.uncompsize) + j$ + moddate$ + "  " + modtime$ + "  " + Method$ + cr$
  437.   showmsg g$
  438.  
  439.   total& = total& + cent.uncompsize      'retain size totals
  440.   tot& = tot& + cent.compsize
  441.   place& = SEEK(1)                       'Move file pointer
  442.   place& = place& - ((12 - cent.fnamelen) - cent.extralen) 'check for extra field
  443.   SEEK 1, place&
  444. NEXT n%
  445. CLOSE 1
  446. showmsg banner$
  447. olddate$ = fixdate$(oldest%)
  448. oldtime$ = fixtime$(oldtime%)
  449. g$ = STR$(first.num) + " files" + "       " + STR$(tot&) + " " + STR$(total&) + "     " + olddate$ + "  " + oldtime$
  450. showmsg g$
  451.  
  452. END SUB
  453.  
  454. SUB zooview (filestr$)
  455. DIM head AS zoomaster
  456. DIM f AS zoofile
  457. OPEN filestr$ FOR BINARY AS 1
  458.  
  459. 'Display banner
  460. b$ = "DIX ZOOview - Archive: " + filestr$ + STR$(LOF(1)) + " bytes"
  461. c$ = SPACE$((80 - LEN(b$)) \ 2 - 3)      'Center line
  462. b$ = c$ + b$
  463. showmsg b$
  464. showmsg banner$
  465.  
  466. b$ = "ZOO Filename    Old Size   New Size  Time      Date       CRC   Method"
  467. showmsg b$
  468. showmsg banner$
  469.  
  470. GET 1, , head    'Get central header and position file pointer to first file
  471.  
  472. FOR n% = 1 TO 100  'arbitrary number
  473.    
  474.     GET 1, , f
  475.     ztime$ = fixtime$(f.zooftim)     'Unpack date and time
  476.     zdate$ = fixdate$(f.zoofdat)
  477.     IF f.zoofnxh = 0 OR f.zoofnxh > LOF(1) THEN EXIT FOR
  478.     IF ASC(f.zoofcmp) = 1 THEN       'Set text for compression method
  479.         meth$ = "LZW"
  480.     ELSE meth$ = "---"
  481.     END IF
  482.     older& = older& + f.zoofosz  'save sizes
  483.     newer& = newer& + f.zoofnsz
  484.     'Format output with spaces
  485.     d$ = STR$(f.zoofosz) + STRING$(11 - LEN(STR$(f.zoofosz)), " ")
  486.     c$ = STR$(f.zoofnsz) + STRING$(11 - LEN(STR$(f.zoofnsz)), " ")
  487.     b$ = UCASE$(f.zoofnam) + "  " + d$ + c$ + ztime$ + "  " + zdate$ + "  " + HEX$(f.zoofcrc) + "  " + meth$
  488.     
  489.     showmsg b$
  490.     SEEK 1, f.zoofnxh - 3     'Move file pointer to next file Note:don't know what the '3' is for
  491.     
  492. NEXT n%
  493.  
  494. 'Print trailer
  495. showmsg banner$
  496. b$ = " " + STR$(n% - 1) + " files      " + STR$(older&) + "     " + STR$(newer&)
  497. CLOSE 1
  498. showmsg b$
  499. END SUB
  500.  
  501.