home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / basic / library / qb_pds / packer / qbzipdir / ziptest.bas < prev    next >
Encoding:
BASIC Source File  |  1989-10-28  |  4.1 KB  |  126 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. '  the TYPE ZIPDIR record array will hold the file information
  8. '  this record array will conform to the "Local File Header" as referred
  9. '  to in "APPNOTE.TXT" contained within PKZIP101.EXE, except for the
  10. '  signature bytes which are not necessary.  This approach doesn't allow
  11. '  retrieving the file attribute, or zipfile comments, but does not
  12. '  require passing the larger array that would be required by accessing the
  13. '  zip directory header
  14.  
  15.  
  16. ' use:  QB ZIPTEST /L ZIPDIRS
  17.  
  18.  
  19. TYPE zipdir
  20.   zby AS INTEGER                                'version zipped by
  21.   flag AS INTEGER                               'general purpose flag
  22.   compress AS INTEGER                           'compression method
  23.   tim  AS INTEGER                               'last mod time flag
  24.   dat AS INTEGER                                'last mod file date
  25.   crc  AS LONG                                  ' crc-32
  26.   zsize AS LONG                                 'compressed size
  27.   nsize AS LONG                                 'uncompressed size
  28.   fnlen AS INTEGER                              'filename length
  29.   extralen AS INTEGER                           'extra field length
  30.   fnam AS STRING * 12                           'filename
  31. END TYPE
  32.  
  33.  
  34.  
  35.  
  36. REM $DYNAMIC                  
  37. DIM z(1) AS zipdir                              'MUST be DIM'd as a dynamic
  38.                                                 'array, since it is re-dimmed
  39.                                                 'to the number of files
  40.                                                 'in the ZIP
  41.  
  42. LINE INPUT "File to zip view?:"; f$
  43.  
  44. ON ERROR GOTO handler
  45.  
  46. OPEN f$ FOR INPUT AS #1: CLOSE #1              'phony check for existence of
  47.                                                ' zip file
  48.  
  49.  
  50. CALL zipdir(f$, z())
  51.  
  52. IF z(0).zby = -1 THEN                           'zipdir sets this to a -1 if
  53.    PRINT "Not a ZIP"                            'it can't find any zip file
  54.    END                                          'headers
  55. END IF
  56.  
  57. PRINT STRING$(80, "-")                          'show what we found
  58. PRINT "Number of entries in ZIP: "; UBOUND(z)
  59. PRINT STRING$(80, "-")
  60. PRINT " Filename      Length    Size       Date       Time       CRC-32     Method"
  61.  
  62. FOR count = 1 TO UBOUND(z)
  63.     
  64.       n = z(count).dat                          'since the date is packed into
  65.       day = n AND &H1F                          '2 bytes, we need to unpack it
  66.   
  67.       n = n \ 32
  68.  
  69.       mnth = n AND &HF
  70.       n = z(count).dat
  71.       n = n \ 512
  72.       year = n + 1980
  73.     
  74.       'pretty up the date a bit for display
  75.       dt$ = LTRIM$(RTRIM$(STR$(mnth))) + "-" + LTRIM$(RTRIM$(STR$(day))) + "-" + LTRIM$(RTRIM$(STR$(year)))
  76.      x = LEN(dt$): IF x < 10 THEN dt$ = dt$ + SPACE$(10 - x)
  77.     
  78.      n = z(count).tim                           'unpack the time
  79.      sec = n AND &H1F
  80.      n = n \ 32
  81.      min = n AND &H3F
  82.      hour = z(count).tim
  83.      hour = (hour \ 2048) AND &H1F
  84.    
  85.      tm$ = LTRIM$(RTRIM$(STR$(hour))) + ":" + LTRIM$(RTRIM$(STR$(min))) + "." + LTRIM$(RTRIM$(STR$(sec)))
  86.      x = LEN(tm$): IF x < 8 THEN tm$ = tm$ + SPACE$(8 - x)
  87.      PRINT z(count).fnam; "   ";
  88.      PRINT USING "######"; z(count).nsize;      'uncompressed size
  89.      PRINT "   ";
  90.      PRINT USING "######"; z(count).zsize;      'compressed size
  91.      PRINT "   ";
  92.      PRINT dt$; "   "; tm$; "   "; HEX$(z(count).crc); "   ";   'crc
  93.  
  94.     SELECT CASE z(count).compress               'show method of compression
  95.       CASE 0
  96.          method$ = "Stored"
  97.  
  98.       CASE 1
  99.          method$ = "Shrunk"
  100.       CASE 2
  101.          method$ = "Reduce-1"
  102.       CASE 3
  103.          method$ = "Reduce-2"
  104.       CASE 4
  105.          method$ = "Reduce-3"
  106.       CASE 5
  107.          method$ = "Reduce-4"
  108.       CASE 6
  109.          method$ = "Imploded"
  110.  
  111.       CASE ELSE
  112.          method$ = "Unknown"
  113.     END SELECT
  114.      PRINT method$
  115.  
  116.  
  117.  
  118.  
  119. NEXT
  120.  
  121. END
  122. handler:
  123.   PRINT "File does not exist"
  124.   END
  125.  
  126.