home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / Compressed47536192002.psc / ComprFileViewer2 / ArchiveNetwork.cls next >
Encoding:
Visual Basic class definition  |  2002-01-03  |  40.4 KB  |  904 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "cArchive"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. Option Explicit
  15. ' Major rewrite 30-May-2001. Handles Ace, Cab, Rar, Zip archives
  16. ' in just one class (easily expandable to accomodate other formats)
  17. ' Common event now returns Total # of files for use in progress bars.
  18. ' Zip and Cab are enumerated using NO 3rd party Dll's.
  19. ' Ace and Rar use UnAce.Dll and UnRar.Dll respectively.
  20. '
  21. 'To Do:
  22. ' Complete Zip/Unzip support(Done - not included in this demo)
  23. ' Finish UnAce/UnRar decompress.
  24. ' Write code to compress Ace/Rar (need Dll's)
  25. ' Write compress/decompress for Cab using Cabinet.Dll
  26. ' instead of setupapi.dll
  27. '
  28. 'Set ArchiveName/ArchiveExt after instantiating class
  29. Public ArchiveName As String  'Compressed FileName to open
  30. Public ArchiveExt As String    'Ext of Archive (ace,cab,rar,zip)
  31. 'Returns total # of files - included in all FileFound events
  32. Public FileCount As Long      'Total
  33.  
  34. Private Type ZipFileCentralHeader
  35.   VersionMadeBy            As Integer
  36.   VersionNeededToExtract   As Integer
  37.   Flag                     As Integer
  38.   CompressionMethod        As Integer
  39.   time                     As Integer
  40.   date                     As Integer
  41.   CRC32                    As Long
  42.   CompressedSize           As Long
  43.   UncompressedSize         As Long
  44.   FileNameLength           As Integer
  45.   ExtraFieldLength         As Integer
  46.   FileCommentLength        As Integer
  47.   DiskNumberStart          As Integer
  48.   InternalAttr             As Integer
  49.   ExternalAttr             As Long
  50.   RelOffsetLocHdr          As Long
  51.   FileName                 As String
  52.   ExtraField               As String
  53.   FileComment              As String
  54. End Type
  55. Private Type ZipFileEndCentralHeader
  56.   DiskNumberThis             As Integer
  57.   DiskNumberCentralDir       As Integer
  58.   CentralDirEntriesThisDisk  As Integer
  59.   CentralDirEntriesTotal     As Integer
  60.   SizeCentralDir             As Long
  61.   CentralDirOffset           As Long
  62.   FileCommentLength          As Integer
  63.   FileComment                As String
  64. End Type
  65. 'Private Type ZipDigitalSignature
  66. '   SignatureSize  As Integer
  67. '   signature      As String
  68. 'End Type
  69.  
  70. 'Private Type ZipFileLocalHeader
  71. '  Version            As Integer
  72. '  Flag               As Integer
  73. '  CompressionMethod  As Integer
  74. '  Time               As Integer
  75. '  Date               As Integer
  76. '  CRC32              As Long
  77. '  CompressedSize     As Long
  78. '  UncompressedSize   As Long
  79. '  FileNameLength     As Integer
  80. '  ExtraFieldLength   As Integer
  81. '  FileName           As String
  82. '  ExtraField         As String
  83. 'End Type
  84. Private Type ACEOPENARCHIVEDATA
  85.     Arcname As Long
  86.     OpenMode As Long
  87.     OpenResult As Long
  88.     flags As Long
  89.     Host As Long
  90.     AV As String * 51
  91.     CmtBuf As Long      'Pointer to buffer ??
  92.     CmtBufSize As Long
  93.     CmtSize As Long
  94.     CmtState As Long
  95.     ChangeVolProc As Long
  96.     ProcessDataProc As Long
  97. End Type
  98.  
  99. Private Type ACEHEADERDATA
  100.     Arcname As String * MAX_PATH
  101.     FileName As String * MAX_PATH
  102.     flags As Long
  103.     PackSize As Long
  104.     UnpSize As Long
  105.     FileCRC As Long
  106.    'was FileTime As Long
  107.     FileTime As Integer
  108.     FileDate As Integer
  109.     Method As Long
  110.     QUAL As Long
  111.     FileAttr As Long
  112.     CmtBuf As Long      'Pointer to buffer
  113.     CmtBufSize As Long
  114.     CmtSize As Long
  115.     CmtState As Long
  116. End Type
  117.  
  118. 'Private Type typCHANGEVOLPROC
  119. '    Arcname As String
  120. '    Mode As Long
  121. 'End Type
  122.  
  123. 'Private Type typPROCESSDATAPROC
  124. '    Addr As String
  125. '    Size As Long
  126. 'End Type
  127.  
  128. 'Private Const ACEERR_MEM = 1
  129. 'Private Const ACEERR_FILES = 2
  130. 'Private Const ACEERR_FOUND = 3
  131. 'Private Const ACEERR_FULL = 4
  132. 'Private Const ACEERR_OPEN = 5
  133. 'Private Const ACEERR_READ = 6
  134. 'Private Const ACEERR_WRITE = 7
  135. 'Private Const ACEERR_CLINE = 8
  136. 'Private Const ACEERR_CRC = 9
  137. 'Private Const ACEERR_OTHER = 10
  138. 'Private Const ACEERR_EXISTS = 11
  139. 'Private Const ACEERR_END = 128
  140. 'Private Const ACEERR_HANDLE = 129
  141. 'Private Const ACEERR_CONSTANT = 130
  142. 'Private Const ACEERR_NOPASSW = 131
  143. 'Private Const ACEERR_METHOD = 132
  144. 'Private Const ACEERR_USER = 255
  145.  
  146. 'Const SUCCESS = 0&
  147.  
  148. Private Const ACEOPEN_LIST = 0
  149. 'Private Const ACEOPEN_EXTRACT = 1
  150.  
  151. Private Const ACECMD_SKIP = 0
  152. 'Private Const ACECMD_TEST = 1
  153. 'Private Const ACECMD_EXTRACT = 2
  154.  
  155. 'Private Const ACEVOL_REQUEST = 0
  156. 'Private Const ACEVOL_OPENED = 1
  157.  
  158. Private Declare Function ACEOpenArchive Lib "unACE.dll" _
  159.                     (ByRef Archivedata As ACEOPENARCHIVEDATA) As Long
  160. Private Declare Function ACEProcessFile Lib "unACE.dll" _
  161.                     (ByVal hArcData As Long, _
  162.                      ByVal Operation As Long, _
  163.                      ByVal DestPath As String) As Long
  164. Private Declare Function ACECloseArchive Lib "unACE.dll" _
  165.                     (ByVal hArcData As Long) As Long
  166. Private Declare Function ACEReadHeader Lib "unACE.dll" _
  167.                     (ByVal hArcData As Long, _
  168.                      ByRef Headerdata As ACEHEADERDATA) As Long
  169. Private Type CabFileHeader
  170.     signature     As String * 4  ' MSCF (cabinet file signature )
  171.     reserved1     As Long        '
  172.     cbCabinet     As Long        'size of this cabinet file in bytes
  173.     reserved2     As Long        '
  174.     coffFiles     As Long        'offset of the first CFFILE entry
  175.     reserved3     As Long        '
  176.     versionMinor  As Byte        'cabinet file format version, minor
  177.     versionMajor  As Byte        'cabinet file format version, major
  178.     cFolders      As Integer     'number of CFFOLDER entries in this cabinet
  179.     cFiles        As Integer     'number of CFFILE entries in this cabinet
  180.     flags         As Integer     'cabinet file option indicators
  181.     setID         As Integer     'must be the same for all cabinets in a set
  182.     iCabinet      As Integer     'number of this cabinet file in a set
  183.   '  cbCFHeader    As Integer     '(optional) size of per-cabinet reserved area
  184.   '  cbCFFolder    As Byte        '(optional) size of per-folder reserved area
  185.   '  cbCFData      As Byte        '(optional) size of per-datablock reserved area
  186.   '  abReserve     As Byte        '(optional) per-cabinet reserved area
  187.   '  szCabinetPrev As Byte        '(optional) name of previous cabinet file
  188.   '  szDiskPrev    As Byte        '(optional) name of previous disk
  189.   '  szCabinetNext As Byte        '(optional) name of next cabinet file
  190.   '  szDiskNext    As Byte        '(optional) name of next disk
  191. End Type
  192.  
  193. Private Type CFFOLDER
  194.     coffCabStart  As Long     'offset of the first CFDATA block in this folder
  195.     cCFData       As Integer  'number of CFDATA blocks in this folder
  196.     typeCompress  As Integer  'compression type indicator
  197. End Type
  198.  
  199. Private Type CFFILE
  200.     uSize            As Long     'uncompressed size of this file in bytes
  201.     uoffFolderStart  As Long     'uncompressed offset of this file in the folder
  202.     iFolder          As Integer  'index into the CFFOLDER area
  203.     date             As Integer  'date stamp for this file
  204.     time             As Integer  'time stamp for this file
  205.     attribs          As Integer  'attribute flags for this file
  206.     'szName is variable length string with Chr$(0) terminator
  207.     'See GetInfo to see how seek is adjusted for block alignment
  208.     szName           As String * 260  'name of this file
  209. End Type
  210.  
  211. 'Would have been nice if the Crc and
  212. 'Compressed size were in CFFILE above
  213.  
  214. 'Private Type CFDATA
  215. '    csum       As Long    'checksum of this CFDATA entry
  216. '    cbData     As Integer 'number of compressed bytes in this block
  217. '    cbUncomp   As Integer 'number of uncompressed bytes in this block
  218. '  '  abReserve  As Byte    '(optional) per-datablock reserved area
  219. '  '  ab[cbData] As Byte    'compressed data bytes
  220. 'End Type
  221. Private Type RAROPENARCHIVEDATA
  222.     szArcName As Long               ' INPUT: Should point to a zero terminated string containing the archive name
  223.     OpenMode As Long                ' INPUT: RAR_OM_LIST - Open archive for reading file headers only
  224.                                     '        RAR_OM_EXTRACT - Open archive for testing and extracting files
  225.     OpenResult As Long              ' OUTPUT: 0                 - Success
  226.                                     '         ERAR_NO_MEMORY    - Not enough memory to initialize data structures
  227.                                     '         ERAR_BAD_DATA     - Archive header broken
  228.                                     '         ERAR_BAD_ARCHIVE  - File is not a valid RAR archive
  229.                                     '         ERAR_EOPEN        - File open error
  230.     szCmtBuf As Long                ' INPUT: Should point to a buffer for archive comments.
  231.                                     '        Maximum comment size is limited to 64 KB. Comment text is zero termintad.
  232.                                     '        If the comment text is larger than the buffer size, the comment text
  233.                                     '        will be trunctated. If szCmtBuf is set to NULL, comments will not be read.
  234.     CmtBufSize As Long              ' INPUT: Should contain size of buffer for archive comments
  235.     CmtSize As Long                 ' OUTPUT: Containing size of comments actually read into the buffer.
  236.                                     '         Cannot exceed CmtBufSize.
  237.     CmtState As Long                ' State:
  238.                                     ' 0                 - absent comments
  239.                                     ' 1                 - Comments read completely
  240.                                     ' ERAR_NO_MEMORY    - Not enough memory to extract comment
  241.                                     ' ERAR_BAD_DATA     - Broken comment
  242.                                     ' ERAR_UNKNOWN_FORMAT - Unknown comment format
  243.                                     ' ERAR_SMALL_BUF    - Buffer too small, comments not completely read
  244. End Type
  245.  
  246. Private Type RARHEADERDATA
  247.     Arcname As String * MAX_PATH         ' Contains the zero terminated string of the current archive name.
  248.                                     ' Maybe used to determine the current volume name
  249.     FileName As String * MAX_PATH        ' Contains the zero terminated string of the file name
  250.     flags As Long                   ' Flags
  251.                                     ' bits 7 6 5 4 3 2 1 0
  252.                                     '      0 0 0 0 0 0 0 1  &H1&    - file continued from previous volume
  253.                                     '      0 0 0 0 0 0 1 0  &H2&    - file continues on next volume
  254.                                     '      0 0 0 0 0 1 0 0  &H4&    - file encrypted with password
  255.                                     '      0 0 0 0 1 0 0 0  &H8&    - file comment present
  256.                                     '      0 0 0 1 0 0 0 0  &H10&   - compression of previous files is used
  257.                                     '                                 (solid flag)
  258.                                     '      0 0 0 0 0 0 0 0  &H00&   - dictionary size    64 KB
  259.                                     '      0 0 1 0 0 0 0 0  &H20&   - dictionary size   128 KB
  260.                                     '      0 1 0 0 0 0 0 0  &H40&   - dictionary size   256 KB
  261.                                     '      0 1 1 0 0 0 0 0  &H60&   - dictionary size   512 KB
  262.                                     '      1 0 0 0 0 0 0 0  &H80&   - dictionary size  1024 KB
  263.                                     '      1 0 1 0 0 0 0 0  &HA0&   - reserved
  264.                                     '      1 1 0 0 0 0 0 0  &HC0&   - reserved
  265.                                     '      1 1 1 0 0 0 0 0  &HE0&   - file is directory
  266.     PackSize As Long                ' Packed file size or size of the file part if file was split between volumes
  267.     UnpSize As Long                 ' UnPacked file size
  268.     HostOS As Long                  ' Operating system used for archiving
  269.                                     ' 0 - MS DOS
  270.                                     ' 1 - OS/2
  271.                                     ' 2 - Win32
  272.                                     ' 3 - Unix
  273.     FileCRC As Long                 ' unpacked CRC of file. '
  274.                                     ' It should not be used for file parts which were split between volumes.
  275.     'was  FILETIME As Long                ' Date & Time in standardMS-DOS format
  276.     FileTime As Integer
  277.     FileDate As Integer
  278.                                     ' First 16 bits contain date
  279.                                     '   Bits 0 - 4  : day (1-31)
  280.                                     '   Bits 5 - 8  : month (1=January,12=December)
  281.                                     '   Bits 9 - 15 : year (0=1980)
  282.                                     ' Second 16 bits contain time
  283.                                     '   Bits 0 - 4  : number of seconds divided by two
  284.                                     '   Bits 5 - 10 : number of minutes (0-59)
  285.                                     '   Bits 11 - 15: numer of hours (0-23)
  286.     UnpVer As Long                  ' RAR version required to extract the file
  287.                                     ' It is encoded as 10 * Major version + minor version
  288.     Method As Long                  ' Packing method
  289.     FileAttr As Long                ' File attributes
  290.     CmtBuf As Long                  ' INPUT: Should point to a buffer for file comments.
  291.                                     '        Maximum comment size is limited to 64 KB. Comment text is zero termintad.
  292.                                     '        If the comment text is larger than the buffer size, the comment text
  293.                                     '        will be trunctated. If szCmtBuf is set to NULL, comments will not be read.
  294.     CmtBufSize As Long              ' INPUT: Should contain size of buffer for file comments
  295.     CmtSize As Long                 ' OUTPUT: Containing size of comments actually read into the buffer.
  296.                                     '         Should not exceed CmtBufSize.
  297.     CmtState As Long                ' State:
  298.                                     ' 0                 - absent comments
  299.                                     ' 1                 - Comments read completely
  300.                                     ' ERAR_NO_MEMORY    - Not enough memory to extract comment
  301.                                     ' ERAR_BAD_DATA     - Broken comment
  302.                                     ' ERAR_UNKNOWN_FORMAT - Unknown comment format
  303.                                     ' ERAR_SMALL_BUF    - Buffer too small, comments not completely read
  304. End Type
  305.  
  306. ' Error constants
  307. 'Private Const ERAR_END_ARCHIVE = 10&    ' end of archive
  308. 'Private Const ERAR_NO_MEMORY = 11&      ' not enough memory to initialize data structures
  309. 'Private Const ERAR_BAD_DATA = 12&       ' Archive header broken
  310. 'Private Const ERAR_BAD_ARCHIVE = 13&    ' File is not valid RAR archive
  311. 'Private Const ERAR_UNKNOWN_FORMAT = 14& ' Unknown comment format
  312. 'Private Const ERAR_EOPEN = 15&          ' File open error
  313. 'Private Const ERAR_ECREATE = 16&        ' File create error
  314. 'Private Const ERAR_ECLOSE = 17&         ' file close error
  315. 'Private Const ERAR_EREAD = 18&          ' Read error
  316. 'Private Const ERAR_EWRITE = 19&         ' Write error
  317. ' Private Const ERAR_SMALL_BUF = 20&      ' Buffer too small, comment weren't read completely
  318.  
  319. ' OpenMode values
  320. Private Const RAR_OM_LIST = 0&           ' Open archive for reading file headers only
  321. 'Private Const RAR_OM_EXTRACT = 1        ' Open archive for testing and extracting files
  322.  
  323. ' Operation values
  324. Private Const RAR_SKIP = 0&              ' Move to the next file in archive
  325.                                         ' Warning: If the archive is solid and
  326.                                         ' RAR_OM_EXTRACT mode was set when the archive
  327.                                         ' was opened, the current file will be processed and
  328.                                         ' the operation will be performed slower than a simple seek
  329. 'Private Const RAR_TEST = 1&             ' Test the current file and move to the next file in
  330.                                         ' the archive. If the archive was opened with the
  331.                                         ' RAR_OM_LIST mode, the operation is equal to RAR_SKIP
  332. 'Private Const RAR_EXTRACT = 2&          ' Extract the current file and move to the next file.
  333.                                         ' If the archive was opened with the RAR_OM_LIST mode,
  334.                                         ' the operation is equal to RAR_SKIP
  335.  
  336. ' ChangeVolProc-Mode-parameter-values
  337. 'Private Const RAR_VOL_ASK = 0&          ' Required volume is absent. The function should
  338.                                         ' prompt the user and return non-zero value to retry the
  339.                                         ' operation. The function may also specify a new
  340.                                         ' volume name, placing it to ArcName parameter
  341. 'Private Const RAR_VOL_NOTIFY = 1&       ' Required volume is successfully opened. This is a
  342.                                         ' notification call and ArcName modification is NOT
  343.                                         ' allowed. The function should return non-zero value
  344.                                         ' to continue or a zero value to terminate operation
  345.  
  346. ' Open RAR archive and allocate memory structures (about 1MB)
  347. ' parameters:   ArchiveData     - points to RAROpenArchiveData structure
  348. ' returns:  Archive handle or NULL in case of error
  349. Private Declare Function RAROpenArchive Lib "unrar.dll" _
  350.                 (ByRef Archivedata As RAROPENARCHIVEDATA) As Long
  351.                 
  352.     
  353. ' Close RAR archive and release allocated memory.
  354. ' Is must be called when archive processing is finished, even if the archive processing
  355. ' was stopped due to an error
  356. ' parameters:   hAcrData        - contains the archive handle obtained from the
  357. '                                 RAROpenArchive function call
  358. ' returns:  0 on success or ERAR_ECLOSE on Archive close error
  359. Private Declare Function RARCloseArchive Lib "unrar.dll" _
  360.                 (ByVal hArcData As Long) As Long
  361.                 
  362. ' Read header of file in archive
  363. ' parameters:   hAcrData        - contains the archive handle obtained from the
  364. '                                 RAROpenArchive function call
  365. '               HeaderData      - points to RARHeaderData structure
  366. ' returns:  0                   - Success
  367. '           ERAR_END_ARCHIVE    - End of archive
  368. '           ERAR_BAD_ARCHIVE    - File header broken
  369. Private Declare Function RARReadHeader Lib "unrar.dll" _
  370.                 (ByVal hArcData As Long, _
  371.                  ByRef Headerdata As RARHEADERDATA) As Long
  372.                  
  373. ' Performs action and moves the current position in the archive to the next file.
  374. ' Extract or test the current file from the archive opened in RAR_OM_EXTRACT mode.
  375. ' If the mode RAR_OM_LIST is set, then a call to this function will simply skip
  376. ' the archive position to the next file
  377. ' parameters:   hAcrData        - contains the archive handle obtained from the
  378. '                                 RAROpenArchive function call
  379. '               Operation       - RAR_SKIP  : Move to the next file in the archive.
  380. '                                   If the archive is solid and RAR_OM_EXTRACT mode
  381. '                                   was set when the archive was opened, the current
  382. '                                   file will be processed and the operation will be
  383. '                                   performed slower than a simple seek.
  384. '                                 RAR_TEST  : Test the current file and move to the
  385. '                                   next file in the archive. If the archive was opened
  386. '                                   with RAR_OM_LIST mode, the operation is equal to
  387. '                                   RAR_SKIP
  388. '                                 RAR_EXTRACT: Extract the current file and move to
  389. '                                   the next file. If the file was opened with
  390. '                                   RAR_OM_LIST mode, the operation is equal to RAR_SKIP
  391. '               DestPath        - points to a zero-terminated string containing the
  392. '                                 destination directory to which to extract files to.
  393. '                                 If DestPath is equal to NULL it means extract to the
  394. '                                 current directory. This parameters has meaning only
  395. '                                 if DestName is NULL
  396. '               DestName        - points to a string containing the full path and name
  397. '                                 of the file to be extracted of NULL as default. If
  398. '                                 DestName is defined (not NULL) it overrides the original
  399. '                                 file name saved in the archive and DestPath setting
  400. ' returns:  0                   - Success
  401. '           ERAR_BAD_DATA       - File CRC error
  402. '           ERAR_BAD_ARCHIVE    - Volume is not a valid RAR archive
  403. '           ERAR_UNKOWN_FORMAT  - Unknown archive format
  404. '           ERAR_EOPEN          - Volume open error
  405. '           ERAR_ECREATE        - File create error
  406. '           ERAR_ECLOSE         - File close error
  407. '           ERAR_EREAD          - Read error
  408. '           ERAR_EWRITE         - Write error
  409. Private Declare Function RARProcessFile Lib "unrar.dll" _
  410.                 (ByVal hArcData As Long, _
  411.                  ByVal Operation As Long, _
  412.                  ByVal DestPath As String, _
  413.                  ByVal DestName As Long) As Long
  414.  
  415. ' Set a user-defined function to process volume changing
  416. ' parameters:   hAcrData        - contains the archive handle obtained from the
  417. '                                 RAROpenArchive function call
  418. '               lpChangeVolProc - should point to a user-defined "volume change processing" function
  419. '                   This function will be passed two parameters:
  420. '                   ArcName     - points to a zero-terminated name of the next volume
  421. '                   Mode        - The function call mode
  422. '                                 RAR_VOL_ASK   : required volume is absent. The function should prompt the
  423. '                                       user and return a non-zero value to retry or return a zero value to
  424. '                                       terminate the operation. The function may also specify a new volume
  425. '                                       name, placing it to the ArcName parameter
  426. '                                 RAR_VOL_NOTIFY: Required volume is successfully opened. This is a notification
  427. '                                       call and ArcName modification is not allowed. The function should
  428. '                                       return a non-zero value to continue or a zero value to terminate operation.
  429. '                   Other functions of UNRAR.DLL should not be called from the ChangeVolProc function
  430. 'Private Declare Sub RARSetChangeVolProc Lib "unrar.dll" _
  431.                 (ByVal hArcData As Long, _
  432.                  ByVal lpChangeVolProc As Long)
  433.                  
  434. ' Set a user-defined function to process unpacked data.
  435. ' It may be used to read a file while it is being extracted or tested without
  436. ' actual extracting file to disk.
  437. ' parameters:   hAcrData        - contains the archive handle obtained from the
  438. '                                 RAROpenArchive function call
  439. '               lpProcessDataProc - should point to a user-defined "data processing" function
  440. '                   This function is called each time when the next data portion is unpacked.
  441. '                   It will be passed two parameters:
  442. '                   Addr        - The address pointing to the unpacked data. The function may refer to the
  443. '                                 the data but must not change it.
  444. '                   Size        - The size of the unpacked data. It is guaranteed only the size will not
  445. '                                 exceed 1 MB (1.048.576 bytes). Any other presumptions may not be correct
  446. '                                 for future implementations of UNRAR.DLL
  447. '                   The function should return a non-zero value to continue process or a zero value to
  448. '                   cancel the archive operation.
  449. '                   Other functions of UNRAR.DLL should not be called from the ChangeVolProc function
  450. 'Private Declare Sub RARSetProcessDataProc Lib "unrar.dll" _
  451.                 (ByVal hArcData As Long, _
  452.                  ByVal lpProcessDataProc As Long)
  453.                  
  454. ' Set a password to decrypt files
  455. ' It may be used to read a file while it is being extracted or tested without
  456. ' actual extracting file to disk.
  457. ' parameters:   hAcrData        - contains the archive handle obtained from the
  458. '                                 RAROpenArchive function call
  459. '               Password - should point to a string containing a zero terminated password
  460. 'Private Declare Sub RARSetPassword Lib "unrar.dll" _
  461.                 (ByVal hArcData As Long, _
  462.                  ByVal sPassword As String)
  463. Public Event FileFound( _
  464.         ByVal Index As Long, _
  465.         ByVal Total As Long, _
  466.         ByVal FileName As String, _
  467.         ByVal ArchiveExt As String, _
  468.         ByVal Modified As Date, _
  469.         ByVal Size As Long, _
  470.         ByVal CompSize As Long, _
  471.         ByVal Method As Long, _
  472.         ByVal Attr As Long, _
  473.         ByVal Path As String, _
  474.         ByVal flags As Long, _
  475.         ByVal Crc As Long, _
  476.         ByVal Comments As String)
  477.  
  478. Private Sub GetZip()
  479.     'Copyright 2001 Dana Seaman
  480.     'Rewritten to:
  481.     '1: Get ZipFileEndCentralHeader
  482.     '2: Go direct to ZipFileCentralHeader
  483.     '3: Enumerate the entries
  484.     '4: Add to Listview
  485.     '5: 31Dec2001 Add network support
  486.     '   Replace VB Binary File I/O with API
  487.     
  488.         '<EhHeader>
  489.         On Error GoTo GetZip_Err
  490.         '</EhHeader>
  491.  
  492.     Dim Sig           As Long
  493.     Dim LenFile       As Long
  494.     Dim Index         As Long
  495.     Dim sPath         As String
  496.     Dim FileName      As String
  497.     Dim Temp          As String * 4096
  498.     Dim MyDate        As Date
  499.     Dim hFile         As Long
  500.     'Dim bBuffer(10)   As Byte
  501.     'Dim lResult       As Long
  502.     Dim lowbyte       As Long 'low dword of file pointer position
  503.     Dim highbyte      As Long 'high dword of file pointer position
  504.     Dim Ret           As Long
  505.     Dim MyPos         As Long
  506.     '-------------------------------------------------
  507.     'Dim zFile         As ZipFileLocalHeader
  508.     Dim zCentral      As ZipFileCentralHeader
  509.     Dim zEndCentral   As ZipFileEndCentralHeader
  510.     'Dim zSignature    As ZipDigitalSignature
  511.     '-------------------------------------------------
  512.     'Zip Signatures                          'a.k.a.
  513.     'Const LocalFileHeaderSig = &H4034B50    'PK 03 04
  514.     'Const CentralFileHeaderSig = &H2014B50  'PK 01 02
  515.     'Const EndCentralHeaderSig = &H6054B50   'PK 05 06
  516.     'Const DigitalSig = &H5054B50            'PK 05 05
  517.     'Const SpanSig = &H8074B50               'PK 07 08
  518.     Const Offset As Long = 4096
  519.  
  520. 100 hFile = CreateFile(ArchiveName, GENERIC_READ, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, 0&)
  521. 102 If hFile = INVALID_HANDLE_VALUE Then Exit Sub
  522. 104 LenFile = GetFileSize(hFile, 0)
  523.     If LenFile = 0 Then Exit Sub
  524.  
  525. 110 If LenFile > Offset Then
  526. 114    MyPos = LenFile - Offset
  527.     Else
  528. 118    MyPos = 1
  529.     End If
  530.     lowbyte = MyPos
  531.     highbyte = 0
  532.     lowbyte = SetFilePointer(hFile, lowbyte, highbyte, FILE_BEGIN)
  533.     ReadFile hFile, ByVal Temp, Offset, Ret, ByVal 0&
  534. 122 Sig = InStrRev(Temp, "PK" & Chr$(5) & Chr$(6))
  535. 124 If Sig Then
  536. 128    lowbyte = MyPos + Sig + 3
  537. 130    highbyte = 0
  538. 132    lowbyte = SetFilePointer(hFile, lowbyte, highbyte, FILE_BEGIN)
  539. 134    With zEndCentral
  540. 138       ReadFile hFile, .DiskNumberThis, 2, Ret, ByVal 0&
  541. 142       ReadFile hFile, .DiskNumberCentralDir, 2, Ret, ByVal 0&
  542. 146       ReadFile hFile, .CentralDirEntriesThisDisk, 2, Ret, ByVal 0&
  543. 150       ReadFile hFile, .CentralDirEntriesTotal, 2, Ret, ByVal 0&
  544. 154       ReadFile hFile, .SizeCentralDir, 4, Ret, ByVal 0&
  545. 158       ReadFile hFile, .CentralDirOffset, 4, Ret, ByVal 0&
  546.          ' Get ZipStream, , .FileCommentLength        'Integer
  547.          ' .FileComment = String$(.FileCommentLength, vbKeySpace)
  548.          ' Get ZipStream, , .FileComment              'String
  549. 160      ' Seek ZipStream, .CentralDirOffset + 1
  550. 162       lowbyte = .CentralDirOffset '+ 1
  551. 164       highbyte = 0
  552. 166       lowbyte = SetFilePointer(hFile, lowbyte, highbyte, FILE_BEGIN)
  553. 168       FileCount = .CentralDirEntriesThisDisk
  554.        End With
  555. 170    For Index = 1 To FileCount
  556. 172       With zCentral 'This has all the goodies
  557. 174          ReadFile hFile, Sig, 4, Ret, ByVal 0&
  558. 176          ReadFile hFile, .VersionMadeBy, 2, Ret, ByVal 0&
  559. 178          ReadFile hFile, .VersionNeededToExtract, 2, Ret, ByVal 0&
  560. 180          ReadFile hFile, .Flag, 2, Ret, ByVal 0&
  561. 182          ReadFile hFile, .CompressionMethod, 2, Ret, ByVal 0&
  562. 184          ReadFile hFile, .time, 2, Ret, ByVal 0&
  563. 186          ReadFile hFile, .date, 2, Ret, ByVal 0&
  564. 188          ReadFile hFile, .CRC32, 4, Ret, ByVal 0&
  565. 190          ReadFile hFile, .CompressedSize, 4, Ret, ByVal 0&
  566. 192          ReadFile hFile, .UncompressedSize, 4, Ret, ByVal 0&
  567. 194          ReadFile hFile, .FileNameLength, 2, Ret, ByVal 0&
  568. 196          ReadFile hFile, .ExtraFieldLength, 2, Ret, ByVal 0&
  569. 198          ReadFile hFile, .FileCommentLength, 2, Ret, ByVal 0&
  570. 200          ReadFile hFile, .DiskNumberStart, 2, Ret, ByVal 0&
  571. 202          ReadFile hFile, .InternalAttr, 2, Ret, ByVal 0&
  572. 204          ReadFile hFile, .ExternalAttr, 4, Ret, ByVal 0&
  573. 206          ReadFile hFile, .RelOffsetLocHdr, 4, Ret, ByVal 0&
  574. 208          .FileName = String$(.FileNameLength, vbKeySpace)
  575. 210          ReadFile hFile, ByVal .FileName, Len(.FileName), Ret, ByVal 0&
  576. 212          If .ExtraFieldLength Then
  577. 214             .ExtraField = String$(.ExtraFieldLength, vbKeySpace)
  578. 216             ReadFile hFile, ByVal .ExtraField, Len(.ExtraField), Ret, ByVal 0&
  579.              End If
  580. 218          If .FileCommentLength Then
  581. 220             .FileComment = String$(.FileCommentLength, vbKeySpace)
  582. 222             ReadFile hFile, ByVal .FileComment, Len(.FileComment), Ret, ByVal 0&
  583.              End If
  584.           End With
  585. 224       ParseFullPath zCentral.FileName, sPath, FileName
  586. 226       With zCentral
  587. 228          MyDate = GetMyDate(.date, .time)
  588. 230          RaiseEvent FileFound(Index, FileCount, FileName, ArchiveExt, MyDate, .UncompressedSize, .CompressedSize, .CompressionMethod, .ExternalAttr, sPath, .Flag, .CRC32, .FileComment)
  589.           End With
  590.        Next
  591.     End If
  592.  
  593. 234 CloseHandle (hFile)
  594.  
  595.         '<EhFooter>
  596.         Exit Sub
  597.  
  598. GetZip_Err:
  599.         MsgBox Err.Description & vbCrLf & _
  600.                "in cArchive.GetZip component " & _
  601.                "at line " & Erl
  602.         Resume Next
  603.         '</EhFooter>
  604. End Sub
  605. Private Sub GetAce()
  606. On Error GoTo ProcedureError
  607. Dim hArchive As Long
  608. Dim bMultiVolume As Boolean
  609. Dim sPath As String, FileName As String
  610. Dim Index As Long
  611. Dim sFile As String
  612. Dim zCentral As ACEHEADERDATA
  613. Dim MyDate As Date
  614. Dim Comments As String
  615.  
  616. '----Step thru just to get the total FileCount
  617.    hArchive = OpenACEArchive(ArchiveName, ACEOPEN_LIST, bMultiVolume)
  618.    If hArchive Then
  619.       While ACEReadHeader(hArchive, zCentral) = 0
  620.          sFile = StripNull(zCentral.FileName)
  621.          FileCount = FileCount + 1
  622.          ACEProcessFile hArchive, ACECMD_SKIP, vbNull
  623.       Wend
  624.       ACECloseArchive hArchive
  625.    End If
  626. '-----
  627.  
  628.    hArchive = OpenACEArchive(ArchiveName, ACEOPEN_LIST, bMultiVolume)
  629.    If hArchive Then
  630.       While ACEReadHeader(hArchive, zCentral) = 0
  631.          sFile = StripNull(zCentral.FileName)
  632.          Index = Index + 1
  633.          ParseFullPath sFile, sPath, FileName
  634.          With zCentral
  635.             MyDate = GetMyDate(.FileDate, .FileTime)
  636.             Comments = PointerToString(.CmtBuf)
  637.             RaiseEvent FileFound(Index, FileCount, FileName, ArchiveExt, MyDate, .UnpSize, .PackSize, .Method, .FileAttr, sPath, .flags, .FileCRC, Comments)
  638.          End With
  639.          ACEProcessFile hArchive, ACECMD_SKIP, vbNull
  640.       Wend
  641.       ACECloseArchive hArchive
  642.    End If
  643.  
  644.  
  645. ProcedureExit:
  646.    Exit Sub
  647. ProcedureError:
  648.    If ErrMsgBox("GetAce") = vbRetry Then Resume Next
  649. End Sub
  650. Private Sub GetCab()
  651. 'Copyright 2001 Dana Seaman
  652. '   31Dec2001 Add network support
  653. '   Replace VB Binary File I/O with API
  654.     
  655.         '<EhHeader>
  656.         On Error GoTo GetCab_Err
  657.         '</EhHeader>
  658.  
  659. 'Dim Sig        As Long
  660. Dim Index      As Long
  661. Dim hFile         As Long
  662. Dim CabStream  As Integer
  663. Dim sPath      As String
  664. Dim FileName   As String
  665. Dim Temp       As String
  666. Dim MyDate     As Date
  667. Dim SeekPos    As Long
  668. 'Dim lResult    As Long
  669. Dim lowbyte    As Long 'low dword of file pointer position
  670. Dim highbyte   As Long 'high dword of file pointer position
  671. Dim Ret        As Long
  672. '-------------------------------------------------
  673.  
  674. Dim zCentral      As CabFileHeader
  675. Dim zFile         As CFFILE
  676. Dim zFolder       As CFFOLDER
  677. '-------------------------------------------------
  678.  
  679. 100 hFile = CreateFile(ArchiveName, GENERIC_READ, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, 0&)
  680. 102 If hFile = INVALID_HANDLE_VALUE Then Exit Sub
  681.  
  682. CabStream = FreeFile
  683.  
  684. Open ArchiveName For Binary As CabStream
  685.  
  686. Get CabStream, , zCentral
  687. ReadFile hFile, zCentral, 36, Ret, ByVal 0&
  688.  
  689. If zCentral.signature = "MSCF" Then
  690.    FileCount = zCentral.cFiles
  691.    If FileCount Then
  692.       If zCentral.cFolders Then
  693.          Get CabStream, , zFolder
  694.          ReadFile hFile, zFolder, 8, Ret, ByVal 0&
  695.       End If
  696.       SeekPos = zCentral.coffFiles '+ 1
  697.       Seek CabStream, SeekPos
  698.       lowbyte = SeekPos
  699.       highbyte = 0
  700.       lowbyte = SetFilePointer(hFile, lowbyte, highbyte, FILE_BEGIN)
  701.       For Index = 1 To FileCount
  702.          Get CabStream, , zFile
  703.          ReadFile hFile, zFile, 276, Ret, ByVal 0&
  704.          With zFile
  705.             Temp = StripNull(.szName)
  706.             ParseFullPath Temp, sPath, FileName
  707.             MyDate = GetMyDate(.date, .time)
  708.             RaiseEvent FileFound(Index, FileCount, FileName, ArchiveExt, MyDate, .uSize, 0, zFolder.typeCompress, .attribs, sPath, zCentral.flags, 0, "")
  709.             '260 bytes were read for .szname
  710.             'synchronize SeekPos for next block
  711.             SeekPos = SeekPos + Len(Temp) + 17
  712.             Seek CabStream, SeekPos
  713.             lowbyte = SeekPos
  714.             highbyte = 0
  715.             lowbyte = SetFilePointer(hFile, lowbyte, highbyte, FILE_BEGIN)
  716.          End With
  717.       Next
  718.    End If
  719.  
  720. End If
  721.  
  722.     Close CabStream
  723. 234 CloseHandle (hFile)
  724.         
  725.         '<EhFooter>
  726.         Exit Sub
  727.  
  728. GetCab_Err:
  729.         MsgBox Err.Description & vbCrLf & _
  730.                "in cArchive.GetCab component " & _
  731.                "at line " & Erl
  732.         Resume Next
  733.         '</EhFooter>
  734. End Sub
  735. Private Sub GetRar()
  736. On Error GoTo ProcedureError
  737.  
  738. Dim hArchive As Long
  739. Dim bMultiVolume As Boolean
  740. Dim sPath As String, FileName As String
  741. Dim MyDate As Date
  742. Dim zCentral As RARHEADERDATA
  743. Dim Index As Long
  744. Dim Comments As String
  745.  
  746. '--------Step thru just to get the total FileCount
  747.     hArchive = OpenRARArchive(ArchiveName, RAR_OM_LIST, bMultiVolume)
  748.     If hArchive = 0 Then Exit Sub
  749.     While RARReadHeader(hArchive, zCentral) = 0
  750.         RARProcessFile hArchive, RAR_SKIP, vbNull, 0&
  751.         If (zCentral.flags And &H1000) = 0 Then
  752.             ' file continued flag not set
  753.            FileCount = FileCount + 1
  754.         End If
  755.     Wend
  756.     RARCloseArchive hArchive
  757. '--------
  758.     hArchive = OpenRARArchive(ArchiveName, RAR_OM_LIST, bMultiVolume)
  759.     If hArchive = 0 Then Exit Sub
  760.     
  761.     While RARReadHeader(hArchive, zCentral) = 0
  762.         
  763.         RARProcessFile hArchive, RAR_SKIP, vbNull, 0&
  764.         If (zCentral.flags And &H1000) = 0 Then
  765.             ' file continued flag not set
  766.            Index = Index + 1
  767.            With zCentral
  768.               ParseFullPath StripNull(.FileName), sPath, FileName
  769.               MyDate = GetMyDate(.FileDate, .FileTime)
  770.               Comments = PointerToString(.CmtBuf)
  771.               RaiseEvent FileFound(Index, FileCount, FileName, ArchiveExt, MyDate, .UnpSize, .PackSize, .Method, .FileAttr, sPath, .flags, .FileCRC, Comments)
  772.             End With
  773.         End If
  774.     Wend
  775.            
  776.     RARCloseArchive hArchive
  777.  
  778. ProcedureExit:
  779.    Exit Sub
  780. ProcedureError:
  781.    If ErrMsgBox("GetRar") = vbRetry Then Resume Next
  782. End Sub
  783. Public Function GetInfo() As Boolean
  784.  
  785.    Select Case ArchiveExt
  786.       Case ace_: GetAce
  787.       Case cab_: GetCab
  788.       Case rar_: GetRar
  789.       Case zip_: GetZip
  790.    End Select
  791.  
  792. End Function
  793. Public Function OpenACEArchive(sFileName As String, _
  794.                 OpenMode As Long, _
  795.                 ByRef bMultiVolume As Boolean) As Long
  796.     Dim hArchive As Long
  797.     Dim tArchiveData As ACEOPENARCHIVEDATA
  798.     Dim ByteArray() As Byte
  799.     
  800.     ReDim ByteArray(0 To Len(sFileName)) As Byte
  801.     tArchiveData.Arcname = StringToPointer(sFileName, ByteArray)
  802.     tArchiveData.OpenMode = OpenMode ' parameter instead of constant
  803.     tArchiveData.CmtBufSize = 0
  804.     hArchive = ACEOpenArchive(tArchiveData)
  805.     If tArchiveData.OpenResult <> 0 Then
  806.         If hArchive <> 0 Then ACECloseArchive hArchive
  807.         OpenACEArchive = 0
  808.     Else
  809.         bMultiVolume = CBool(tArchiveData.flags & &H800)
  810.         OpenACEArchive = hArchive
  811.     End If
  812. End Function
  813.  
  814. 'Public Function UnpackACE(sFileName As String, sDestin As String) As Boolean
  815. '    Dim hArchive As Long
  816. '    Dim tHeaderdata As ACEHEADERDATA
  817. '    Dim sFile As String
  818. '    Dim bMultiVolume As Boolean
  819. '    hArchive = OpenACEArchive(sFileName, ACEOPEN_EXTRACT, bMultiVolume)
  820. '    If hArchive = 0 Then Exit Function
  821. '
  822. '    While ACEReadHeader(hArchive, tHeaderdata) = 0
  823. '        sFile = StripNull(tHeaderdata.FileName)
  824. '        Select Case ACEProcessFile(hArchive, ACECMD_EXTRACT, sDestin)
  825. '           Case ACEERR_WRITE
  826. '              MsgBox "Could not write file to disk", vbCritical
  827. '              ACECloseArchive hArchive
  828. '              Exit Function
  829. '           Case ACEERR_CRC
  830. '              MsgBox "Crc Error on File " & sFile, vbInformation
  831. '        End Select
  832. '
  833. '        If tHeaderdata.FileAttr <> vbDirectory Then
  834. '           'Show progress
  835. '        End If
  836. '        DoEvents
  837. '    Wend
  838. '    ACECloseArchive hArchive
  839. 'End Function
  840.  
  841. Public Function OpenRARArchive(sFileName As String, _
  842.                 OpenMode As Long, _
  843.                 ByRef bMultiVolume As Boolean) As Long
  844.     Dim hArchive As Long
  845.     Dim tArchiveData As RAROPENARCHIVEDATA
  846.     Dim ByteArray() As Byte
  847.     
  848.     ReDim ByteArray(0 To Len(sFileName)) As Byte
  849.     tArchiveData.szArcName = StringToPointer(sFileName, ByteArray)
  850.     tArchiveData.OpenMode = OpenMode
  851.     tArchiveData.CmtBufSize = 0
  852.     hArchive = RAROpenArchive(tArchiveData)
  853.     If tArchiveData.OpenResult <> 0 Then
  854.         If hArchive <> 0 Then RARCloseArchive hArchive
  855.         OpenRARArchive = 0
  856.     Else
  857.         OpenRARArchive = hArchive
  858.     End If
  859. End Function
  860.  
  861. 'Public Function UnpackRAR(sFileName As String, sDestin As String) As Boolean
  862. '    Dim hArchive As Long
  863. '    Dim tHeaderdata As RARHEADERDATA
  864. '    Dim sFile As String
  865. '    Dim bMultiVolume As Boolean
  866. '
  867. '    hArchive = OpenRARArchive(sFileName, RAR_OM_EXTRACT, bMultiVolume)
  868. '    If hArchive = 0 Then Exit Function
  869. '
  870. ''    RARSetChangeVolProc hArchive, FnPtr(AddressOf ChangeVolProc)
  871. ''    RARSetProcessDataProc hArchive, FnPtr(AddressOf ProcessDataProc)
  872. '
  873. '    sDestin = QualifyPath(sDestin)
  874. '
  875. '    While RARReadHeader(hArchive, tHeaderdata) = 0
  876. '        sFile = StripNull(tHeaderdata.FileName)
  877. '        Select Case RARProcessFile(hArchive, RAR_EXTRACT, sDestin, 0&)
  878. '           Case ERAR_EWRITE
  879. '              MsgBox "Write error", vbCritical
  880. '              RARCloseArchive hArchive
  881. '              Exit Function
  882. '           Case ERAR_EREAD
  883. '                MsgBox "Archive " & sFile & " Read Error.", vbInformation + vbOKOnly
  884. '        End Select
  885. '
  886. '        If tHeaderdata.FileAttr <> vbDirectory Then
  887. '          'Show progress here
  888. '        End If
  889. '
  890. '        DoEvents
  891. '    Wend
  892. '    RARCloseArchive hArchive
  893. 'End Function
  894.  
  895. 'Public Function ChangeVolProc(ByRef sArcName As String, ByVal lMode As Long) As Long
  896. '    Debug.Print sArcName & " " & CStr(lMode)
  897. '    ChangeVolProc = 1&
  898. 'End Function
  899.  
  900. 'Public Function ProcessDataProc(ByVal lAddr As Long, ByVal lSize As Long) As Long
  901. '    Debug.Print "SIZE: " & CStr(lSize)
  902. '    ProcessDataProc = 1&
  903. 'End Function
  904.