VB编程实现lzw压缩算法.docVIP

做出差不多这样的控件就好了 解压可以不要 下面是lzw无损压缩算法的源代码 vb的 希望帮改改 弄个控件 急用 谢谢了 Attribute VB_Name = Comp_LZW_Predefined Option Compare Database Option Explicit This is a 2 run method Private MaxChars As Long Private TempStream() As Byte Private OutStream() As Byte Private OutPos As Long Private OutByteBuf As Integer Private OutBitCount As Integer Private ReadBitPos As Integer Private Dict() As String the dictionaries Private DictPos As Integer the position to store the next characters Private SearchPos() As Long Private SpeedSearch() As Long Private ActDict As Integer actual dictionary Private maxCharLenght As Byte Maximum stringlength in de dictionary Private maxDictDeep As Long maximum stored words per dictionary Private TotBitDeep As Integer total bitlength per character Private MaxBitDeep As Integer Private minBitDeep As Integer Private StartDict As Long startposition of de dictionary Private NewBitLengt As Long Private EscapeCode As Long Private WaitForLessBits As Long The next varariable is used to detect the kind of asciis used 0 = all ascii 1 = 2 ascii determen the range that is used =127 following codes are used 127 following codes are not used Private DictCode As Integer Private DictChars(127) As Byte Public Sub Compress_LZWPre(FileArray() As Byte) Dim ByteValue As Byte Dim TempByte As Long Dim ExtraBits As Integer Dim DictStr As String Dim NewStr As String Dim CompPos As Long Dim DictVal As Long Dim DictPosit As Long Dim DictPositOld As Long Dim FilePos As Long Dim FileLenght As Long Dim BitLengthCount As Integer Dim Temp As Long Dim MostUsed1 As Integer Dim MostUsed2 As Integer Dim MostCount1 As Long Dim MostCount2 As Long Dim MinCount As Long Dim CharCount(255) As Long Dim X As Long Dim DictNu As Integer Dim CheckRange As Boolean Dim MaxDictPagesInBites As Long MaxDictPagesInBites = CLng(1024) * DictionarySize - 1 DictNu = 0 Dic