classzip.cls

VB写的文件压缩算法

                        aintWindowNext(aintWindowPrev(intNext)) = aintWindowNext(intNext)
                        aintWindowPrev(aintWindowNext(intNext)) = aintWindowPrev(intNext)
                        aintWindowNext(intNext) = mcintNull
                        aintWindowPrev(intNext) = mcintNull
                    End If
                    If lngInPos < lngInBufLen Then
                        abytWindow(intNext) = abytInBuf(lngInPos)
                        If intPrev >= mcintWindowSize Then abytWindow(intPrev) = abytInBuf(lngInPos)
                        lngBytesRead = lngBytesRead + 1
                        lngInPos = lngInPos + 1
                        If lngInPos >= lngInBufLen Then
                            If lngFileLength > lngBytesRead Then
                                If lngInBufLen > lngFileLength - lngBytesRead Then
                                    lngInBufLen = lngFileLength - lngBytesRead
                                    ReDim abytInBuf(lngInBufLen - 1)
                                End If
                                Get intInputFile, , abytInBuf
                                lngInPos = 0
                                RaiseEvent FileProgress(lngBytesRead / lngFileLength)
                                DoEvents
                                If m_bEnableProcss = False Then intErrNo = 254:  GoTo PROC_ERR
                           End If
                        End If
                    End If
                    intPrev = ((&H100& * abytWindow(intBufferLocation + 1) + abytWindow(intBufferLocation)) And &HFFF) + mcintWindowSize + 1
                    intNext = aintWindowNext(intPrev)
                    aintWindowPrev(intBufferLocation) = intPrev
                    aintWindowNext(intBufferLocation) = intNext
                    aintWindowNext(intPrev) = intBufferLocation
                    If Not (intNext And mcintNull) Then aintWindowPrev(intNext) = intBufferLocation
                    intBufferLocation = (intBufferLocation + 1) And &HFFF
                    intMatchLen = intMatchLen - 1
                Loop
                If lngInPos >= lngInBufLen Then intMaxLen = intMaxLen - 1
            Loop
            If intByteCodeWritten > 0 Then
                If lngOutBufLen - lngOutPos >= intByteCodeWritten Then ReDim Preserve abytOutBuf(lngOutPos + intByteCodeWritten - 1)
                CopyMemory abytOutBuf(lngOutPos), abytOutputBuffer(0), intByteCodeWritten
                lngOutPos = lngOutPos + intByteCodeWritten
            End If
            If lngOutPos > 0 Then Put intOutputFile, , abytOutBuf
        Close intInputFile
    Close intOutputFile
    If Len(Dir(m_strOutputFileName)) > 0 Then Kill m_strOutputFileName
    Name strOutTmpFile As m_strOutputFileName
    RaiseEvent FileProgress(1)
    Exit Sub
PROC_ERR:
    Close intOutputFile
    Close intInputFile
    If Len(Dir(strOutTmpFile)) > 0 And Len(strOutTmpFile) > 0 Then Kill strOutTmpFile
    If intErrNo = 0 Then intErrNo = 255
    RaiseEvent ProcssError(LastError(intErrNo))
End Sub

Private Sub Class_Terminate()
    m_bEnableProcss = False
End Sub

Private Sub Decompress()
    Dim intTemp As Integer
    Dim intBufferLocation As Integer
    Dim intLength As Integer
    Dim bytHiByte As Integer
    Dim bytLoByte As Integer
    Dim intWindowPosition As Integer
    Dim lngFlags As Long
    Dim intInputFile As Integer
    Dim intOutputFile As Integer
    Dim abytWindow(mcintWindowSize + mcintMaxMatchLen) As Byte
    Dim strOutTmpFile As String
    Dim lngBytesRead As Long
    Dim lngBytesWritten As Long
    Dim lngFileLength As Long
    Dim lngOriginalFileLen As Long
    Dim lngInBufLen As Long, abytInBuf() As Byte, abytOutBuf() As Byte
    Dim lngOutBufLen As Long, lngInPos As Long, lngOutPos As Long
    Dim udtFileH As FileHeader
    Dim intErrNo As Integer
    On Error GoTo PROC_ERR
    m_bEnableProcss = True
    If Len(Dir(m_strInputFileName)) = 0 Or Len(m_strInputFileName) = 0 Then intErrNo = 4:  GoTo PROC_ERR
    If Len(m_strOutputFileName) = 0 Then m_strOutputFileName = m_strInputFileName
    strOutTmpFile = m_strOutputFileName & ".tmp"
    If Len(Dir(strOutTmpFile)) > 0 Then Kill strOutTmpFile
    intInputFile = FreeFile
    Open m_strInputFileName For Binary Access Read As intInputFile
        lngFileLength = LOF(intInputFile)
        Get intInputFile, , udtFileH
        If udtFileH.HeaderTag = mcstrSignature And udtFileH.Version <= App.Revision Then
            Seek #intInputFile, udtFileH.HeaderSize + 1
            intOutputFile = FreeFile
            Open strOutTmpFile For Binary As intOutputFile
                lngOriginalFileLen = udtFileH.FileLength
                lngFileLength = lngFileLength - udtFileH.HeaderSize
                lngInBufLen = &HA000&
                lngOutBufLen = lngInBufLen
                If lngInBufLen > lngFileLength Then lngInBufLen = lngFileLength
                ReDim abytInBuf(lngInBufLen - 1)
                ReDim abytOutBuf(lngOutBufLen - 1)
                Get intInputFile, , abytInBuf
                Do While lngBytesWritten < lngOriginalFileLen
                    lngFlags = lngFlags \ 2
                    If (lngFlags And &H100) = 0 Then
                        lngFlags = &HFF00& Or abytInBuf(lngInPos)
                        lngBytesRead = lngBytesRead + 1
                        lngInPos = lngInPos + 1
                        If lngInPos >= lngInBufLen Then
                            If lngFileLength > lngBytesRead Then
                                If lngInBufLen > lngFileLength - lngBytesRead Then
                                    lngInBufLen = lngFileLength - lngBytesRead
                                    ReDim abytInBuf(lngInBufLen - 1)
                                End If
                                Get intInputFile, , abytInBuf
                                lngInPos = 0
                            End If
                        End If
                    End If
                    If (lngFlags And 1) Then
                        abytWindow(intWindowPosition) = abytInBuf(lngInPos)
                        abytOutBuf(lngOutPos) = abytInBuf(lngInPos)
                        lngBytesRead = lngBytesRead + 1
                        lngInPos = lngInPos + 1
                        lngBytesWritten = lngBytesWritten + 1
                        lngOutPos = lngOutPos + 1
                        intWindowPosition = (intWindowPosition + 1) And &HFFF
                        If lngInPos >= lngInBufLen Then
                            If lngFileLength > lngBytesRead Then
                                If lngInBufLen > lngFileLength - lngBytesRead Then
                                    lngInBufLen = lngFileLength - lngBytesRead
                                    ReDim abytInBuf(lngInBufLen - 1)
                                End If
                                Get intInputFile, , abytInBuf
                                lngInPos = 0
                            End If
                        End If
                        If lngOutPos >= lngOutBufLen Then
                            Put intOutputFile, , abytOutBuf
                            lngOutPos = 0
                            RaiseEvent FileProgress(lngBytesWritten / lngOriginalFileLen)
                            DoEvents
                            If m_bEnableProcss = False Then intErrNo = 254:  GoTo PROC_ERR
                        End If
                    Else
                        bytHiByte = abytInBuf(lngInPos)
                        lngBytesRead = lngBytesRead + 1
                        lngInPos = lngInPos + 1
                        If lngInPos >= lngInBufLen Then
                            If lngFileLength > lngBytesRead Then
                                If lngInBufLen > lngFileLength - lngBytesRead Then
                                    lngInBufLen = lngFileLength - lngBytesRead
                                    ReDim abytInBuf(lngInBufLen - 1)
                                End If
                                Get intInputFile, , abytInBuf
                                lngInPos = 0
                            End If
                        End If
                        bytLoByte = abytInBuf(lngInPos)
                        intBufferLocation = ((bytLoByte And &HF0) * 16 + bytHiByte) And &HFFF
                        intLength = (bytLoByte And &HF) + mcintMinMatchLen
                        lngBytesRead = lngBytesRead + 1
                        lngInPos = lngInPos + 1
                        If lngInPos >= lngInBufLen Then
                            If lngFileLength > lngBytesRead Then
                                If lngInBufLen > lngFileLength - lngBytesRead Then
                                    lngInBufLen = lngFileLength - lngBytesRead
                                    ReDim abytInBuf(lngInBufLen - 1)
                                End If
                                Get intInputFile, , abytInBuf
                                lngInPos = 0
                            End If
                        End If
                        For intTemp = 0 To intLength - 1
                            abytOutBuf(lngOutPos) = abytWindow((intBufferLocation + intTemp) And &HFFF)
                            lngBytesWritten = lngBytesWritten + 1
                            abytWindow(intWindowPosition) = abytOutBuf(lngOutPos)
                            intWindowPosition = (intWindowPosition + 1) And &HFFF
                            lngOutPos = lngOutPos + 1
                            If lngOutPos >= lngOutBufLen Then
                                Put intOutputFile, , abytOutBuf
                                lngOutPos = 0
                                RaiseEvent FileProgress(lngBytesWritten / lngOriginalFileLen)
                                DoEvents
                                If m_bEnableProcss = False Then intErrNo = 254:  GoTo PROC_ERR
                           End If
                        Next
                    End If
                Loop
                If lngOutPos > 0 Then
                    ReDim Preserve abytOutBuf(lngOutPos - 1)
                    Put intOutputFile, , abytOutBuf
                End If
            Close intOutputFile
        Else
            intErrNo = 5
            GoTo PROC_ERR
        End If
    Close intInputFile
    If Len(Dir(m_strOutputFileName)) > 0 Then Kill m_strOutputFileName
    Name strOutTmpFile As m_strOutputFileName
    RaiseEvent FileProgress(1)
    Exit Sub
PROC_ERR:
    Close intOutputFile
    Close intInputFile
    If Len(Dir(strOutTmpFile)) > 0 And Len(strOutTmpFile) > 0 Then Kill strOutTmpFile
    If intErrNo = 0 Then intErrNo = 255
    RaiseEvent ProcssError(LastError(intErrNo))
End Sub