' --------------------------------------------------------------------------------
' Code generated automatically by Code Architects' VB Migration Partner
' --------------------------------------------------------------------------------
Option Strict Off ' Code migrated from VB6 has Option Strict disabled by default
Friend Class Cls_Arj
#Region "Constructor"
'A public default constructor
Public Sub New()
' Add initialization code here
End Sub
#End Region
'This class file can be used to show the contents of an ARJ-archive
Friend Structure ARJmainheader
Public Id As Short
Public Headersize As Short
Public Firsthdrsize As Byte
Public Version As Byte
Public Minversion As Byte
Public Archiveos As Byte
Public Flags As Byte
Public Secversion As Byte
Public Filetype As Byte
Public X_reserved As Byte
Public Createtime As Integer
Public Modifytime As Integer
Public FileSize As Integer
Public Secenvpos As Integer
Public Filespecpos As Short
Public Secenvlength As Short
Public X_notused As Short
End Structure
Friend Structure ARJlocalheader
Public Id As Short
Public Headersize As Short
Public Firsthdrsize As Byte
Public Version As Byte
Public Minversion As Byte
Public Archiveos As Byte
Public Flags As Byte
Public Method As Byte
Public Filetype As Byte
Public X_reserved As Byte
Public Datemodify As Integer
Public Sizecompr As Integer
Public Sizeorig As Integer
Public Origcrc As Integer
Public Filespecpos As Short
Public Accessmode As Short
Public Hostdata As Short
End Structure
Friend Structure ARJFileType
Public Id As Short
Public Headersize As Short
Public Firsthdrsize As Byte
Public Version As Byte
Public Minversion As Byte
Public Archiveos As Byte
Public Flags As Byte
Public Method As Byte
Public Filetype As Byte
Public X_reserved As Byte
Public FTime As Short
Public FDate As Short
Public Sizecompr As Integer
Public Sizeorig As Integer
Public Origcrc As Integer
Public Filespecpos As Short
Public Accessmode As Short
Public Hostdata As Short
Public StartSplit As Integer
Public FileName As String
Public FileComment As String
Public HeaderCRC As Integer
Public ExtHeadSize As Short
Public extHeader As String
Public ExtHeadCRC As Integer
Public DataOffSet As Integer
End Structure
Private ArjFileData() As Cls_Arj.ARJFileType
Private Const m_Unpack_Supported As Boolean = False
Public Function Get_Contents(ByVal ZipName As String) As Short
Dim FileNum As Integer
Dim FileLenght As Integer
Dim LngVal As Integer
Dim IntVal As Short
Dim IntVal2 As Short
Dim ByteVal As Byte
Dim LN As Integer
Dim X As Integer
PackFileName = ZipName
PackComments = ""
PackTotFiles = 0
PackFileType = 0
FileNum = FreeFile6()
FileOpen6(FileNum, PackFileName, OpenMode.Binary, OpenAccess.Read, OpenShare.Default, -1)
If LOF6(FileNum) < 2 Then
FileClose6(FileNum)
Exit Function
End If
'get the end of central date
FileGet6(FileNum, IntVal)
If IntVal = ARJHeader Then 'arj header
FileGet6(FileNum, IntVal) 'total header bytes
FileGet6(FileNum, LngVal, FileSeek6(FileNum) + IntVal) 'Header CRC
FileGet6(FileNum, IntVal) 'Lenght extra header data
If IntVal > 0 Then
FileGet6(FileNum, LngVal, FileSeek6(FileNum) + IntVal) 'Extra Header CRC
End If
PackFileType = Mod_Declarations.ARJFileType
'Whe reached the local header area so lets collecting the data
FileGet6(FileNum, IntVal)
Do While IntVal = ARJHeader 'arj header
FileGet6(FileNum, IntVal2)
If IntVal2 = 0 Then Exit Do 'HeaderSize
PackTotFiles += 1
ReDim Preserve ArjFileData(PackTotFiles)
With ArjFileData(PackTotFiles)
.Id = IntVal
.Headersize = IntVal2
FileGet6(FileNum, .Firsthdrsize)
FileGet6(FileNum, .Version)
FileGet6(FileNum, .Minversion)
FileGet6(FileNum, .Archiveos)
FileGet6(FileNum, .Flags)
FileGet6(FileNum, .Method)
FileGet6(FileNum, .Filetype)
FileGet6(FileNum, .X_reserved)
FileGet6(FileNum, .FTime)
FileGet6(FileNum, .FDate)
FileGet6(FileNum, .Sizecompr)
FileGet6(FileNum, .Sizeorig)
FileGet6(FileNum, .Origcrc)
FileGet6(FileNum, .Filespecpos)
FileGet6(FileNum, .Accessmode)
FileGet6(FileNum, .Hostdata)
If (.Flags And 8) Then FileGet6(FileNum, .StartSplit)
Do
FileGet6(FileNum, ByteVal)
If ByteVal = 0 Then Exit Do 'filename complete
.FileName &= Chr6(ByteVal)
Loop
Do
FileGet6(FileNum, ByteVal)
If ByteVal = 0 Then Exit Do 'filecomment complete
.FileComment &= Chr6(ByteVal)
Loop
FileGet6(FileNum, .HeaderCRC)
FileGet6(FileNum, .ExtHeadSize)
If .ExtHeadSize > 0 Then
.extHeader = String6(CInt(.ExtHeadSize), 0)
FileGet6(FileNum, .extHeader)
FileGet6(FileNum, .ExtHeadCRC)
End If
.DataOffSet = FileSeek6(FileNum)
FileGet6(FileNum, IntVal, FileSeek6(FileNum) + .Sizecompr) 'get new header
End With
Loop
End If
FileClose6(FileNum)
End Function
'Unzip as file and return 0 for good decompression or others for error
Public Function UnPack(ByVal ZippedFile() As Boolean, ByVal ToPath As String) As Short
Erase6(PackData)
End Function
Public Function Pack(ByVal ZipName As String, ByVal Files() As String, ByVal CompType As Short, ByVal CompLevel As Short, Optional ByVal IncludeDir As String = "") As Short
End Function
Public ReadOnly Property CanUnpack() As Boolean
Get
Return m_Unpack_Supported
End Get
End Property
Public ReadOnly Property FileCount() As Integer
Get
Return PackTotFiles
End Get
End Property
Public ReadOnly Property FileName(ByVal FileNum As Integer) As String
Get
If NotGood(FileNum) Then Exit Property
Return ArjFileData(FileNum).FileName
End Get
End Property
Public ReadOnly Property CommentsFile(ByVal FileNum As Integer) As String
Get
Return ArjFileData(FileNum).FileComment
End Get
End Property
Public ReadOnly Property CommentsPack() As String
Get
Return PackComments
End Get
End Property
Public ReadOnly Property IsDir(ByVal FileNum As Integer) As Boolean
Get
If NotGood(FileNum) Then Exit Property
If (ArjFileData(FileNum).Flags And 2) > 0 Then Return True
End Get
End Property
Public ReadOnly Property Method(ByVal FileNum As Integer) As String
Get
If NotGood(FileNum) Then Exit Property
Return Methods(CShort(ArjFileData(FileNum).Method))
End Get
End Property
Public ReadOnly Property CRC32(ByVal FileNum As Integer) As Integer
Get
If NotGood(FileNum) Then Exit Property
Return ArjFileData(FileNum).Origcrc
End Get
End Property
Public ReadOnly Property Compressed_Size(ByVal FileNum As Integer) As Integer
Get
If NotGood(FileNum) Then Exit Property
Return ArjFileData(FileNum).Sizecompr
End Get
End Property
Public ReadOnly Property UnCompressed_Size(ByVal FileNum As Integer) As Integer
Get
If NotGood(FileNum) Then Exit Property
Return ArjFileData(FileNum).Sizeorig
End Get
End Property
Public ReadOnly Property Encrypted(ByVal FileNum As Integer) As Boolean
Get
If NotGood(FileNum) Then Exit Property
Return (ArjFileData(FileNum).Flags And 1) = 1
End Get
End Property
Public ReadOnly Property FileDateTime(ByVal FileNum As Integer) As Date
Get
If NotGood(FileNum) Then Exit Property
Return GetZipDate(ArjFileData(FileNum).FDate, ArjFileData(FileNum).FTime)
End Get
End Property
Public ReadOnly Property SystemMadeBy(ByVal FileNum As Integer) As String
Get
If NotGood(FileNum) Then Exit Property
Return SystemName(ArjFileData(FileNum).Archiveos)
End Get
End Property
Public ReadOnly Property VersionMadeBy(ByVal FileNum As Integer) As String
Get
If NotGood(FileNum) Then Exit Property
Return VersionTo(ArjFileData(FileNum).Version)
End Get
End Property
Public ReadOnly Property SystemNeeded(ByVal FileNum As Integer) As String
Get
If NotGood(FileNum) Then Exit Property
Return SystemName(99)
End Get
End Property
Public ReadOnly Property VersionNeeded(ByVal FileNum As Integer) As String
Get
If NotGood(FileNum) Then Exit Property
Return VersionTo(ArjFileData(FileNum).Version)
End Get
End Property
Private Function NotGood(ByVal FileNum As Integer) As Boolean
If FileNum = 0 Then Return True
If FileNum > PackTotFiles Then Return True
If PackFileType = 0 Then Return True
End Function
Private Function DataSize() As Integer
On Error Resume Next
DataSize = UBound6(PackData) + 1
If Err.Number <> 0 Then
Err.Clear()
Return 0
End If
End Function
Private Function SystemName(ByVal System As Byte) As String
Select Case System
Case 0: Return "MS-DOS and OS/2 (FAT / VFAT / FAT32 file systems)"
Case 1: Return "Primos"
Case 2: Return "UNIX"
Case 3: Return "Amiga"
Case 4: Return "MAC-OS"
Case 5: Return "OS/2"
Case 6: Return "Apple GS"
Case 7: Return "Atari ST"
Case 8: Return "Next"
Case 9: Return "VAX VMS"
Case Else: Return "unKnown"
End Select
End Function
Private Function VersionTo(ByVal Version As Byte) As String
Return Fix(Version / 10) & "." & CInt(Version) Mod 10
End Function
Private Function Methods(ByVal MethodType As Short) As String
Select Case MethodType
Case 0: Return "No Compression"
Case 1: Return "Maximum"
Case 2: Return "Normal"
Case 3: Return "Small"
Case 4: Return "Fastest"
Case Else: Return "Unknown"
End Select
End Function
End Class