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_Arj.cls < prev    next >
Text File  |  2004-04-15  |  10KB  |  302 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_Arj"
  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 ARJ-archive
  16.  
  17. Private Type ARJmainheader
  18.    Id             As Integer
  19.    Headersize     As Integer
  20.    Firsthdrsize   As Byte
  21.    Version        As Byte
  22.    Minversion     As Byte
  23.    Archiveos      As Byte
  24.    Flags          As Byte
  25.    Secversion     As Byte
  26.    Filetype       As Byte
  27.    X_reserved     As Byte
  28.    Createtime     As Long
  29.    Modifytime     As Long
  30.    FileSize       As Long
  31.    Secenvpos      As Long
  32.    Filespecpos    As Integer
  33.    Secenvlength   As Integer
  34.    X_notused      As Integer
  35. End Type
  36. Private Type ARJlocalheader
  37.    Id             As Integer
  38.    Headersize     As Integer
  39.    Firsthdrsize   As Byte
  40.    Version        As Byte
  41.    Minversion     As Byte
  42.    Archiveos      As Byte
  43.    Flags          As Byte
  44.    Method         As Byte
  45.    Filetype       As Byte
  46.    X_reserved     As Byte
  47.    Datemodify     As Long
  48.    Sizecompr      As Long
  49.    Sizeorig       As Long
  50.    Origcrc        As Long
  51.    Filespecpos    As Integer
  52.    Accessmode     As Integer
  53.    Hostdata       As Integer
  54. End Type
  55. Private Type ARJFileType
  56.    Id             As Integer
  57.    Headersize     As Integer
  58.    Firsthdrsize   As Byte
  59.    Version        As Byte
  60.    Minversion     As Byte
  61.    Archiveos      As Byte
  62.    Flags          As Byte
  63.    Method         As Byte
  64.    Filetype       As Byte
  65.    X_reserved     As Byte
  66.    FTime          As Integer
  67.    FDate          As Integer
  68.    Sizecompr      As Long
  69.    Sizeorig       As Long
  70.    Origcrc        As Long
  71.    Filespecpos    As Integer
  72.    Accessmode     As Integer
  73.    Hostdata       As Integer
  74.    StartSplit     As Long
  75.    FileName       As String
  76.    FileComment    As String
  77.    HeaderCRC      As Long
  78.    ExtHeadSize    As Integer
  79.    extHeader      As String
  80.    ExtHeadCRC     As Long
  81.    DataOffSet     As Long
  82. End Type
  83.  
  84. Private ArjFileData() As ARJFileType
  85. Private Const m_Unpack_Supported As Boolean = False
  86.  
  87. Public Function Get_Contents(ZipName As String) As Integer
  88.     Dim FileNum As Long
  89.     Dim FileLenght As Long
  90.     Dim LngVal As Long
  91.     Dim IntVal As Integer
  92.     Dim IntVal2 As Integer
  93.     Dim ByteVal As Byte
  94.     Dim LN As Long
  95.     Dim X As Long
  96.     PackFileName = ZipName
  97.     PackComments = ""
  98.     PackTotFiles = 0
  99.     PackFileType = 0
  100.     FileNum = FreeFile
  101.     Open PackFileName For Binary Access Read As #FileNum
  102.     If LOF(FileNum) < 2 Then
  103.         Close #FileNum
  104.         Exit Function
  105.     End If
  106.     'get the end of central date
  107.     Get #FileNum, , IntVal
  108.     If IntVal = ARJHeader Then                              'arj header
  109.         Get #FileNum, , IntVal                              'total header bytes
  110.         Get #FileNum, Seek(FileNum) + IntVal, LngVal        'Header CRC
  111.         Get #FileNum, , IntVal                              'Lenght extra header data
  112.         If IntVal > 0 Then
  113.             Get #FileNum, Seek(FileNum) + IntVal, LngVal    'Extra Header CRC
  114.         End If
  115.         PackFileType = ARJFileType
  116. 'Whe reached the local header area so lets collecting the data
  117.         Get #FileNum, , IntVal
  118.         Do While IntVal = ARJHeader                         'arj header
  119.             Get #FileNum, , IntVal2
  120.             If IntVal2 = 0 Then Exit Do                     'HeaderSize
  121.             PackTotFiles = PackTotFiles + 1
  122.             ReDim Preserve ArjFileData(PackTotFiles)
  123.             With ArjFileData(PackTotFiles)
  124.                 .Id = IntVal
  125.                 .Headersize = IntVal2
  126.                 Get #FileNum, , .Firsthdrsize
  127.                 Get #FileNum, , .Version
  128.                 Get #FileNum, , .Minversion
  129.                 Get #FileNum, , .Archiveos
  130.                 Get #FileNum, , .Flags
  131.                 Get #FileNum, , .Method
  132.                 Get #FileNum, , .Filetype
  133.                 Get #FileNum, , .X_reserved
  134.                 Get #FileNum, , .FTime
  135.                 Get #FileNum, , .FDate
  136.                 Get #FileNum, , .Sizecompr
  137.                 Get #FileNum, , .Sizeorig
  138.                 Get #FileNum, , .Origcrc
  139.                 Get #FileNum, , .Filespecpos
  140.                 Get #FileNum, , .Accessmode
  141.                 Get #FileNum, , .Hostdata
  142.                 
  143.                 If (.Flags And 8) Then Get #FileNum, , .StartSplit
  144.                 Do
  145.                     Get #FileNum, , ByteVal
  146.                     If ByteVal = 0 Then Exit Do 'filename complete
  147.                     .FileName = .FileName & Chr(ByteVal)
  148.                 Loop
  149.                 Do
  150.                     Get #FileNum, , ByteVal
  151.                     If ByteVal = 0 Then Exit Do 'filecomment complete
  152.                     .FileComment = .FileComment & Chr(ByteVal)
  153.                 Loop
  154.                 Get #FileNum, , .HeaderCRC
  155.                 
  156.                 Get #FileNum, , .ExtHeadSize
  157.                 If .ExtHeadSize > 0 Then
  158.                     .extHeader = String(CLng(.ExtHeadSize), 0)
  159.                     Get #FileNum, , .extHeader
  160.                     Get #FileNum, , .ExtHeadCRC
  161.                 End If
  162.                 .DataOffSet = Seek(FileNum)
  163.                 Get #FileNum, Seek(FileNum) + .Sizecompr, IntVal                'get new header
  164.             End With
  165.         Loop
  166.     End If
  167.     Close FileNum
  168. End Function
  169.  
  170. 'Unzip as file and return 0 for good decompression or others for error
  171. Public Function UnPack(ZippedFile() As Boolean, ToPath As String) As Integer
  172.     
  173.     Erase PackData
  174. End Function
  175.  
  176. Public Function Pack(ZipName As String, Files() As String, CompType As Integer, CompLevel As Integer, Optional IncludeDir As String = "") As Integer
  177.     
  178. End Function
  179.  
  180. Public Property Get CanUnpack() As Boolean
  181.     CanUnpack = m_Unpack_Supported
  182. End Property
  183.  
  184. Public Property Get FileCount() As Long
  185.     FileCount = PackTotFiles
  186. End Property
  187.  
  188. Public Property Get FileName(FileNum As Long) As String
  189.     If NotGood(FileNum) Then Exit Property
  190.     FileName = ArjFileData(FileNum).FileName
  191. End Property
  192.  
  193. Public Property Get CommentsFile(FileNum As Long) As String
  194.     CommentsFile = ArjFileData(FileNum).FileComment
  195. End Property
  196.  
  197. Public Property Get CommentsPack() As String
  198.     CommentsPack = PackComments
  199. End Property
  200.  
  201. Public Property Get IsDir(FileNum As Long) As Boolean
  202.     If NotGood(FileNum) Then Exit Property
  203.     If (ArjFileData(FileNum).Flags And 2) > 0 Then IsDir = True
  204. End Property
  205.  
  206. Public Property Get Method(FileNum As Long) As String
  207.     If NotGood(FileNum) Then Exit Property
  208.     Method = Methods(CInt(ArjFileData(FileNum).Method))
  209. End Property
  210.  
  211. Public Property Get CRC32(FileNum As Long) As Long
  212.     If NotGood(FileNum) Then Exit Property
  213.     CRC32 = ArjFileData(FileNum).Origcrc
  214. End Property
  215.  
  216. Public Property Get Compressed_Size(FileNum As Long) As Long
  217.     If NotGood(FileNum) Then Exit Property
  218.     Compressed_Size = ArjFileData(FileNum).Sizecompr
  219. End Property
  220.  
  221. Public Property Get UnCompressed_Size(FileNum As Long) As Long
  222.     If NotGood(FileNum) Then Exit Property
  223.     UnCompressed_Size = ArjFileData(FileNum).Sizeorig
  224. End Property
  225.  
  226. Public Property Get Encrypted(FileNum As Long) As Boolean
  227.     If NotGood(FileNum) Then Exit Property
  228.     Encrypted = (ArjFileData(FileNum).Flags And 1) = 1
  229. End Property
  230.  
  231. Public Property Get FileDateTime(FileNum As Long) As Date
  232.     If NotGood(FileNum) Then Exit Property
  233.     FileDateTime = GetZipDate(ArjFileData(FileNum).FDate, ArjFileData(FileNum).FTime)
  234. End Property
  235.  
  236. Public Property Get SystemMadeBy(FileNum As Long) As String
  237.     If NotGood(FileNum) Then Exit Property
  238.     SystemMadeBy = SystemName(ArjFileData(FileNum).Archiveos)
  239. End Property
  240.  
  241. Public Property Get VersionMadeBy(FileNum As Long) As String
  242.     If NotGood(FileNum) Then Exit Property
  243.     VersionMadeBy = VersionTo(ArjFileData(FileNum).Version)
  244. End Property
  245.  
  246. Public Property Get SystemNeeded(FileNum As Long) As String
  247.     If NotGood(FileNum) Then Exit Property
  248.     SystemNeeded = SystemName(99)
  249. End Property
  250.  
  251. Public Property Get VersionNeeded(FileNum As Long) As String
  252.     If NotGood(FileNum) Then Exit Property
  253.     VersionNeeded = VersionTo(ArjFileData(FileNum).Version)
  254. End Property
  255.  
  256. Private Function NotGood(FileNum As Long) As Boolean
  257.     If FileNum = 0 Then NotGood = True: Exit Function
  258.     If FileNum > PackTotFiles Then NotGood = True: Exit Function
  259.     If PackFileType = 0 Then NotGood = True: Exit Function
  260. End Function
  261.  
  262. Private Function DataSize() As Long
  263.     On Error Resume Next
  264.     DataSize = UBound(PackData) + 1
  265.     If Err.Number <> 0 Then
  266.         Err.Clear
  267.         DataSize = 0
  268.     End If
  269. End Function
  270.  
  271. Private Function SystemName(System As Byte) As String
  272.     Select Case System
  273.     Case 0:     SystemName = "MS-DOS and OS/2 (FAT / VFAT / FAT32 file systems)"
  274.     Case 1:     SystemName = "Primos"
  275.     Case 2:     SystemName = "UNIX"
  276.     Case 3:     SystemName = "Amiga"
  277.     Case 4:     SystemName = "MAC-OS"
  278.     Case 5:     SystemName = "OS/2"
  279.     Case 6:     SystemName = "Apple GS"
  280.     Case 7:     SystemName = "Atari ST"
  281.     Case 8:     SystemName = "Next"
  282.     Case 9:     SystemName = "VAX VMS"
  283.     Case Else:  SystemName = "unKnown"
  284.     End Select
  285. End Function
  286.  
  287. Private Function VersionTo(Version As Byte) As String
  288.     VersionTo = Fix(Version / 10) & "." & Version Mod 10
  289. End Function
  290.  
  291. Private Function Methods(MethodType As Integer) As String
  292.     Select Case MethodType
  293.         Case 0: Methods = "No Compression"
  294.         Case 1: Methods = "Maximum"
  295.         Case 2: Methods = "Normal"
  296.         Case 3: Methods = "Small"
  297.         Case 4: Methods = "Fastest"
  298.         Case Else: Methods = "Unknown"
  299.     End Select
  300. End Function
  301.  
  302.