| 订阅 | 在线投稿
分享
 
 
 

一个优化后的压缩算法(下)

来源:互联网  宽屏版  评论
2006-01-09 20:55:01

'类中压缩与解压算法

Private Sub Compress()

Dim lngTemp As Long, intCount As Integer

Dim intBufferLocation As Integer

Dim intMaxLen As Integer

Dim intNext As Integer

Dim intPrev As Integer

Dim intMatchPos As Integer

Dim intMatchLen As Integer

Dim intInputFile As Integer

Dim intOutputFile As Integer

Dim aintWindowNext(mcintWindowSize + 1 + mcintWindowSize) As Integer

Dim aintWindowPrev(mcintWindowSize + 1) As Integer

Dim intByteCodeWritten As Long

Dim intBitCount As Integer

Dim abytWindow(mcintWindowSize + mcintMaxMatchLen) As Byte

Dim udtFileH As FileHeader

Dim strOutTmpFile As String

Dim lngBytesRead As Long

Dim lngFileLength As Long

Dim lngCurWritten As Long

Dim lngInBufLen As Long, abytInputBuffer() As Byte, abytOutputBuffer() As Byte

Dim lngOutBufLen As Long, lngInPos As Long, lngOutPos As Long

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 = 1: 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

If FileLen(m_strInputFileName) < 100 Then intErrNo = 2: GoTo PROC_ERR

intInputFile = FreeFile

Open m_strInputFileName For Binary Access Read As intInputFile

Get intInputFile, , udtFileH

Seek #intInputFile, 1

If udtFileH.HeaderTag = mcstrSignature Then intErrNo = 3: GoTo PROC_ERR

intOutputFile = FreeFile

Open strOutTmpFile For Binary As intOutputFile

For intCount = 0 To mcintWindowSize

aintWindowPrev(intCount) = mcintNull

abytWindow(intCount) = &H20

Next

CopyMemory aintWindowNext(0), aintWindowPrev(0), (mcintWindowSize + 1) * 2

CopyMemory aintWindowNext(mcintWindowSize + 1), aintWindowPrev(0), mcintWindowSize * 2

CopyMemory abytWindow(mcintWindowSize + 1), abytWindow(0), mcintMaxMatchLen - 1

intByteCodeWritten = 1

lngFileLength = LOF(intInputFile)

lngInBufLen = &HA000&

lngOutBufLen = &HA000&

If lngInBufLen > lngFileLength Then lngInBufLen = lngFileLength

ReDim abytInputBuffer(lngInBufLen - 1)

ReDim abytOutputBuffer(lngOutBufLen + 17)

With udtFileH

.HeaderSize = Len(udtFileH)

lngCurWritten = .HeaderSize + 1

.HeaderTag = mcstrSignature

.FileLength = lngFileLength

.Version = App.Revision

.Flag = 0

End With

intMaxLen = mcintMaxMatchLen

lngBytesRead = mcintMaxMatchLen

lngInPos = mcintMaxMatchLen

intBitCount = 1

Put intOutputFile, , udtFileH

Get intInputFile, , abytInputBuffer

CopyMemory abytWindow(0), abytInputBuffer(0), mcintMaxMatchLen

CopyMemory abytWindow(mcintWindowSize), abytInputBuffer(0), mcintMaxMatchLen

Do While intMaxLen

intMatchPos = 0

intMatchLen = 0

intPrev = aintWindowNext(((&H100& * abytWindow(intBufferLocation + 1) + abytWindow(intBufferLocation)) And &HFFF) + mcintWindowSize + 1)

intCount = 0

Do Until intCount > mintCompressLevel Or intPrev = mcintNull

intNext = 0

Do While (abytWindow(intPrev + intNext) = abytWindow(intBufferLocation + intNext)) And intNext < mcintMaxMatchLen

intNext = intNext + 1

Loop

If intNext > intMatchLen Then

intMatchLen = intNext

intMatchPos = intPrev

If intNext = mcintMaxMatchLen Then

aintWindowNext(aintWindowPrev(intPrev)) = aintWindowNext(intPrev)

aintWindowPrev(aintWindowNext(intPrev)) = aintWindowPrev(intPrev)

aintWindowNext(intPrev) = mcintNull

aintWindowPrev(intPrev) = mcintNull

Exit Do

End If

End If

intPrev = aintWindowNext(intPrev)

intCount = intCount + 1

Loop

If intBitCount And &H100 Then

lngOutPos = intByteCodeWritten

If intByteCodeWritten > lngOutBufLen Then

Put intOutputFile, lngCurWritten, abytOutputBuffer

DoEvents

If m_bEnableProcss = False Then intErrNo = 254: GoTo PROC_ERR

lngCurWritten = lngCurWritten + intByteCodeWritten

lngOutPos = 0

End If

intByteCodeWritten = lngOutPos + 1

intBitCount = 1

abytOutputBuffer(lngOutPos) = 0

End If

If intMatchLen < mcintMinMatchLen Then

intMatchLen = 1

abytOutputBuffer(intByteCodeWritten) = abytWindow(intBufferLocation)

abytOutputBuffer(lngOutPos) = abytOutputBuffer(lngOutPos) Or intBitCount

End If

If intMatchLen > 1 Then

If intMatchLen > intMaxLen Then intMatchLen = intMaxLen

abytOutputBuffer(intByteCodeWritten) = intMatchPos And &HFF

intByteCodeWritten = intByteCodeWritten + 1

abytOutputBuffer(intByteCodeWritten) = (((intMatchPos \ 16) And &HF0) Or intMatchLen - mcintMinMatchLen) And &HFF

End If

intByteCodeWritten = intByteCodeWritten + 1

intBitCount = intBitCount * 2

Do While intMatchLen

intPrev = intBufferLocation + mcintMaxMatchLen

intNext = intPrev And &HFFF

If aintWindowPrev(intNext) <> mcintNull Then

aintWindowNext(aintWindowPrev(intNext)) = aintWindowNext(intNext)

aintWindowPrev(aintWindowNext(intNext)) = aintWindowPrev(intNext)

aintWindowNext(intNext) = mcintNull

aintWindowPrev(intNext) = mcintNull

End If

If lngInPos < lngInBufLen Then

abytWindow(intNext) = abytInputBuffer(lngInPos)

If intPrev >= mcintWindowSize Then abytWindow(intPrev) = abytInputBuffer(lngInPos)

lngBytesRead = lngBytesRead + 1

lngInPos = lngInPos + 1

If lngInPos >= lngInBufLen Then

If lngFileLength > lngBytesRead Then

If lngInBufLen > lngFileLength - lngBytesRead Then

lngInBufLen = lngFileLength - lngBytesRead

ReDim abytInputBuffer(lngInBufLen - 1)

End If

Get intInputFile, , abytInputBuffer

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 intNext <> 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

ReDim Preserve abytOutputBuffer(intByteCodeWritten - 1)

Put intOutputFile, lngCurWritten, abytOutputBuffer

End If

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 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 = &H20000

lngOutBufLen = &H20000

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

DoEvents

If m_bEnableProcss = False Then intErrNo = 254: GoTo PROC_ERR

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

DoEvents

If m_bEnableProcss = False Then intErrNo = 254: GoTo PROC_ERR

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

DoEvents

If m_bEnableProcss = False Then intErrNo = 254: GoTo PROC_ERR

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

DoEvents

If m_bEnableProcss = False Then intErrNo = 254: GoTo PROC_ERR

lngInPos = 0

End If

End If

intTemp = intBufferLocation + intLength

Do While intBufferLocation < intTemp

abytOutBuf(lngOutPos) = abytWindow((intBufferLocation) And &HFFF)

abytWindow(intWindowPosition) = abytOutBuf(lngOutPos)

intBufferLocation = intBufferLocation + 1

lngBytesWritten = lngBytesWritten + 1

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

Loop

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

 
'类中压缩与解压算法 Private Sub Compress() Dim lngTemp As Long, intCount As Integer Dim intBufferLocation As Integer Dim intMaxLen As Integer Dim intNext As Integer Dim intPrev As Integer Dim intMatchPos As Integer Dim intMatchLen As Integer Dim intInputFile As Integer Dim intOutputFile As Integer Dim aintWindowNext(mcintWindowSize + 1 + mcintWindowSize) As Integer Dim aintWindowPrev(mcintWindowSize + 1) As Integer Dim intByteCodeWritten As Long Dim intBitCount As Integer Dim abytWindow(mcintWindowSize + mcintMaxMatchLen) As Byte Dim udtFileH As FileHeader Dim strOutTmpFile As String Dim lngBytesRead As Long Dim lngFileLength As Long Dim lngCurWritten As Long Dim lngInBufLen As Long, abytInputBuffer() As Byte, abytOutputBuffer() As Byte Dim lngOutBufLen As Long, lngInPos As Long, lngOutPos As Long 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 = 1: 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 If FileLen(m_strInputFileName) < 100 Then intErrNo = 2: GoTo PROC_ERR intInputFile = FreeFile Open m_strInputFileName For Binary Access Read As intInputFile Get intInputFile, , udtFileH Seek #intInputFile, 1 If udtFileH.HeaderTag = mcstrSignature Then intErrNo = 3: GoTo PROC_ERR intOutputFile = FreeFile Open strOutTmpFile For Binary As intOutputFile For intCount = 0 To mcintWindowSize aintWindowPrev(intCount) = mcintNull abytWindow(intCount) = &H20 Next CopyMemory aintWindowNext(0), aintWindowPrev(0), (mcintWindowSize + 1) * 2 CopyMemory aintWindowNext(mcintWindowSize + 1), aintWindowPrev(0), mcintWindowSize * 2 CopyMemory abytWindow(mcintWindowSize + 1), abytWindow(0), mcintMaxMatchLen - 1 intByteCodeWritten = 1 lngFileLength = LOF(intInputFile) lngInBufLen = &HA000& lngOutBufLen = &HA000& If lngInBufLen > lngFileLength Then lngInBufLen = lngFileLength ReDim abytInputBuffer(lngInBufLen - 1) ReDim abytOutputBuffer(lngOutBufLen + 17) With udtFileH .HeaderSize = Len(udtFileH) lngCurWritten = .HeaderSize + 1 .HeaderTag = mcstrSignature .FileLength = lngFileLength .Version = App.Revision .Flag = 0 End With intMaxLen = mcintMaxMatchLen lngBytesRead = mcintMaxMatchLen lngInPos = mcintMaxMatchLen intBitCount = 1 Put intOutputFile, , udtFileH Get intInputFile, , abytInputBuffer CopyMemory abytWindow(0), abytInputBuffer(0), mcintMaxMatchLen CopyMemory abytWindow(mcintWindowSize), abytInputBuffer(0), mcintMaxMatchLen Do While intMaxLen intMatchPos = 0 intMatchLen = 0 intPrev = aintWindowNext(((&H100& * abytWindow(intBufferLocation + 1) + abytWindow(intBufferLocation)) And &HFFF) + mcintWindowSize + 1) intCount = 0 Do Until intCount > mintCompressLevel Or intPrev = mcintNull intNext = 0 Do While (abytWindow(intPrev + intNext) = abytWindow(intBufferLocation + intNext)) And intNext < mcintMaxMatchLen intNext = intNext + 1 Loop If intNext > intMatchLen Then intMatchLen = intNext intMatchPos = intPrev If intNext = mcintMaxMatchLen Then aintWindowNext(aintWindowPrev(intPrev)) = aintWindowNext(intPrev) aintWindowPrev(aintWindowNext(intPrev)) = aintWindowPrev(intPrev) aintWindowNext(intPrev) = mcintNull aintWindowPrev(intPrev) = mcintNull Exit Do End If End If intPrev = aintWindowNext(intPrev) intCount = intCount + 1 Loop If intBitCount And &H100 Then lngOutPos = intByteCodeWritten If intByteCodeWritten > lngOutBufLen Then Put intOutputFile, lngCurWritten, abytOutputBuffer DoEvents If m_bEnableProcss = False Then intErrNo = 254: GoTo PROC_ERR lngCurWritten = lngCurWritten + intByteCodeWritten lngOutPos = 0 End If intByteCodeWritten = lngOutPos + 1 intBitCount = 1 abytOutputBuffer(lngOutPos) = 0 End If If intMatchLen < mcintMinMatchLen Then intMatchLen = 1 abytOutputBuffer(intByteCodeWritten) = abytWindow(intBufferLocation) abytOutputBuffer(lngOutPos) = abytOutputBuffer(lngOutPos) Or intBitCount End If If intMatchLen > 1 Then If intMatchLen > intMaxLen Then intMatchLen = intMaxLen abytOutputBuffer(intByteCodeWritten) = intMatchPos And &HFF intByteCodeWritten = intByteCodeWritten + 1 abytOutputBuffer(intByteCodeWritten) = (((intMatchPos \ 16) And &HF0) Or intMatchLen - mcintMinMatchLen) And &HFF End If intByteCodeWritten = intByteCodeWritten + 1 intBitCount = intBitCount * 2 Do While intMatchLen intPrev = intBufferLocation + mcintMaxMatchLen intNext = intPrev And &HFFF If aintWindowPrev(intNext) <> mcintNull Then aintWindowNext(aintWindowPrev(intNext)) = aintWindowNext(intNext) aintWindowPrev(aintWindowNext(intNext)) = aintWindowPrev(intNext) aintWindowNext(intNext) = mcintNull aintWindowPrev(intNext) = mcintNull End If If lngInPos < lngInBufLen Then abytWindow(intNext) = abytInputBuffer(lngInPos) If intPrev >= mcintWindowSize Then abytWindow(intPrev) = abytInputBuffer(lngInPos) lngBytesRead = lngBytesRead + 1 lngInPos = lngInPos + 1 If lngInPos >= lngInBufLen Then If lngFileLength > lngBytesRead Then If lngInBufLen > lngFileLength - lngBytesRead Then lngInBufLen = lngFileLength - lngBytesRead ReDim abytInputBuffer(lngInBufLen - 1) End If Get intInputFile, , abytInputBuffer 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 intNext <> 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 ReDim Preserve abytOutputBuffer(intByteCodeWritten - 1) Put intOutputFile, lngCurWritten, abytOutputBuffer End If 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 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 = &H20000 lngOutBufLen = &H20000 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 DoEvents If m_bEnableProcss = False Then intErrNo = 254: GoTo PROC_ERR 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 DoEvents If m_bEnableProcss = False Then intErrNo = 254: GoTo PROC_ERR 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 DoEvents If m_bEnableProcss = False Then intErrNo = 254: GoTo PROC_ERR 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 DoEvents If m_bEnableProcss = False Then intErrNo = 254: GoTo PROC_ERR lngInPos = 0 End If End If intTemp = intBufferLocation + intLength Do While intBufferLocation < intTemp abytOutBuf(lngOutPos) = abytWindow((intBufferLocation) And &HFFF) abytWindow(intWindowPosition) = abytOutBuf(lngOutPos) intBufferLocation = intBufferLocation + 1 lngBytesWritten = lngBytesWritten + 1 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 Loop 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
󰈣󰈤
 
 
 
>>返回首页<<
 
 热帖排行
 
 
 
静静地坐在废墟上,四周的荒凉一望无际,忽然觉得,凄凉也很美
©2005- 王朝网络 版权所有