Autor
Código:
'---------------------------------------------------------------------------------------
' Module : mZIPInfo
' DateTime : 10/12/2010 10:45
' Author : Cobein
' Mail : cobein27@hotmail.com
' WebPage : http://www.advancevb.com.ar
' Purpose : Read file/folder info from zip files
' Usage : At your own risk
' Requirements: None
' Distribution: You can freely use this code in your own
' applications, but you may not reproduce
' or publish this code on any web site,
' online service, or distribute as source
' on any media without express permission.
'
' Reference : http://www.pkware.com/documents/casestudies/APPNOTE.TXT
'
' History : 10/12/2010 First Cut....................................................
'---------------------------------------------------------------------------------------
Option Explicit
Private Const ZIP_SIGNATURE As Long = &H4034B50
Private Type tZipHeader
Signature As Long
Version As Integer
Flag As Integer
Compression As Integer
FileTime As Integer
FileDate As Integer
CRC As Long
CompZise As Long
UncompSize As Long
NameLength As Integer
ExtraLength As Integer
End Type
Public Function ReadZipInfo(ByVal sFile As String) As Collection
Dim iFile As Integer
Dim tHead As tZipHeader
Dim sName As String
Dim sExtra As String
Dim lOffset As Long
Dim cNames As New Collection
On Local Error GoTo ReadZipInfo_Error
iFile = FreeFile
lOffset = 1
Open sFile For Binary Access Read As iFile
NextHead:
Get iFile, lOffset, tHead
With tHead
If .Signature = ZIP_SIGNATURE Then
sName = Space(.NameLength)
Get iFile, , sName
sExtra = Space(.ExtraLength)
Get iFile, , sExtra
Call cNames.Add(sName)
lOffset = lOffset + .CompZise + 30 + .ExtraLength + .NameLength
GoTo NextHead:
End If
End With
Close iFile
Set ReadZipInfo = cNames
On Error GoTo 0
Exit Function
ReadZipInfo_Error:
Close iFile
Set ReadZipInfo = cNames
End Function
En línea
