谁能帮我分析一下这个VB源码

qq5531671

我不懂VB........但是我看不懂......哪位高手可以给我解释一下里面的核心内存是什么
易语言如何调用zlib1.dll来进行打包和解压
'说明：在VB下运行会出现“DLL 的调用约定错误（错误 49）”

'但编译后再运行EXE则运行正常
'zlib1.dll不用注册或复制到系统目录下，程序首先会在当前目录下查找该文件,有则使用它。

'VB的Open语句打开文件，第1个字节位于1，而WinHex等十六进制编辑器第1个字节位于0

'---------------------------------------------------------------------

Option Explicit

Dim strFileName  As String

Dim lngFileCount As Long                '打包的文件总数
Dim strFileList() As String             '保存文件的名字路径 列表
Dim lngFileStartOffsetList() As Long    '保存文件起始偏移 列表
Dim lngFileOriginSizeList() As Long     '保存文件的原始大小 列表
Dim lngFileSizeList() As Long           '保存文件的大小 列表

Dim lngFileListPos As Long              '文件列表区的偏移地址
Dim lngFileListSize As Long             '文件列表区的大小

Dim strPkgDirName As String


Const pkgFileHead As Long = &H64        '文件头 64 00 00 00


Private Function ReadPkgFile(strFileName As String) As Long
'读取P文件

    Dim lngTmp As Long          '4字节
    Dim intTmp As Integer       '2字节
    Dim bytFilePath() As Byte
    Dim i As Long
   
    i = 0
   
    Open strFileName For Binary As #1
    Get #1, , lngTmp                '1 - 4
    '判断文件头是否是p文件
    If lngTmp <> pkgFileHead Then Exit Function
    '获取打包的文件个数
    Get #1, , lngFileCount          '5 - 8
    ReDim strFileList(lngFileCount - 1)
    ReDim lngFileStartOffsetList(lngFileCount - 1)
    ReDim lngFileSizeList(lngFileCount - 1)
    ReDim lngFileOriginSizeList(lngFileCount - 1)
   
   
    '获取文件列表区的偏移地址
    Get #1, , lngFileListPos        '9 - 12
    '获取文件列表区的大小
    Get #1, , lngFileListSize       '13 - 16
   
    '转到文件列表区的位置开始读写
    Seek #1, lngFileListPos + 1
   
    Do Until EOF(1)
        Get #1, , intTmp        '后面的文件路径名称的长度
        ReDim bytFilePath(intTmp - 1)
        Get #1, , bytFilePath   '文件路径名称
        strFileList(i) = StrConv(bytFilePath(), vbUnicode)
        Get #1, , lngTmp        '00 00 00 00，大概是起分隔作用吧
        If lngTmp = 0 Then
        '无需处理
        End If
        Get #1, , lngTmp        '文件起始偏移地址
        lngFileStartOffsetList(i) = lngTmp
        Get #1, , lngTmp        '原始文件大小
        lngFileOriginSizeList(i) = lngTmp
        Get #1, , lngTmp        '文件结束偏移地址
        lngFileSizeList(i) = lngTmp
        '一个文件记录结束
        i = i + 1
        
        If Seek(1) >= lngFileListPos + lngFileListSize Then         '偏移+ 1，大小 -1 ，正好抵消
            Exit Do
        End If
    Loop
   
    Close #1
   
    '返回值就是打包的文件个数
    ReadPkgFile = i
   

End Function

Private Function GetSingleFileData(ByVal No As Long) As Byte()
    Dim bytFileData() As Byte
    Dim lngFileSize As Long
   
    ReDim bytFileData(lngFileSizeList(No) - 1)
   
    Open strFileName For Binary As #1
    '转到文件列表区的位置开始读写
    Seek #1, lngFileStartOffsetList(No) + 1
    Get #1, , bytFileData
    Close #1
    GetSingleFileData = bytFileData

End Function

Private Sub cmdExit_Click()
    Unload Me

End Sub

Private Sub cmdOpen_Click()
'打开p文件
    Dim i As Long
    Dim lngFileCount As Long        '打包的文件个数

    CD.Filter = "Q文件(*.0.0)|*.0.0"
    CD.ShowOpen
    If CD.FileName = "" Then Exit Sub
    strFileName = CD.FileName
    lngFileCount = ReadPkgFile(strFileName)
    List1.Clear
    For i = 0 To (lngFileCount - 1)
        List1.AddItem strFileList(i)
    Next

End Sub




Private Function FileExist(ByRef inFile As String) As Boolean
    On Error Resume Next
    FileExist = CBool(FileLen(inFile) + 1)
   
End Function

Private Function FileToBuf(ByRef inFile As String, ByRef outBuf() As Byte) As Long
'读取二进制文件到字节数组

    Dim FNum As Integer
    Dim RetBuf() As Byte

    If (Not FileExist(inFile)) Then Exit Function
   
    FNum = FreeFile()
    Open inFile For Binary Access Read Lock Write As #FNum
    ReDim RetBuf(0 To (LOF(FNum) - 1)) As Byte
    Get #FNum, , RetBuf()
    Close #FNum

    outBuf = RetBuf
    FileToBuf = UBound(RetBuf) + 1
   
End Function

Private Sub SaveFile(ByRef bytData() As Byte, strFile As String)
'把字节数组写入二进制文件保存
   
    Open strFile For Binary Access Write As #1
    Put #1, , bytData()
    Close #1
   
End Sub

Private Sub Log(strText As String)
'输出日志到文件
   
    Open App.Path & "\log.txt" For Append As #1
    Print #1, strText
    Close #1
   
End Sub


Private Function CompressBytes(ByRef Bytes() As Byte, ByRef outBuf() As Byte) As Boolean
'压缩 二进制文件的字节数组 到 输出字节数组

    Dim CompressBuf() As Byte
    Dim CompressLen As Long
    Dim RetVal As Long
   
    CompressLen = compressBound(UBound(Bytes) + 1)
    ReDim CompressBuf(0 To (CompressLen - 1)) As Byte
   
    RetVal = compress(CompressBuf(0), CompressLen, Bytes(0), UBound(Bytes) + 1)
    If (RetVal = Z_OK) Then
        '成功压缩后，CompressLen会变成压缩后数据的真实大小
        ReDim Preserve CompressBuf(0 To (CompressLen - 1))      '把多余的字节去掉
        outBuf = CompressBuf
        CompressBytes = True
        
    Else
        CompressBytes = False
    End If

   

End Function



Private Function UnCompressBytes(ByRef Bytes() As Byte, ByRef OriginalSize As Long) As Byte()
'解压 压缩文件的字节数组 到 输出字节数组

    Dim DecompressBuf() As Byte
    Dim DecompressLen As Long
    Dim RetVal As Long
   
    DecompressLen = OriginalSize
    ReDim DecompressBuf(0 To (DecompressLen - 1)) As Byte       '注意这里分配缓冲区一定要足够大
   
    RetVal = uncompress(DecompressBuf(0), DecompressLen, Bytes(0), UBound(Bytes) + 1)
'    MsgBox RetVal
    UnCompressBytes = DecompressBuf

End Function



Private Sub cmdSaveOriginFile_Click()
   
    Dim i As Long
    strPkgDirName = Trim$(txtPkgDirName.Text)
    If Dir$(App.Path & "\" & strPkgDirName, vbDirectory) = "" Then
        MkDir App.Path & "\" & strPkgDirName
    End If
   
    ' 如果一个文件项被选中，那么将它保存到文件。
    For i = 0 To List1.ListCount - 1
        If List1.Selected(i) Then
            Call MakeDirectory(App.Path & "\" & strPkgDirName & "\", GetPath(strFileList(i)))
            Call SaveFile(GetSingleFileData(i), App.Path & "\" & strPkgDirName & "\" & strFileList(i))

           
        End If
    Next i
   
    MsgBox "保存文件成功!", vbInformation
   

End Sub

Private Sub cmdSaveUnComFile_Click()

    Dim i As Long
    Dim bytData() As Byte
    Dim bytUnComData() As Byte
    Dim Ret As Boolean
    Dim strMsg As String
   
    strPkgDirName = Trim$(txtPkgDirName.Text)
    If Dir$(App.Path & "\" & strPkgDirName, vbDirectory) = "" Then
        MkDir App.Path & "\" & strPkgDirName
    End If
   
    ' 如果一个文件项被选中，那么将它保存到文件。
    For i = 0 To List1.ListCount - 1
        If List1.Selected(i) Then
            Call MakeDirectory(App.Path & "\" & strPkgDirName & "\", GetPath(strFileList(i)))
            bytData = GetSingleFileData(i)
           
            '---------------------------------------------------------------------------------
            Dim DecompressBuf() As Byte
            Dim DecompressLen As Long
            Dim RetVal As Long
            
            '这里假设并不知道原文件的大小，按照一般的压缩率计算，不会小于10%，就按照压缩文件大小的10倍来算
            DecompressLen = lngFileOriginSizeList(i)
            ReDim DecompressBuf(0 To (DecompressLen - 1)) As Byte       '注意这里分配缓冲区一定要足够大
            
            RetVal = uncompress(DecompressBuf(0), DecompressLen, bytData(0), UBound(bytData) + 1)
            
            Call SaveFile(DecompressBuf(), App.Path & "\" & strPkgDirName & "\" & strFileList(i))
            '---------------------------------------------------------------------------------
           
        End If
    Next
   
    MsgBox "保存解出的文件成功！", vbInformation

End Sub

Private Sub List1_Click()
'点击文件名，显示文件信息

    lblCount.Caption = CStr(List1.ListIndex + 1) & "/" & List1.ListCount
    txtStartOffset.Text = Hex$(lngFileStartOffsetList(List1.ListIndex))
    txtEndOffset.Text = Hex$(lngFileSizeList(List1.ListIndex))
    txtOriginSize.Text = Hex$(lngFileOriginSizeList(List1.ListIndex))
   
End Sub

Private Function GetPath(strFilePath As String) As String
'根据完整文件路径获取相对目录，即去掉\符号和文件名
    Dim intPos As Integer
    intPos = InStrRev(strFilePath, "\")
    GetPath = Mid$(strFilePath, 1, intPos - 1)
   
End Function

Private Sub MakeDirectory(strMainDir As String, strDirPath As String)
'根据一个相对目录路径名，判断目录是否存在，不存在则建立
'参数：
'strMainDir - 完整目录名后面带有\符号，在这个目录下检查strDirPath的文件夹是否存在
'strDirPath - 目录路径名，后面不带有\符号

    Dim strPart() As String
    Dim i As Integer
    Dim strDir As String
   
    strPart = Split(strDirPath, "\")
    For i = 0 To UBound(strPart)
        strDir = strDir & strPart(i) & "\"
        If Dir$(strMainDir & strDir, vbDirectory) = "" Then
            MkDir strMainDir & strDir
        End If
    Next
   
End Sub

Tocurd

他不是解释的很清楚么

a1119309917

貌似后面有解释。。。。