К сожалению он не работает так как нужно, вернее не работает вовсе. Пожалуйста помогите разобратсья/найти ошибки.
- Код: Выделить всё
Option Explicit
Private code1 As Long
Private code2 As Long
Private code3 As Long
Private code4 As Long
Private packedOffset As Byte
Private packedBytes() As Byte
Private unpackedBytes() As Byte
Private unpackedChunk() As Byte
Public Sub MppcUnpacker()
code3 = 0
code4 = 0
ReDim packedBytes(0)
ReDim unpackedBytes(0)
End Sub
Public Function Unpack(packedByte() As Byte) As Byte()
Dim outB As Byte
Dim size As Long
packedBytes = packedByte
'unpackedChunk = new List<byte>();
If (UBound(unpackedBytes)) >= (10240 - 1) Then
ReDim Preserve unpackedBytes(2048)
Do
If code3 = 0 Then
If HasBits(4) Then
If GetPackedBits(1) = 0 Then
' 0-xxxxxxx
code1 = 1
code3 = 1
Else
If GetPackedBits(1) = 0 Then
' 10-xxxxxxx
code1 = 2
code3 = 1
Else
If GetPackedBits(1) = 0 Then
' 110-xxxxxxxxxxxxx-*
code1 = 3
code3 = 1
Else
If GetPackedBits(1) = 0 Then
' 1110-xxxxxxxx-*
code1 = 4
code3 = 1
Else
' 1111-xxxxxx-*
code1 = 5
code3 = 1
End If
End If
End If
End If
Else
Exit Do
End If
ElseIf code3 = 1 Then
If code1 = 1 Then
If HasBits(7) Then
outB = GetPackedBits(7)
ReDim Preserve unpackedChunk(UBound(unpackedChunk) + 1)
unpackedChunk(UBound(unpackedChunk)) = outB
ReDim Preserve unpackedBytes(UBound(unpackedBytes) + 1)
unpackedBytes(UBound(unpackedBytes)) = outB
code3 = 0
Else
Exit Do
End If
ElseIf code1 = 2 Then
If HasBits(7) Then
outB = GetPackedBits(7)
outB = outB Or &H80
ReDim Preserve unpackedChunk(UBound(unpackedChunk) + 1)
unpackedChunk(UBound(unpackedChunk)) = outB
ReDim Preserve unpackedBytes(UBound(unpackedBytes) + 1)
unpackedBytes(UBound(unpackedBytes)) = outB
code3 = 0
Else
Exit Do
End If
ElseIf code1 = 3 Then
If HasBits(13) Then
code4 = CInt(Fix(GetPackedBits(13))) + &H140
code3 = 2
Else
Exit Do
End If
ElseIf code1 = 4 Then
If HasBits(8) Then
code4 = CInt(Fix(GetPackedBits(8))) + &H40
code3 = 2
Else
Exit Do
End If
ElseIf code1 = 5 Then
If HasBits(6) Then
code4 = CInt(Fix(GetPackedBits(6)))
code3 = 2
Else
Exit Do
End If
End If
ElseIf code3 = 2 Then
If code4 = 0 Then
' Guess !!!
If packedOffset <> 0 Then
packedOffset = 0
' packedBytes.RemoveAt (0)
End If
code3 = 0
'Continue Do
End If
code2 = 0
code3 = 3
ElseIf code3 = 3 Then
If HasBits(1) Then
If GetPackedBits(1) = 0 Then
code3 = 4
Else
code2 = code2 + 1
End If
Else
Exit Do
End If
ElseIf code3 = 4 Then
Dim copySize As Long
If code2 = 0 Then
copySize = 3
Else
size = code2 + 1
If HasBits(size) Then
copySize = CInt(Fix(GetPackedBits(size))) + (shl(1, size))
Else
Exit Do
End If
End If
Copy code4, copySize, unpackedChunk
code3 = 0
End If
Loop
Unpack = unpackedChunk
End If
End Function
Private Sub Copy(shift As Long, size As Long, ByRef unpackedChunkData() As Byte)
Dim i As Long, a As Long, pIndex As Long, b As Byte
For i = 0 To (size - 1)
pIndex = UBound(unpackedBytes) - shift
If pIndex < 0 Then
Exit Sub
End If
b = unpackedBytes(pIndex)
ReDim Preserve unpackedBytes(UBound(unpackedBytes) + 1)
unpackedBytes(UBound(unpackedBytes)) = b
ReDim Preserve unpackedChunkData(UBound(unpackedChunkData) + 1)
unpackedChunkData(UBound(unpackedChunkData)) = b
Next
End Sub
Public Function GetPackedBits(bitCount As Long) As Long
Dim alBitCount As Long, AlByteCount As Long, freeBytes As Long
Dim v As Long
Dim s As Byte
Dim i As Long
If bitCount > 16 Then
GetPackedBits = 0
Exit Function
End If
If Not (HasBits(bitCount)) Then
'bitCount = bitCount / 0
End If
alBitCount = bitCount + packedOffset
AlByteCount = (alBitCount + 7) / 8
i = 0
For i = 0 To AlByteCount
v = v Or shl(packedBytes(i), (24 - i * 8))
Next
v = shl(v, packedOffset)
v = shr(v, (32 - bitCount))
packedOffset = packedOffset + CByte(bitCount)
freeBytes = packedOffset / 8
If freeBytes <> 0 Then
ReDim Preserve packedBytes(freeBytes)
End If
packedOffset = packedOffset Mod 8
GetPackedBits = v
End Function
Private Function HasBits(count As Long) As Boolean
HasBits = ((UBound(packedBytes) * 8 - packedOffset) >= count)
End Function
Public Function shl(ByVal Value As Long, ByVal shift As Byte) As Long
shl = Value
If shift > 0 Then
Dim i As Byte
Dim m As Long
For i = 1 To shift
m = shl And &H40000000
shl = (shl And &H3FFFFFFF) * 2
If m <> 0 Then
shl = shl Or &H80000000
End If
Next i
End If
End Function
Public Function shr(ByVal Value As Long, ByVal shift As Byte) As Long
Dim i As Byte
shr = Value
If shift > 0 Then
shr = Int(shr / (2 ^ shift))
End If
End Function
;
