wizard.bas

一个兼容pkzip的文件/内存压缩算法

Attribute VB_Name = "Module2"
#If Win16 Then
Declare Function GetDriveType Lib "Kernel" (ByVal nDrive As Integer) As Integer
#Else
Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
#End If
Public Const DRIVE_REMOVABLE = 2

Function GetAction(cFrom As String) As String
    GetAction = GetPiece(cFrom, "|", 2)
End Function

Function GetFileCompressedSize(cFrom As String) As Long
    GetFileCompressedSize = Val(GetPiece(cFrom, "|", 7))
End Function

Function GetFileCompressionRatio(cFrom As String) As Integer
    GetFileCompressionRatio = Val(GetPiece(cFrom, "|", 8))
End Function
Function GetPercentComplete(cFrom As String) As Integer
    GetPercentComplete = Val(GetPiece(cFrom, "|", 8))
End Function

Function GetFileName(cFrom As String) As String
    GetFileName = GetPiece(cFrom, "|", 5)
End Function

Function GetFileOriginalSize(cFrom As String) As Long
    GetFileOriginalSize = Val(GetPiece(cFrom, "|", 6))
    Debug.Print Val(GetPiece(cFrom, "|", 6))
End Function

Function GetFilePath(cFrom As String) As String
    GetFilePath = GetPiece(cFrom, "|", 4)
End Function
Function GetPiece(from As String, delim As String, Index As Integer) As String
    Dim temp$
    Dim Count As Integer
    Dim Where As Integer
    '
    temp$ = from & delim
    Where = InStr(temp$, delim)
    Count = 0
    Do While (Where > 0)
        Count = Count + 1
        If (Count = Index) Then
            GetPiece = Left$(temp$, Where - 1)
            Exit Function
        End If
        temp$ = Right$(temp$, Len(temp$) - Where)
        Where = InStr(temp$, delim)
    Loop
    If (Count = 0) Then
        GetPiece = from
    Else
        GetPiece = ""
    End If
End Function