Obsah kompresovan²ch soubor∙ ARJ/ZIP
Funkce:
Private
Type ZFHeader
Signature As Long
version As Integer
GPBFlag As Integer
Compress As Integer
Date
As Integer
Time
As Integer
CRC32 As
Long
CSize As
Long
USize As
Long
FNameLen As Integer
ExtraField As Integer
End Type
Private Type
ARJmainheader
id
As Integer
headersize As Integer
firsthdrsize As Byte
version As Byte
minversion As Byte
archiveos As Byte
flags As
Byte
secversion As Byte
filetype As Byte
x_reserved As Byte
createtime As Long
modifytime As Long
FileSize As Long
secenvpos As Long
filespecpos As Integer
secenvlength As Integer
x_notused As Integer
End Type
Private Type
ARJlocalheader
id
As Integer
headersize As Integer
firsthdrsize As Byte
version As Byte
minversion As Byte
archiveos As Byte
flags As
Byte
method As Byte
filetype As Byte
x_reserved As Byte
datemodify As Long
sizecompr As Long
sizeorig As Long
origcrc As Long
filespecpos As Integer
accessmode As Integer
hostdata As Integer
End Type
Private Type LZHheader
headersize As Byte
remaincrc As Byte
id
As String * 3
method As
String * 1
id2
As String * 1
sizecompr As Long
sizeorig As Long
filedate As Long
fileattrib As Integer
filenamelen As Byte
End Type
Private Function
StripGarbage(ByVal str As String) As String
Dim sTmp As String, ch As String * 1, i As Integer
For i = 1
To Len(str)
ch = Mid$(str, i, 1)
If ch <> Chr$(0) Then
sTmp = sTmp & ch
Else
StripGarbage = sTmp
Exit Function
End If
Next
End Function
Public Sub AddLZHfiles(LZHfile
As String, LBox As ListBox)
Dim FNum As Integer, LZHrec As LZHheader, NameStr As String
FNum =
FreeFile
Open LZHfile For Binary Lock Write As #FNum
Do
If (Loc(FNum) + Len(LZHrec)) > LOF(FNum)
Then Exit Do
Get FNum, , LZHrec
If Left$(LZHrec.id, 2) = "-l" Then
NameStr = Space$(LZHrec.filenamelen)
Get FNum, , NameStr
LBox.AddItem Trim$(NameStr) & Chr$(9) & Chr$(9) & LZHrec.sizeorig
Seek FNum, Loc(FNum) + 2 + LZHrec.sizecompr + 4
End If
Loop Until EOF(FNum)
Close FNum
End Sub
Public Sub AddARJfiles(ARJfile
As String, LBox As ListBox)
Dim FNum As Integer, ARJrec As ARJmainheader, FILrec As
ARJlocalheader, FPos As Long
Dim NameStr As String * 256
FNum =
FreeFile
Open ARJfile For Binary Lock Write As #FNum
Get FNum, ,
ARJrec
If ARJrec.id = -5536 Then
Seek FNum, ARJrec.headersize + 11
Do
If (Loc(FNum) + Len(FILrec))
> LOF(FNum) Then Exit Do
FPos = Loc(FNum)
Get FNum, , FILrec
If FILrec.id = -5536 Then
Get FNum,
, NameStr
NameStr =
StripGarbage(NameStr)
LBox.AddItem Trim$(NameStr) & Chr$(9) & Chr$(9) & FILrec.sizeorig
Seek FNum, FPos
Seek FNum,
Loc(FNum) + FILrec.headersize + 12 + FILrec.sizecompr
End If
Loop Until EOF(FNum)
End If
Close FNum
End Sub
Public Sub AddZIPfiles(ByVal
ZIPfile As String, LBox As ListBox)
Dim FNum As Integer, sRet As String
Dim iCounter As Integer, sResult As String
Dim zhdr As ZFHeader
Const ZIPSIG = &H4034B50
FNum =
FreeFile
Open ZIPfile For Binary Lock Read Write As #FNum
Get #FNum, , zhdr
While zhdr.Signature
= ZIPSIG
ReDim s(0 To zhdr.FNameLen - 1) As String * 1
For iCounter = 0 To UBound(s)
s(iCounter) = Chr$(0)
Next
For iCounter = 0 To zhdr.FNameLen - 1
Get #FNum, , s(iCounter)
Next
Seek #FNum, Seek(FNum) + zhdr.CSize + zhdr.ExtraField
sResult = ""
For iCounter = 0 To UBound(s)
sResult = sResult & s(iCounter)
Next
LBox.AddItem sResult & Chr$(9) & Format$(zhdr.USize)
Get #FNum, , zhdr
Wend
Close FNum
End Sub
P°φklad pou₧itφ:
'Na formulß°i musφ
b²t ListBox
'VÜechny funkce do ListBoxu zapisujφ data. Pokud chcete data zobrazovat v
jinΘm prvku, musφte
'funkce upravit
AddZIPfiles
"C:\myZipFile.zip", List1