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_Arc.cls < prev    next >
Text File  |  2004-04-15  |  6KB  |  173 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_Arc"
  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 ARC-archive
  16.         
  17. Private Type ARCHeaderType
  18.     Id As Byte              'Arc signature
  19.     Method As Byte          'Compression method
  20.     FileName As String      'FileName
  21.     CSize As Long           'Compressed filesize
  22.     FDate As Integer        'Date
  23.     FTime As Integer        'Time
  24.     CRC16 As Integer        'CRC 16
  25.     USize As Long           'Original filesize
  26.     DataOffSet As Long      'Offset of the compressed data
  27. End Type
  28.  
  29. Private ARCFiles() As ARCHeaderType
  30. Private Const m_Unpack_Supported As Boolean = False
  31.  
  32. Public Function Get_Contents(ZipName As String) As Integer
  33.     Dim FileNum As Long
  34.     Dim ByteVal As Byte
  35.     Dim FName As String * 13
  36.     PackFileName = ZipName
  37.     PackComments = ""
  38.     PackFileType = 0
  39.     FileNum = FreeFile
  40.     Open PackFileName For Binary Access Read As #FileNum
  41.     PackTotFiles = 0
  42.     Erase ARCFiles
  43.     Do
  44.         Get #FileNum, , ByteVal
  45.         If ByteVal <> ARCHeader Then Exit Do            'No arc file
  46.         Get #FileNum, , ByteVal
  47.         If ByteVal < 1 Or ByteVal > 9 Then Exit Do  'probably No arc file or EOF
  48.         PackTotFiles = PackTotFiles + 1
  49.         ReDim Preserve ARCFiles(PackTotFiles)
  50.         With ARCFiles(PackTotFiles)
  51.             .Id = ARCHeader
  52.             .Method = ByteVal
  53.             Get #FileNum, , FName
  54.             .FileName = Trim(Replace(FName, vbNullChar, ""))
  55.             Get #FileNum, , .CSize
  56.             Get #FileNum, , .FDate
  57.             Get #FileNum, , .FTime
  58.             Get #FileNum, , .CRC16
  59.             Get #FileNum, , .USize
  60.             .DataOffSet = Seek(FileNum)
  61.             Seek #FileNum, .DataOffSet + .CSize
  62.         End With
  63.     Loop
  64.     ReDim Preserve ARCFiles(PackTotFiles)
  65.     If PackTotFiles > 0 Then PackFileType = ARCFileType
  66.     Close FileNum
  67. End Function
  68.  
  69. 'Unzip as file and return 0 for good decompression or others for error
  70. Public Function UnPack(ZippedFile() As Boolean, ToPath As String) As Integer
  71.  
  72.     Erase PackData
  73. End Function
  74.  
  75. Public Function Pack(ZipName As String, Files() As String, CompType As Integer, CompLevel As Integer, Optional IncludeDir As String = "") As Integer
  76.     
  77. End Function
  78.  
  79. Public Property Get CanUnpack() As Boolean
  80.     CanUnpack = m_Unpack_Supported
  81. End Property
  82.  
  83. Public Property Get FileName(FileNum As Long) As String
  84.     If NotGood(FileNum) Then Exit Property
  85.     FileName = ARCFiles(FileNum).FileName
  86. End Property
  87.  
  88. Public Property Get CommentsFile(FileNum As Long) As String
  89.     If NotGood(FileNum) Then Exit Property
  90.     CommentsFile = "Not Supported"
  91. End Property
  92.  
  93. Public Property Get CommentsPack() As String
  94.     CommentsPack = ""
  95. End Property
  96.  
  97. Public Property Get IsDir(FileNum As Long) As Boolean
  98.     If NotGood(FileNum) Then Exit Property
  99.     If ARCFiles(FileNum).USize = 0 Then
  100.         If Right(ARCFiles(FileNum).FileName, 1) = "/" Then IsDir = True
  101.     End If
  102. End Property
  103.  
  104. Public Property Get Method(FileNum As Long) As String
  105.     If NotGood(FileNum) Then Exit Property
  106.     Method = Methods(ARCFiles(FileNum).Method)
  107. End Property
  108.  
  109. 'Not totaly correct but what the hack
  110. Public Property Get CRC32(FileNum As Long) As Long
  111.     If NotGood(FileNum) Then Exit Property
  112.     CRC32 = ARCFiles(FileNum).CRC16
  113. End Property
  114.  
  115. Public Property Get Compressed_Size(FileNum As Long) As Long
  116.     If NotGood(FileNum) Then Exit Property
  117.     Compressed_Size = ARCFiles(FileNum).CSize
  118. End Property
  119.  
  120. Public Property Get UnCompressed_Size(FileNum As Long) As Long
  121.     If NotGood(FileNum) Then Exit Property
  122.     UnCompressed_Size = ARCFiles(FileNum).USize
  123. End Property
  124.  
  125. Public Property Get Encrypted(FileNum As Long) As Boolean
  126.     If NotGood(FileNum) Then Exit Property
  127.     Encrypted = False
  128. End Property
  129.  
  130. Public Property Get FileDateTime(FileNum As Long) As Date
  131.     If NotGood(FileNum) Then Exit Property
  132.     FileDateTime = GetZipDate(ARCFiles(FileNum).FDate, ARCFiles(FileNum).FTime)
  133. End Property
  134.  
  135. Public Property Get SystemMadeBy(FileNum As Long) As String
  136.     SystemMadeBy = "UnKnown"
  137. End Property
  138.  
  139. Public Property Get VersionMadeBy(FileNum As Long) As String
  140.     VersionMadeBy = "UnKnown"
  141. End Property
  142.  
  143. Public Property Get SystemNeeded(FileNum As Long) As String
  144.     SystemNeeded = "UnKnown"
  145. End Property
  146.  
  147. Public Property Get VersionNeeded(FileNum As Long) As String
  148.     VersionNeeded = "UnKnown"
  149. End Property
  150.  
  151. Private Function Methods(MethodType As Byte) As String
  152.     Select Case MethodType
  153.         Case 1: Methods = "unpacked (obsolete)"
  154.         Case 2: Methods = "unpacked"
  155.         Case 3: Methods = "packed"
  156.         Case 4: Methods = "squeezed (after packing)"
  157.         Case 5: Methods = "crunched (obsolete)"
  158.         Case 6: Methods = "crunched (after packing) (obsolete)"
  159.         Case 7: Methods = "crunched (after packing, using faster hash algorithm)"
  160.         Case 8: Methods = "crunched (after packing, using dynamic LZW variations)"
  161.         Case 9: Methods = "Squashed c/o Phil Katz (no packing) (var. on crunching)"
  162.         Case Else: Methods = "Unknown"
  163.     End Select
  164. End Function
  165.  
  166. Private Function NotGood(FileNum As Long) As Boolean
  167.     If FileNum = 0 Then NotGood = True: Exit Function
  168.     If FileNum > PackTotFiles Then NotGood = True: Exit Function
  169.     If PackFileType = 0 Then NotGood = True: Exit Function
  170. End Function
  171.  
  172.  
  173.