vb调用zlib解压zip

模块:

Option Explicit
Private Type tm_unz
    tm_sec As Long
    tm_min As Long
    tm_hour As Long
    tm_mday As Long
    tm_mon As Long
    tm_year As Long
End Type

Private Type unz_global_info
    number_entry As Long

    size_comment As Long
End Type

Private Type unz_file_info
    version As Long
    version_needed As Long
    flag As Long
    compression_method As Long
    dosDate As Long
    crc As Long
    compressed_size As Long
    uncompressed_size As Long
    size_filename As Long
    size_file_extra As Long
    size_file_comment As Long

    disk_num_start As Long
    internal_fa As Long
    external_fa As Long

    tmu_date As tm_unz
End Type
Private Declare Function unzOpen Lib "ZLIB.DLL" (ByVal FilePath As String) As Long
Private Declare Function unzClose Lib "ZLIB.DLL" (ByVal hFile As Long) As Long
Private Declare Function unzGetGlobalInfo Lib "ZLIB.DLL" (ByVal hFile As Long, ByRef pglobal_info As unz_global_info) As Long
Private Declare Function unzGetCurrentFileInfo Lib "ZLIB.DLL" (ByVal hFile As Long, _
                         ByRef pfile_info As unz_file_info, _
                         ByVal szFileName As String, _
                         ByVal fileNameBufferSize As Long, _
                         ByRef extraField As Long, _
                         ByVal extraFieldBufferSize As Long, _
                         ByVal szComment As String, _
                         ByVal commentBufferSize As String) As Long
Private Declare Function unzOpenCurrentFile Lib "ZLIB.DLL" (ByVal hFile As Long) As Long
Private Declare Function unzCloseCurrentFile Lib "ZLIB.DLL" (ByVal hFile As Long) As Long
Private Declare Function unzReadCurrentFile Lib "ZLIB.DLL" (ByVal hFile As Long, _
                      ByRef Buffer As Byte, _
                      ByVal BuffLen As Long) As Long
Private Declare Function unzGoToNextFile Lib "ZLIB.DLL" (ByVal hFile As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function CreateDirectory Lib "kernel32" Alias "CreateDirectoryA" (ByVal lpPathName As String, lpSecurityAttributes As SECURITY_ATTRIBUTES) As Long
Private Type SECURITY_ATTRIBUTES
        nLength As Long
        lpSecurityDescriptor As Long
        bInheritHandle As Long
End Type

Private Const BUFFERSIZE        As Long = 2048
Private Const MAX_PATH          As Long = 260
Private Const MAX_COMMENT       As Long = 255
Private strFileNameBuff         As String * MAX_PATH
Private szComment               As String * MAX_COMMENT
Private hFile                   As Long
Private buff()                  As Byte

Public Sub UnZipTo(ByVal strPath As String, ByVal strZipFile As String)
Dim strFileName             As String
Dim tPath                   As String
Dim info                    As unz_file_info
Dim i                       As Long
ReDim buff(BUFFERSIZE - 1) As Byte

hFile = unzOpen(strZipFile)
If hFile = 0 Then Exit Sub

strPath = Replace(strPath & "\", "\\", "\")
If Dir(strPath, vbDirectory) = "" Then Call CreateFloder(strPath)

Do
    i = unzGetCurrentFileInfo(hFile, info, strFileNameBuff, MAX_PATH, 0, 0, szComment, MAX_COMMENT)

    strFileName = Left(strFileNameBuff, info.size_filename)
    tPath = strPath
    If InStr(strFileName, "/") > 0 Then
        strFileName = Replace(strFileName, "/", "\")
        tPath = CreateFloder(GetPath(strPath & strFileName))
        strFileName = GetFileName(strFileName)
    End If

    i = unzOpenCurrentFile(hFile)

    If (info.external_fa And &H10) = 0 Then
        Open tPath & strFileName For Binary As #1
        Do
            i = unzReadCurrentFile(hFile, buff(0), BUFFERSIZE)
            If i = 0 Then Exit Do
            If i < BUFFERSIZE Then
                ReDim tbuff(i - 1) As Byte
                Call CopyMemory(tbuff(0), buff(0), i)
                Put #1, , tbuff
            Else
                Put #1, , buff
            End If
        Loop Until (i < BUFFERSIZE)
        Close #1
    End If

Loop Until (unzGoToNextFile(hFile) <> 0)
i = unzCloseCurrentFile(hFile)
i = unzClose(hFile)
End Sub

Private Function CreateFloder(ByVal strPath As String) As String
Dim tmpPath As String
Dim t       As SECURITY_ATTRIBUTES
Dim i       As Long
Dim Index   As Integer
strPath = Replace(strPath & "\", "\\", "\")
Do
    Index = InStr(Index + 1, strPath, "\")
    tmpPath = Left(strPath, Index)

    If Dir(tmpPath, vbDirectory) = "" Then
        i = CreateDirectory(tmpPath, t)
    End If

Loop Until (Dir(strPath, vbDirectory) <> "")
CreateFloder = strPath
End Function

Private Function GetFileName(ByVal strPath As String) As String
Dim i As Integer
        i = InStrRev(strPath, "\")
        GetFileName = Right(strPath, Len(strPath) - i)
End Function

Private Function GetPath(ByVal strPath As String) As String
Dim i As Integer
        i = InStrRev(strPath, "\")
        GetPath = Left(strPath, i)
End Function

窗口:

Private Sub Command1_Click()
    Dim a As String
    Dim b As String
    a = App.Path & "\"
    b = App.Path & "\Demo.zip"
    Label1.Caption = "当前解压文件名:" & b
    Call UnZipTo(a, b)
    MsgBox "解压ZIP文件成功"
    Label2.Caption = "解压后输出地址:" & a
End Sub
Private Sub Form_Unload(Cancel As Integer)
    End
End Sub

vb调用zlib解压zip


本站如无特别说明即为原创,转而告知:(https://iwonmo.com/archives/1066.html)

标签: visual basic 6.0, vb, zlib, zip

添加新评论