home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 3_2004-2005.ISO / Data / Zips / Archive_Ex1733794152004.psc / Cls_Cab.cls < prev    next >
Text File  |  2004-04-15  |  13KB  |  338 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 = "Cls_Cab"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. Option Explicit
  15. 'This class file can be used to show the contents of an CAB-archive
  16.  
  17. Private Type CabFileHeaderType
  18.     signature     As Long        ' MSCF (cabinet file signature )
  19.     HeadCRC       As Long        'CRC 32 of the cab header
  20.     cbCabinet     As Long        'size of this cabinet file in bytes
  21.     FolderCRC     As Long        'CRC 32 of the folder header
  22.     coffFiles     As Long        'offset of the first CFFILE entry
  23.     FilesCRC      As Long        'CRC 32 of the Files header
  24.     versionMinor  As Byte        'cabinet file format version, minor
  25.     versionMajor  As Byte        'cabinet file format version, major
  26.     cFolders      As Integer     'number of CFFOLDER entries in this cabinet
  27.     cFiles        As Integer     'number of CFFILE entries in this cabinet
  28.     Flags         As Integer     'cabinet file option indicators
  29.                                  'bit 0 = Has Previous Cab file
  30.                                  'bit 1 = Has Next cab file
  31.                                  'Bit 2 = reserve
  32.     setID         As Integer     'must be the same for all cabinets in a set
  33.     iCabinet      As Integer     'number of this cabinet file in a set
  34.   '  cbCFHeader    As Integer     '(optional) size of per-cabinet reserved area
  35.   '  cbCFFolder    As Byte        '(optional) size of per-folder reserved area
  36.   '  cbCFData      As Byte        '(optional) size of per-datablock reserved area
  37.   '  abReserve     As Byte        '(optional) per-cabinet reserved area
  38.   '  szCabinetPrev As Byte        '(optional) name of previous cabinet file
  39.   '  szDiskPrev    As Byte        '(optional) name of previous disk
  40.   '  szCabinetNext As Byte        '(optional) name of next cabinet file
  41.   '  szDiskNext    As Byte        '(optional) name of next disk
  42. End Type
  43.  
  44.  
  45. Private Type CFFolderType
  46.     coffCabStart  As Long     'offset of the first CFDATA block in this folder
  47.     cCFData       As Integer  '??number of CFDATA blocks in this folder
  48.     typeCompress  As Integer  'compression type indicator
  49. End Type
  50.  
  51. Private Type CFFileType
  52.     USize            As Long     'uncompressed size of this file in bytes
  53.     UoffFolderStart  As Long     'uncompressed offset of this file in the folder
  54.     IFolder          As Integer  'index into the CFFOLDER area
  55.                                  '&h0000 = FIRST
  56.                                  '&h0001 = NEXT
  57.                                  '&hFFFE = SPLIT
  58.                                  '&hFFFF = CONTINUED
  59.     FDate            As Integer  'date stamp for this file
  60.     FTime            As Integer  'time stamp for this file
  61.     Attribs          As Integer  'attribute flags for this file
  62.                                  'and &h0001 = READONLY
  63.                                  'and &h0002 = HIDDEN
  64.                                  'and &h0004 = SYSTEM
  65.                                  'and &h0008 = VOLUME
  66.                                  'and &h0010 = DIRECTORY
  67.                                  'and &h0020 = ARCHIVE
  68.     'szName is variable length string with Chr$(0) terminator
  69.     'See GetInfo to see how seek is adjusted for block alignment
  70.     FileName         As String   'name of this file
  71. End Type
  72.  
  73. 'Would have been nice if the Crc and
  74. 'Compressed size were in CFFILE above
  75.  
  76. Private Type CFDataType
  77.     CRC32      As Long    'checksum of this CFDATA entry
  78.     CSize      As Integer 'number of compressed bytes in this block
  79.     cbUncomp   As Integer 'number of uncompressed bytes in this block
  80.   '  abReserve  As Byte    '(optional) per-datablock reserved area
  81.   '  ab[cbData] As Byte    'compressed data bytes
  82. End Type
  83.  
  84. Private Type CabFileDataType
  85.     USize            As Long     'uncompressed size of this file in bytes
  86.     UoffFolderStart  As Long     'uncompressed offset of this file in the folder
  87.     IFolder          As Integer  'index into the CFFOLDER area
  88.                                  '&h0000 = FIRST
  89.                                  '&h0001 = NEXT
  90.                                  '&hFFFE = SPLIT
  91.                                  '&hFFFF = CONTINUED
  92.     FDate            As Integer  'date stamp for this file
  93.     FTime            As Integer  'time stamp for this file
  94.     Attribs          As Integer  'attribute flags for this file
  95.                                  'and &h0001 = READONLY
  96.                                  'and &h0002 = HIDDEN
  97.                                  'and &h0004 = SYSTEM
  98.                                  'and &h0008 = VOLUME
  99.                                  'and &h0010 = DIRECTORY
  100.                                  'and &h0020 = ARCHIVE
  101.     'szName is variable length string with Chr$(0) terminator
  102.     'See GetInfo to see how seek is adjusted for block alignment
  103.     FileName         As String   'name of this file
  104.     CRC32      As Long           'checksum of this CFDATA entry
  105.     CSize      As Integer        'number of compressed bytes in this block
  106.     cbUncomp   As Integer        'number of uncompressed bytes in this block
  107.     DataOffSet As Long           'start position if the compressed data
  108.     Method     As Integer
  109.   '  abReserve  As Byte    '(optional) per-datablock reserved area
  110.   '  ab[cbData] As Byte    'compressed data bytes
  111. End Type
  112.  
  113. Private CabFiles() As CabFileDataType
  114. Private CabHead As CabFileHeaderType
  115. Private Const m_Unpack_Supported As Boolean = False
  116.  
  117. Public Function Get_Contents(ZipName As String) As Integer
  118.     Dim FileNum As Long
  119.     Dim FileLenght As Long
  120.     Dim ByteVal As Byte
  121.     Dim LN As Long
  122.     Dim X As Long
  123.     Dim CabFolder() As CFFolderType
  124.     Dim CabReserve As Integer
  125.     Dim FolderReserve As Byte
  126.     Dim dataReserve As Byte
  127.     Dim CAbPrevName As String
  128.     Dim CabPrevDisk As String
  129.     Dim CabNextName As String
  130.     Dim CabNextDist As String
  131.     PackFileName = ZipName
  132.     PackComments = ""
  133.     PackFileType = 0
  134.     FileNum = FreeFile
  135.     Open PackFileName For Binary Access Read As #FileNum
  136.     If LOF(FileNum) < Len(CabHead) Then
  137.         Close #FileNum
  138.         Exit Function
  139.     End If
  140.     'get the end of central date
  141.     Get #FileNum, , CabHead
  142.     If CabHead.signature = &H4643534D Then
  143.         PackFileType = CABFileType
  144.         If (CabHead.Flags And 4) Then       'reserve
  145.             Get #FileNum, , CabReserve      'Reserved header space
  146.             Get #FileNum, , FolderReserve   'Reserved folder space
  147.             Get #FileNum, , dataReserve     'Reserved Datablock space
  148.             If CabReserve > 0 Then
  149.                 Seek #FileNum, Seek(FileNum) + CabReserve + 1   'Skip reserved block
  150.             End If
  151.         End If
  152.         If (CabHead.Flags And 1) Then       'Has Previous
  153.             Do
  154.                 Get #FileNum, , ByteVal
  155.                 If ByteVal = 0 Then Exit Do
  156.                 CAbPrevName = CAbPrevName & Chr(ByteVal)
  157.             Loop
  158.             Do
  159.                 Get #FileNum, , ByteVal
  160.                 If ByteVal = 0 Then Exit Do
  161.                 CabPrevDisk = CabPrevDisk & Chr(ByteVal)
  162.             Loop
  163.         End If
  164.         If (CabHead.Flags And 2) Then       'Has Next
  165.             Do
  166.                 Get #FileNum, , ByteVal
  167.                 If ByteVal = 0 Then Exit Do
  168.                 CabNextName = CabNextName & Chr(ByteVal)
  169.             Loop
  170.             Do
  171.                 Get #FileNum, , ByteVal
  172.                 If ByteVal = 0 Then Exit Do
  173.                 CabNextDist = CabNextDist & Chr(ByteVal)
  174.             Loop
  175.         End If
  176.         ReDim CabFolder(CabHead.cFolders)
  177.         For X = 1 To CabHead.cFolders
  178.             Get #FileNum, , CabFolder(X)
  179.             If FolderReserve > 0 Then
  180.                 Seek #FileNum, Seek(FileNum) + FolderReserve + 1   'Skip reserved block
  181.             End If
  182.         Next
  183.         ReDim CabFiles(CabHead.cFiles)
  184.         If Seek(FileNum) <> CabHead.coffFiles + 1 Then Seek #FileNum, CabHead.coffFiles + 1
  185.         PackTotFiles = CabHead.cFiles
  186.         For X = 1 To PackTotFiles
  187.             With CabFiles(X)
  188.                 Get #FileNum, , .USize
  189.                 Get #FileNum, , .UoffFolderStart
  190.                 Get #FileNum, , .IFolder
  191.                 Get #FileNum, , .FDate
  192.                 Get #FileNum, , .FTime
  193.                 Get #FileNum, , .Attribs
  194.                 Do
  195.                     Get #FileNum, , ByteVal
  196.                     If ByteVal = 0 Then Exit Do
  197.                     .FileName = .FileName & Chr(ByteVal)
  198.                 Loop
  199.                 .Method = CabFolder(1).typeCompress
  200.             End With
  201.         Next
  202. 'At this point the CFDatablock begin
  203. 'These are compressed blocks from uncompressed blocks up to 32K
  204. 'The files are stored into a buff of 32K until its full, After that the compression
  205. 'starts. That's why there are no CRC-value of the independed files
  206.  
  207. '        If Seek(FileNum) <> CabFolder(1).coffCabStart + 1 Then Seek #FileNum, CabFolder(1).coffCabStart + 1
  208. '        For X = 1 To PackTotFiles
  209. '            With CabFiles(X)
  210. '                Get #FileNum, , .CRC32
  211. '                Get #FileNum, , .CSize
  212. '                Get #FileNum, , .cbUncomp
  213. '                .DataOffSet = Seek(FileNum)
  214. '                .Method = CabFolder(1).typeCompress
  215. '                Seek #FileNum, Seek(FileNum) + .CSize
  216. '            End With
  217. '        Next
  218.     End If
  219. '    Close FileNum
  220. End Function
  221.  
  222. 'Unzip as file and return 0 for good decompression or others for error
  223. Public Function UnPack(ZippedFile() As Boolean, ToPath As String) As Integer
  224.     
  225.     Erase PackData
  226. End Function
  227.  
  228. Public Function Pack(ZipName As String, Files() As String, CompType As Integer, CompLevel As Integer, Optional IncludeDir As String = "") As Integer
  229.     
  230. End Function
  231.  
  232. Public Property Get CanUnpack() As Boolean
  233.     CanUnpack = m_Unpack_Supported
  234. End Property
  235.  
  236. Public Property Get FileCount() As Long
  237.     FileCount = PackTotFiles
  238. End Property
  239.  
  240. Public Property Get FileName(FileNum As Long) As String
  241.     If NotGood(FileNum) Then Exit Property
  242.     FileName = CabFiles(FileNum).FileName
  243. End Property
  244.  
  245. Public Property Get CommentsFile(FileNum As Long) As String
  246.     CommentsFile = ""
  247. End Property
  248.  
  249. Public Property Get CommentsPack() As String
  250.     CommentsPack = ""
  251. End Property
  252.  
  253. Public Property Get IsDir(FileNum As Long) As Boolean
  254.     If NotGood(FileNum) Then Exit Property
  255.     If (CabFiles(FileNum).Attribs And &H10) > 0 Then IsDir = True
  256. End Property
  257.  
  258. Public Property Get Method(FileNum As Long) As String
  259.     If NotGood(FileNum) Then Exit Property
  260.     Method = Methods(CInt(CabFiles(FileNum).Method And &HF))
  261. End Property
  262.  
  263. Public Property Get CRC32(FileNum As Long) As Long
  264.     If NotGood(FileNum) Then Exit Property
  265.     CRC32 = CabFiles(FileNum).CRC32
  266. End Property
  267.  
  268. Public Property Get Compressed_Size(FileNum As Long) As Long
  269.     If NotGood(FileNum) Then Exit Property
  270.     Compressed_Size = CabFiles(FileNum).CSize
  271. End Property
  272.  
  273. Public Property Get UnCompressed_Size(FileNum As Long) As Long
  274.     If NotGood(FileNum) Then Exit Property
  275.     UnCompressed_Size = CabFiles(FileNum).USize
  276. End Property
  277.  
  278. Public Property Get Encrypted(FileNum As Long) As Boolean
  279.     If NotGood(FileNum) Then Exit Property
  280.     Encrypted = False
  281. End Property
  282.  
  283. Public Property Get FileDateTime(FileNum As Long) As Date
  284.     If NotGood(FileNum) Then Exit Property
  285.     FileDateTime = GetZipDate(CabFiles(FileNum).FDate, CabFiles(FileNum).FTime)
  286. End Property
  287.  
  288. Public Property Get SystemMadeBy(FileNum As Long) As String
  289.     If NotGood(FileNum) Then Exit Property
  290.     SystemMadeBy = "UnKnown"
  291. End Property
  292.  
  293. Public Property Get VersionMadeBy(FileNum As Long) As String
  294.     If NotGood(FileNum) Then Exit Property
  295.     VersionMadeBy = "Unknown"
  296. End Property
  297.  
  298. Public Property Get SystemNeeded(FileNum As Long) As String
  299.     If NotGood(FileNum) Then Exit Property
  300.     SystemNeeded = "Unknown"
  301. End Property
  302.  
  303. Public Property Get VersionNeeded(FileNum As Long) As String
  304.     If NotGood(FileNum) Then Exit Property
  305.     VersionNeeded = Trim(CabHead.versionMajor & "." & CabHead.versionMinor)
  306. End Property
  307.  
  308. Private Function NotGood(FileNum As Long) As Boolean
  309.     If FileNum = 0 Then NotGood = True: Exit Function
  310.     If FileNum > PackTotFiles Then NotGood = True: Exit Function
  311.     If PackFileType = 0 Then NotGood = True: Exit Function
  312. End Function
  313.  
  314. Private Function DataSize() As Long
  315.     On Error Resume Next
  316.     DataSize = UBound(PackData) + 1
  317.     If Err.Number <> 0 Then
  318.         Err.Clear
  319.         DataSize = 0
  320.     End If
  321. End Function
  322.  
  323. Private Function VersionTo(Version As Byte) As String
  324.     VersionTo = Fix(Version / 10) & "." & Version Mod 10
  325. End Function
  326.  
  327. Private Function Methods(MethodType As Integer) As String
  328.     Select Case MethodType
  329.         Case 0: Methods = "No Compression"
  330.         Case 1: Methods = "MsZip"
  331.         Case 2: Methods = "Quantum"
  332.         Case 3: Methods = "Lzx"
  333.         Case Else: Methods = "Unknown"
  334.     End Select
  335. End Function
  336.  
  337.  
  338.