An optimized compression algorithm (below)

Class compression and decompression algorithm

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) LNGCURWRITEN = .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 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 i f 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 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 INTNEXT <> McINTnull Ten 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 SubPROC_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 SubPrivate 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 = lngInBufLen Then If lngFileLength > LNGBYTESREAD THEN IF LNGINBUFLEN> LNGFILENGTH - 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 = lngOutBufLen Then Put intOutputFile,, abytOutBuf lngOutPos =