?? comp_combiner.bas
字號:
ContCount = ContCount * 256 + ByteArray(3)
InData = Int(ContCount / 8) + InCont
If ContCount / 8 <> Int(ContCount / 8) Then
InData = InData + 1
End If
ContBitCount = 0
OutPos = 0
Do While ContHad < ContCount
GoSub Check_ContBitCount
If (ContData And 2 ^ ContBitCount) > 0 Then
'read compression size
CombSize = 0
For X = 0 To 1
CombSize = CombSize * 2
GoSub Check_ContBitCount
If (ContData And 2 ^ ContBitCount) > 0 Then CombSize = CombSize + 1
Next
'read compressed byte en decompress it
bitcount = 8
NewByte = 0
CombSize = CombVal(CombSize)
For X = 1 To 24 / CombSize
For Y = 1 To CombSize
bitcount = bitcount - 1
NewByte = NewByte * 2
If (ByteArray(InData) And 2 ^ bitcount) > 0 Then NewByte = NewByte + 1
If bitcount = 0 Then
bitcount = 8
InData = InData + 1
End If
Next
GoSub OutPutNewByte
NewByte = 0
Next
Else
NewByte = ByteArray(InData)
InData = InData + 1
GoSub OutPutNewByte
End If
Loop
OutPos = OutPos - 1
ReDim ByteArray(OutPos)
For X = 0 To OutPos
ByteArray(X) = OutStream(X)
Next
Exit Sub
Check_ContBitCount:
ContBitCount = ContBitCount - 1
ContHad = ContHad + 1
If ContBitCount = -1 Then
ContData = ByteArray(InCont)
InCont = InCont + 1
ContBitCount = 7
End If
Return
OutPutNewByte:
If OutPos > UBound(OutStream) Then
ReDim Preserve OutStream(OutPos + 100)
End If
OutStream(OutPos) = NewByte
OutPos = OutPos + 1
Return
End Sub
Public Sub Compress_CombinerVariable(ByteArray() As Byte)
Dim ContStream() As Byte
Dim OutStream() As Byte
Dim ContByte As Byte
Dim ContPos As Long
Dim ContCount As Long
Dim ContBitCount As Integer
Dim OutPos As Long
Dim InpPos As Long
Dim FileLength As Long
Dim Byte1 As Byte
Dim Byte2 As Byte
Dim NewByte As Byte
Dim NewLen As Long
Dim NumBytes As Integer
Dim X As Long
Dim Y As Integer
Dim Z As Integer
Dim Combine As Boolean
Dim BetterComb As Boolean
Dim CombSize As Integer
Dim CombVal As Integer
Dim CombBits(15) As Integer
Dim CombBytes(15) As Integer
Dim bitcount As Integer
FileLength = UBound(ByteArray)
ReDim ContStream((FileLength / 8) + 1)
ReDim OutStream(FileLength)
CombBits(0) = 3: CombBytes(0) = 16
CombBits(1) = 2: CombBytes(1) = 12
CombBits(2) = 1: CombBytes(2) = 8
CombBits(3) = 4: CombBytes(3) = 14
CombBits(4) = 2: CombBytes(4) = 8
CombBits(5) = 4: CombBytes(5) = 12
CombBits(6) = 3: CombBytes(6) = 8
CombBits(7) = 4: CombBytes(7) = 10
CombBits(8) = 4: CombBytes(8) = 8
CombBits(9) = 2: CombBytes(9) = 4
CombBits(10) = 4: CombBytes(10) = 6
CombBits(11) = 6: CombBytes(11) = 12
CombBits(12) = 4: CombBytes(12) = 4
CombBits(13) = 6: CombBytes(13) = 8
CombBits(14) = 4: CombBytes(14) = 2
CombBits(15) = 6: CombBytes(15) = 4
InpPos = 0
OutPos = 0
ContPos = 0
ContByte = 0
ContBitCount = 0
ContCount = 0
bitcount = 0
Do While InpPos <= FileLength
NumBytes = 1
'check for an option
For X = 0 To 15
Combine = False
If InpPos + CombBytes(X) <= FileLength Then
Combine = True
CombSize = CombBits(X)
For Y = 0 To CombBytes(X) - 1
If ByteArray(InpPos + Y) >= 2 ^ CombSize Then
Combine = False
Exit For
End If
Next
End If
If Combine = True Then
CombVal = X
Exit For
End If
Next
If Combine = True Then
'check if there is maybe a better option
For X = 1 To CombBytes(CombVal) - 1
For Y = 0 To CombVal - 1
BetterComb = False
If InpPos + X + CombBytes(Y) - 1 <= FileLength Then
BetterComb = True
For Z = 0 To CombBytes(Y) - 1
If ByteArray(InpPos + X + Z) >= (2 ^ CombBits(Y)) Then
BetterComb = False
Exit For
End If
Next
End If
If BetterComb = True Then
If (CombBytes(Y) * (8 - CombBits(Y)) - X - (CombBytes(CombVal) - CombBytes(Y))) > (CombBytes(CombVal) * (8 - CombBits(CombVal))) Then
NumBytes = X + 1
Combine = False
Exit For
End If
End If
Next
If Combine = False Then
Exit For
End If
Next
End If
For Z = 1 To NumBytes
If Combine = False Then
ContByte = ContByte * 2
ContBitCount = ContBitCount + 1
ContCount = ContCount + 1
GoSub Store_ContByte
OutStream(OutPos) = ByteArray(InpPos)
OutPos = OutPos + 1
InpPos = InpPos + 1
Else
'opslaan controle byte
ContByte = ContByte * 2 + 1
ContBitCount = ContBitCount + 1
ContCount = ContCount + 1
GoSub Store_ContByte
For X = 3 To 0 Step -1
ContByte = ContByte * 2
If (CombVal And 2 ^ X) > 0 Then ContByte = ContByte + 1
ContBitCount = ContBitCount + 1
ContCount = ContCount + 1
GoSub Store_ContByte
Next
'opslaan databytes
NewByte = 0
bitcount = 0
For X = 1 To CombBytes(CombVal)
For Y = CombSize - 1 To 0 Step -1
NewByte = NewByte * 2
bitcount = bitcount + 1
If (ByteArray(InpPos) And 2 ^ Y) > 0 Then NewByte = NewByte + 1
If bitcount = 8 Then
OutStream(OutPos) = NewByte
OutPos = OutPos + 1
bitcount = 0
NewByte = 0
End If
Next
InpPos = InpPos + 1
Next
End If
Next
Loop
If ContBitCount > 0 Then
Do While ContBitCount < 8
ContByte = ContByte * 2
ContBitCount = ContBitCount + 1
Loop
If ContPos > UBound(ContStream) Then ReDim Preserve ContStream(ContPos + 1)
ContStream(ContPos) = ContByte
ContPos = ContPos + 1
End If
ContPos = ContPos - 1
OutPos = OutPos - 1
If UBound(ByteArray) < 3 Then
ReDim Preserve ByteArray(3)
End If
ByteArray(0) = Int(ContCount / &H1000000) And &HFF
ByteArray(1) = Int(ContCount / &H10000) And &HFF
ByteArray(2) = Int(ContCount / &H100) And &HFF
ByteArray(3) = ContCount And &HFF
InpPos = 4
For X = 0 To ContPos
If InpPos > UBound(ByteArray) Then
ReDim Preserve ByteArray(InpPos + 100)
End If
ByteArray(InpPos) = ContStream(X)
InpPos = InpPos + 1
Next
For X = 0 To OutPos
If InpPos > UBound(ByteArray) Then
ReDim Preserve ByteArray(InpPos + 100)
End If
ByteArray(InpPos) = OutStream(X)
InpPos = InpPos + 1
Next
ReDim Preserve ByteArray(InpPos - 1)
Exit Sub
Store_ContByte:
If ContBitCount = 8 Then
If ContPos > UBound(ContStream) Then ReDim Preserve ContStream(ContPos + 100)
ContStream(ContPos) = ContByte
ContByte = 0
ContPos = ContPos + 1
ContBitCount = 0
End If
Return
End Sub
Public Sub DeCompress_CombinerVariable(ByteArray() As Byte)
Dim OutStream() As Byte
Dim InCont As Long
Dim InData As Long
Dim ContData As Integer
Dim ContCount As Long
Dim ContBitCount As Long
Dim ContHad As Long
Dim FileLength As Long
Dim NewByte As Byte
Dim OutPos As Long
Dim X As Long
Dim Y As Integer
Dim CombVal As Integer
Dim CombSize As Integer
Dim bitcount As Integer
Dim CombBits(15) As Integer
Dim CombBytes(15) As Integer
CombBits(0) = 3: CombBytes(0) = 16
CombBits(1) = 2: CombBytes(1) = 12
CombBits(2) = 1: CombBytes(2) = 8
CombBits(3) = 4: CombBytes(3) = 14
CombBits(4) = 2: CombBytes(4) = 8
CombBits(5) = 4: CombBytes(5) = 12
CombBits(6) = 3: CombBytes(6) = 8
CombBits(7) = 4: CombBytes(7) = 10
CombBits(8) = 4: CombBytes(8) = 8
CombBits(9) = 2: CombBytes(9) = 4
CombBits(10) = 4: CombBytes(10) = 6
CombBits(11) = 6: CombBytes(11) = 12
CombBits(12) = 4: CombBytes(12) = 4
CombBits(13) = 6: CombBytes(13) = 8
CombBits(14) = 4: CombBytes(14) = 2
CombBits(15) = 6: CombBytes(15) = 4
FileLength = UBound(ByteArray)
ReDim OutStream(FileLength)
ContHad = 0
InCont = 4
ContCount = ByteArray(0)
ContCount = ContCount * 256 + ByteArray(1)
ContCount = ContCount * 256 + ByteArray(2)
ContCount = ContCount * 256 + ByteArray(3)
InData = Int(ContCount / 8) + InCont
If ContCount / 8 <> Int(ContCount / 8) Then
InData = InData + 1
End If
ContBitCount = 0
OutPos = 0
Do While ContHad < ContCount
GoSub Check_ContBitCount
If (ContData And 2 ^ ContBitCount) > 0 Then
'read compression size
CombVal = 0
For X = 0 To 3
CombVal = CombVal * 2
GoSub Check_ContBitCount
If (ContData And 2 ^ ContBitCount) > 0 Then CombVal = CombVal + 1
Next
'read compressed byte en decompress it
bitcount = 8
NewByte = 0
CombSize = CombBytes(CombVal)
For X = 1 To CombSize
For Y = 1 To CombBits(CombVal)
bitcount = bitcount - 1
NewByte = NewByte * 2
If (ByteArray(InData) And 2 ^ bitcount) > 0 Then NewByte = NewByte + 1
If bitcount = 0 Then
bitcount = 8
InData = InData + 1
End If
Next
GoSub OutPutNewByte
NewByte = 0
Next
Else
NewByte = ByteArray(InData)
InData = InData + 1
GoSub OutPutNewByte
End If
Loop
OutPos = OutPos - 1
ReDim ByteArray(OutPos)
For X = 0 To OutPos
ByteArray(X) = OutStream(X)
Next
Exit Sub
Check_ContBitCount:
ContBitCount = ContBitCount - 1
ContHad = ContHad + 1
If ContBitCount = -1 Then
ContData = ByteArray(InCont)
InCont = InCont + 1
ContBitCount = 7
End If
Return
OutPutNewByte:
If OutPos > UBound(OutStream) Then
ReDim Preserve OutStream(OutPos + 100)
End If
OutStream(OutPos) = NewByte
OutPos = OutPos + 1
Return
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -