home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / basic / library / qb_pds / packer / qbzipdir / ziptest2.bas < prev   
Encoding:
BASIC Source File  |  1989-10-28  |  4.9 KB  |  150 lines
  1. DEFINT A-Z
  2. DECLARE SUB zipdir (f$, z() AS ANY)
  3. DECLARE FUNCTION Seekit& (name$, search$, ptr&)
  4.                                                 'you should use these declarations
  5.                                                 ' in your application
  6.  
  7.  
  8.  
  9. TYPE zipdir
  10.   zby AS INTEGER                    ' version zipped by
  11.   needed AS INTEGER                 'version needed to extract
  12.   flag AS INTEGER                   ' general purpose flag
  13.   compress AS INTEGER               ' compression method
  14.   tim  AS INTEGER                   ' time  stamp
  15.   dat AS INTEGER                    ' date stamp
  16.   crc  AS LONG                      ' crc-32
  17.   zsize AS LONG                     ' zipped size
  18.   nsize AS LONG                     ' unzipped size
  19.   fnlen AS INTEGER                  ' file name length
  20.   extralen AS INTEGER               ' extra field length
  21.   commentlen AS INTEGER             ' length of file comment
  22.   startdisk AS INTEGER              ' starting disk #
  23.   intattr AS INTEGER                ' internal attributes
  24.   extattr AS LONG                   ' file attribute flags
  25.   offset AS LONG                    ' offset into zip
  26.   buff AS STRING * 72               ' holds file name and comment
  27. END TYPE
  28.  
  29.  
  30.  
  31.  
  32. REM $DYNAMIC                 
  33. DIM z(1) AS zipdir                              'MUST be DIM'd as a dynamic
  34.                                                 'array, since it is re-dimmed
  35.                                                 'to the number of files
  36.                                                 'in the ZIP
  37.  
  38. LINE INPUT "File to zip view?:"; f$
  39.  
  40.  
  41.  
  42. ON ERROR GOTO handler
  43.  
  44. OPEN f$ FOR INPUT AS #1: CLOSE #1              'phony check for existence of
  45.                                                ' zip file
  46.  
  47. CALL zipdir(f$, z())
  48.  
  49. IF z(0).zby = -1 THEN                           'zipdir sets this to a -1 if
  50.    PRINT "Not a ZIP"                            'it can't find any zip file
  51.    END                                          'headers
  52. END IF
  53.  
  54. PRINT STRING$(80, "-")                          'show what we found
  55. PRINT "Number of entries in ZIP: "; UBOUND(z)
  56. PRINT STRING$(80, "-")
  57. PRINT " Filename    Attr   Length    Size    Date      Time      CRC-32    Method"
  58.  
  59. FOR count = 1 TO UBOUND(z)
  60.      
  61.       n = z(count).dat                          'since the date is packed into
  62.       day = n AND &H1F                          '2 bytes, we need to unpack it
  63.    
  64.       n = n \ 32
  65.  
  66.       mnth = n AND &HF
  67.       n = z(count).dat
  68.       n = n \ 512
  69.       year = n + 1980
  70.      
  71.       'pretty up the date a bit for display
  72.       dt$ = LTRIM$(RTRIM$(STR$(mnth))) + "-" + LTRIM$(RTRIM$(STR$(day))) + "-" + LTRIM$(RTRIM$(STR$(year)))
  73.      x = LEN(dt$): IF x < 10 THEN dt$ = dt$ + SPACE$(10 - x)
  74.      
  75.      n = z(count).tim                           'unpack the time
  76.      sec = n AND &H1F
  77.      n = n \ 32
  78.      min = n AND &H3F
  79.      hour = z(count).tim
  80.      hour = (hour \ 2048) AND &H1F
  81.     
  82.      tm$ = LTRIM$(RTRIM$(STR$(hour))) + ":" + LTRIM$(RTRIM$(STR$(min))) + "." + LTRIM$(RTRIM$(STR$(sec)))
  83.      x = LEN(tm$): IF x < 8 THEN tm$ = tm$ + SPACE$(8 - x)
  84.      fil$ = MID$(z(count).buff, 1, z(count).fnlen)
  85.      x = LEN(fil$): IF x < 12 THEN fil$ = fil$ + SPACE$(12 - x)
  86.     
  87.      PRINT fil$; "  ";                    'determine the file attributes
  88.      fattr = z(count).extattr AND &HF
  89.      SELECT CASE fattr
  90.         CASE 0
  91.            attr$ = "--w"      'normal
  92.         CASE 1
  93.            attr$ = "--r"      'read only
  94.         CASE 2
  95.            attr$ = "--h"      ' hidden
  96.         CASE 3
  97.            attr$ = "-rh"      ' hidden and read only
  98.         CASE IS >= 4
  99.            attr$ = "--s"      'shortcut... (check DOS technical manual)
  100.      END SELECT
  101.      crypt = z(count).flag AND &H1
  102.      IF crypt > 0 THEN                 'is it an encrypted file?
  103.         attr$ = attr$ + "*"
  104.      ELSE
  105.         attr$ = attr$ + " "
  106.      END IF
  107.      PRINT attr$; "  ";
  108.      PRINT USING "######"; z(count).nsize;      'uncompressed size
  109.      PRINT "  ";
  110.      PRINT USING "######"; z(count).zsize;      'compressed size
  111.      PRINT "  ";
  112.      PRINT dt$; "  "; tm$; "  "; HEX$(z(count).crc); "  ";   'crc
  113.  
  114.     SELECT CASE z(count).compress               'show method of compression
  115.       CASE 0
  116.          method$ = "Stored"
  117.  
  118.       CASE 1
  119.          method$ = "Shrunk"
  120.       CASE 2
  121.          method$ = "Reduce-1"
  122.       CASE 3
  123.          method$ = "Reduce-2"
  124.       CASE 4
  125.          method$ = "Reduce-3"
  126.       CASE 5
  127.          method$ = "Reduce-4"
  128.       CASE 6
  129.          method$ = "Imploded"
  130.  
  131.       CASE ELSE
  132.          method$ = "Unknown"
  133.     END SELECT
  134.      PRINT method$
  135.  
  136.                                        'get the file comment
  137.  
  138.      fcom$ = MID$(z(count).buff, z(count).fnlen + 1, z(count).commentlen)
  139. '    PRINT "File Comment: "; fcom$
  140.  
  141. NEXT
  142.                                        'print the zipfile comment
  143.  PRINT "Zip Comment: "; MID$(z(0).buff, 1, 60)
  144.  
  145. END
  146. handler:
  147.   PRINT "File does not exist"
  148.   END
  149.  
  150.