Here's some VB6 code you could convert:
Option Explicit
' Huffman Compression Algorithm
' David Midkiff (md*****@hotmai l.com>
Private Const PROGRESS_CALCFR EQUENCY = 7
Private Const PROGRESS_CALCCR C = 5
Private Const PROGRESS_ENCODI NG = 88
Private Const PROGRESS_DECODI NG = 89
Private Const PROGRESS_CHECKC RC = 11
Event Progress(Procen t As Integer)
Private Type HUFFMANTREE
ParentNode As Integer
RightNode As Integer
LeftNode As Integer
Value As Integer
Weight As Long
End Type
Private Type ByteArray
Count As Byte
Data() As Byte
End Type
Private Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMem ory"
(Destination As Any, Source As Any, ByVal Length As Long)
Public Sub EncodeFile(Sour ceFile As String, DestFile As String)
Dim ByteArray() As Byte, Filenr As Integer
If (Not FileExist(Sourc eFile)) Then Err.Raise vbObjectError,
"clsHuffman.Enc odeFile()", "Source file does not exist"
Filenr = FreeFile
Open SourceFile For Binary As #Filenr
ReDim ByteArray(0 To LOF(Filenr) - 1)
Get #Filenr, , ByteArray()
Close #Filenr
Call EncodeByte(Byte Array(), UBound(ByteArra y) + 1)
If (FileExist(Dest File)) Then Kill DestFile
Open DestFile For Binary As #Filenr
Put #Filenr, , ByteArray()
Close #Filenr
End Sub
Public Sub DecodeFile(Sour ceFile As String, DestFile As String)
Dim ByteArray() As Byte, Filenr As Integer
If (Not FileExist(Sourc eFile)) Then Err.Raise vbObjectError,
"clsHuffman.Dec odeFile()", "Source file does not exist"
Filenr = FreeFile
Open SourceFile For Binary As #Filenr
ReDim ByteArray(0 To LOF(Filenr) - 1)
Get #Filenr, , ByteArray()
Close #Filenr
Call DecodeByte(Byte Array(), UBound(ByteArra y) + 1)
If (FileExist(Dest File)) Then Kill DestFile
Open DestFile For Binary As #Filenr
Put #Filenr, , ByteArray()
Close #Filenr
End Sub
Private Sub CreateTree(Node s() As HUFFMANTREE, NodesCount As Long, Char As
Long, Bytes As ByteArray)
Dim a As Integer, NodeIndex As Long
NodeIndex = 0
For a = 0 To (Bytes.Count - 1)
If (Bytes.Data(a) = 0) Then
If (Nodes(NodeInde x).LeftNode = -1) Then
Nodes(NodeIndex ).LeftNode = NodesCount
Nodes(NodesCoun t).ParentNode = NodeIndex
Nodes(NodesCoun t).LeftNode = -1
Nodes(NodesCoun t).RightNode = -1
Nodes(NodesCoun t).Value = -1
NodesCount = NodesCount + 1
End If
NodeIndex = Nodes(NodeIndex ).LeftNode
ElseIf (Bytes.Data(a) = 1) Then
If (Nodes(NodeInde x).RightNode = -1) Then
Nodes(NodeIndex ).RightNode = NodesCount
Nodes(NodesCoun t).ParentNode = NodeIndex
Nodes(NodesCoun t).LeftNode = -1
Nodes(NodesCoun t).RightNode = -1
Nodes(NodesCoun t).Value = -1
NodesCount = NodesCount + 1
End If
NodeIndex = Nodes(NodeIndex ).RightNode
Else
Stop
End If
Next
Nodes(NodeIndex ).Value = Char
End Sub
Public Sub EncodeByte(Byte Array() As Byte, ByteLen As Long)
Dim i As Long, j As Long, Char As Byte, BitPos As Byte, lNode1 As Long
Dim lNode2 As Long, lNodes As Long, lLength As Long, Count As Integer
Dim lWeight1 As Long, lWeight2 As Long, Result() As Byte, ByteValue As
Byte
Dim ResultLen As Long, Bytes As ByteArray, NodesCount As Integer,
NewProgress As Integer
Dim CurrProgress As Integer, BitValue(0 To 7) As Byte, CharCount(0 To
255) As Long
Dim Nodes(0 To 511) As HUFFMANTREE, CharValue(0 To 255) As ByteArray
If (ByteLen = 0) Then
ReDim Preserve ByteArray(0 To ByteLen + 3)
If (ByteLen > 0) Then Call CopyMem(ByteArr ay(4), ByteArray(0),
ByteLen)
ByteArray(0) = 72
ByteArray(1) = 69
ByteArray(2) = 48
ByteArray(3) = 13
Exit Sub
End If
ReDim Result(0 To 522)
Result(0) = 72
Result(1) = 69
Result(2) = 51
Result(3) = 13
ResultLen = 4
For i = 0 To (ByteLen - 1)
CharCount(ByteA rray(i)) = CharCount(ByteA rray(i)) + 1
If (i Mod 1000 = 0) Then
NewProgress = i / ByteLen * PROGRESS_CALCFR EQUENCY
If (NewProgress <> CurrProgress) Then
CurrProgress = NewProgress
RaiseEvent Progress(CurrPr ogress)
End If
End If
Next
For i = 0 To 255
If (CharCount(i) > 0) Then
With Nodes(NodesCoun t)
.Weight = CharCount(i)
.Value = i
.LeftNode = -1
.RightNode = -1
.ParentNode = -1
End With
NodesCount = NodesCount + 1
End If
Next
For lNodes = NodesCount To 2 Step -1
lNode1 = -1: lNode2 = -1
For i = 0 To (NodesCount - 1)
If (Nodes(i).Paren tNode = -1) Then
If (lNode1 = -1) Then
lWeight1 = Nodes(i).Weight
lNode1 = i
ElseIf (lNode2 = -1) Then
lWeight2 = Nodes(i).Weight
lNode2 = i
ElseIf (Nodes(i).Weigh t < lWeight1) Then
If (Nodes(i).Weigh t < lWeight2) Then
If (lWeight1 < lWeight2) Then
lWeight2 = Nodes(i).Weight
lNode2 = i
Else
lWeight1 = Nodes(i).Weight
lNode1 = i
End If
Else
lWeight1 = Nodes(i).Weight
lNode1 = i
End If
ElseIf (Nodes(i).Weigh t < lWeight2) Then
lWeight2 = Nodes(i).Weight
lNode2 = i
End If
End If
Next
With Nodes(NodesCoun t)
.Weight = lWeight1 + lWeight2
.LeftNode = lNode1
.RightNode = lNode2
.ParentNode = -1
.Value = -1
End With
Nodes(lNode1).P arentNode = NodesCount
Nodes(lNode2).P arentNode = NodesCount
NodesCount = NodesCount + 1
Next
ReDim Bytes.Data(0 To 255)
Call CreateBitSequen ces(Nodes(), NodesCount - 1, Bytes, CharValue)
For i = 0 To 255
If (CharCount(i) > 0) Then lLength = lLength + CharValue(i).Co unt *
CharCount(i)
Next
lLength = IIf(lLength Mod 8 = 0, lLength \ 8, lLength \ 8 + 1)
If ((lLength = 0) Or (lLength > ByteLen)) Then
ReDim Preserve ByteArray(0 To ByteLen + 3)
Call CopyMem(ByteArr ay(4), ByteArray(0), ByteLen)
ByteArray(0) = 72
ByteArray(1) = 69
ByteArray(2) = 48
ByteArray(3) = 13
Exit Sub
End If
Char = 0
For i = 0 To (ByteLen - 1)
Char = Char Xor ByteArray(i)
If (i Mod 10000 = 0) Then
NewProgress = i / ByteLen * PROGRESS_CALCCR C +
PROGRESS_CALCFR EQUENCY
If (NewProgress <> CurrProgress) Then
CurrProgress = NewProgress
RaiseEvent Progress(CurrPr ogress)
End If
End If
Next
Result(ResultLe n) = Char
ResultLen = ResultLen + 1
Call CopyMem(Result( ResultLen), ByteLen, 4)
ResultLen = ResultLen + 4
BitValue(0) = 2 ^ 0
BitValue(1) = 2 ^ 1
BitValue(2) = 2 ^ 2
BitValue(3) = 2 ^ 3
BitValue(4) = 2 ^ 4
BitValue(5) = 2 ^ 5
BitValue(6) = 2 ^ 6
BitValue(7) = 2 ^ 7
Count = 0
For i = 0 To 255
If (CharValue(i).C ount > 0) Then Count = Count + 1
Next
Call CopyMem(Result( ResultLen), Count, 2)
ResultLen = ResultLen + 2
Count = 0
For i = 0 To 255
If (CharValue(i).C ount > 0) Then
Result(ResultLe n) = i
ResultLen = ResultLen + 1
Result(ResultLe n) = CharValue(i).Co unt
ResultLen = ResultLen + 1
Count = Count + 16 + CharValue(i).Co unt
End If
Next
ReDim Preserve Result(0 To ResultLen + Count \ 8)
BitPos = 0
ByteValue = 0
For i = 0 To 255
With CharValue(i)
If (.Count > 0) Then
For j = 0 To (.Count - 1)
If (.Data(j)) Then ByteValue = ByteValue +
BitValue(BitPos )
BitPos = BitPos + 1
If (BitPos = 8) Then
Result(ResultLe n) = ByteValue
ResultLen = ResultLen + 1
ByteValue = 0
BitPos = 0
End If
Next
End If
End With
Next
If (BitPos > 0) Then
Result(ResultLe n) = ByteValue
ResultLen = ResultLen + 1
End If
ReDim Preserve Result(0 To ResultLen - 1 + lLength)
Char = 0
BitPos = 0
For i = 0 To (ByteLen - 1)
With CharValue(ByteA rray(i))
For j = 0 To (.Count - 1)
If (.Data(j) = 1) Then Char = Char + BitValue(BitPos )
BitPos = BitPos + 1
If (BitPos = 8) Then
Result(ResultLe n) = Char
ResultLen = ResultLen + 1
BitPos = 0
Char = 0
End If
Next
End With
If (i Mod 10000 = 0) Then
NewProgress = i / ByteLen * PROGRESS_ENCODI NG + PROGRESS_CALCCR C
+ PROGRESS_CALCFR EQUENCY
If (NewProgress <> CurrProgress) Then
CurrProgress = NewProgress
RaiseEvent Progress(CurrPr ogress)
End If
End If
Next
If (BitPos > 0) Then
Result(ResultLe n) = Char
ResultLen = ResultLen + 1
End If
ReDim ByteArray(0 To ResultLen - 1)
Call CopyMem(ByteArr ay(0), Result(0), ResultLen)
If (CurrProgress <> 100) Then RaiseEvent Progress(100)
End Sub
Public Function DecodeString(Te xt As String) As String
Dim ByteArray() As Byte
ByteArray() = StrConv(Text, vbFromUnicode)
Call DecodeByte(Byte Array, Len(Text))
DecodeString = StrConv(ByteArr ay(), vbUnicode)
End Function
Public Function EncodeString(Te xt As String) As String
Dim ByteArray() As Byte
ByteArray() = StrConv(Text, vbFromUnicode)
Call EncodeByte(Byte Array, Len(Text))
EncodeString = StrConv(ByteArr ay(), vbUnicode)
End Function
Public Sub DecodeByte(Byte Array() As Byte, ByteLen As Long)
Dim i As Long, j As Long, Pos As Long, Char As Byte, CurrPos As Long
Dim Count As Integer, CheckSum As Byte, Result() As Byte, BitPos As
Integer
Dim NodeIndex As Long, ByteValue As Byte, ResultLen As Long, NodesCount
As Long
Dim lResultLen As Long, NewProgress As Integer, CurrProgress As Integer,
BitValue(0 To 7) As Byte
Dim Nodes(0 To 511) As HUFFMANTREE, CharValue(0 To 255) As ByteArray
If (ByteArray(0) <> 72) Or (ByteArray(1) <> 69) Or (ByteArray(3) <> 13)
Then
ElseIf (ByteArray(2) = 48) Then
Call CopyMem(ByteArr ay(0), ByteArray(4), ByteLen - 4)
ReDim Preserve ByteArray(0 To ByteLen - 5)
Exit Sub
ElseIf (ByteArray(2) <> 51) Then
Err.Raise vbObjectError, "HuffmanDecode( )", "The data either was not
compressed with HE3 or is corrupt (identification string not found)"
Exit Sub
End If
CurrPos = 5
CheckSum = ByteArray(CurrP os - 1)
CurrPos = CurrPos + 1
Call CopyMem(ResultL en, ByteArray(CurrP os - 1), 4)
CurrPos = CurrPos + 4
lResultLen = ResultLen
If (ResultLen = 0) Then Exit Sub
ReDim Result(0 To ResultLen - 1)
Call CopyMem(Count, ByteArray(CurrP os - 1), 2)
CurrPos = CurrPos + 2
For i = 1 To Count
With CharValue(ByteA rray(CurrPos - 1))
CurrPos = CurrPos + 1
.Count = ByteArray(CurrP os - 1)
CurrPos = CurrPos + 1
ReDim .Data(0 To .Count - 1)
End With
Next
BitValue(0) = 2 ^ 0
BitValue(1) = 2 ^ 1
BitValue(2) = 2 ^ 2
BitValue(3) = 2 ^ 3
BitValue(4) = 2 ^ 4
BitValue(5) = 2 ^ 5
BitValue(6) = 2 ^ 6
BitValue(7) = 2 ^ 7
ByteValue = ByteArray(CurrP os - 1)
CurrPos = CurrPos + 1
BitPos = 0
For i = 0 To 255
With CharValue(i)
If (.Count > 0) Then
For j = 0 To (.Count - 1)
If (ByteValue And BitValue(BitPos )) Then .Data(j) = 1
BitPos = BitPos + 1
If (BitPos = 8) Then
ByteValue = ByteArray(CurrP os - 1)
CurrPos = CurrPos + 1
BitPos = 0
End If
Next
End If
End With
Next
If (BitPos = 0) Then CurrPos = CurrPos - 1
NodesCount = 1
Nodes(0).LeftNo de = -1
Nodes(0).RightN ode = -1
Nodes(0).Parent Node = -1
Nodes(0).Value = -1
For i = 0 To 255
Call CreateTree(Node s(), NodesCount, i, CharValue(i))
Next
ResultLen = 0
For CurrPos = CurrPos To ByteLen
ByteValue = ByteArray(CurrP os - 1)
For BitPos = 0 To 7
If (ByteValue And BitValue(BitPos )) Then NodeIndex =
Nodes(NodeIndex ).RightNode Else NodeIndex = Nodes(NodeIndex ).LeftNode
If (Nodes(NodeInde x).Value > -1) Then
Result(ResultLe n) = Nodes(NodeIndex ).Value
ResultLen = ResultLen + 1
If (ResultLen = lResultLen) Then GoTo DecodeFinished
NodeIndex = 0
End If
Next
If (CurrPos Mod 10000 = 0) Then
NewProgress = CurrPos / ByteLen * PROGRESS_DECODI NG
If (NewProgress <> CurrProgress) Then
CurrProgress = NewProgress
RaiseEvent Progress(CurrPr ogress)
End If
End If
Next
DecodeFinished:
Char = 0
For i = 0 To (ResultLen - 1)
Char = Char Xor Result(i)
If (i Mod 10000 = 0) Then
NewProgress = i / ResultLen * PROGRESS_CHECKC RC +
PROGRESS_DECODI NG
If (NewProgress <> CurrProgress) Then
CurrProgress = NewProgress
RaiseEvent Progress(CurrPr ogress)
End If
End If
Next
If (Char <> CheckSum) Then Err.Raise vbObjectError,
"clsHuffman.Dec ode()", "The data might be corrupted (checksum did not match
expected value)"
ReDim ByteArray(0 To ResultLen - 1)
Call CopyMem(ByteArr ay(0), Result(0), ResultLen)
If (CurrProgress <> 100) Then RaiseEvent Progress(100)
End Sub
Private Sub CreateBitSequen ces(Nodes() As HUFFMANTREE, ByVal NodeIndex As
Integer, Bytes As ByteArray, CharValue() As ByteArray)
Dim NewBytes As ByteArray
If (Nodes(NodeInde x).Value > -1) Then
CharValue(Nodes (NodeIndex).Val ue) = Bytes
Exit Sub
End If
If (Nodes(NodeInde x).LeftNode > -1) Then
NewBytes = Bytes
NewBytes.Data(N ewBytes.Count) = 0
NewBytes.Count = NewBytes.Count + 1
Call CreateBitSequen ces(Nodes(), Nodes(NodeIndex ).LeftNode,
NewBytes, CharValue)
End If
If (Nodes(NodeInde x).RightNode > -1) Then
NewBytes = Bytes
NewBytes.Data(N ewBytes.Count) = 1
NewBytes.Count = NewBytes.Count + 1
Call CreateBitSequen ces(Nodes(), Nodes(NodeIndex ).RightNode,
NewBytes, CharValue)
End If
End Sub
Private Function FileExist(Filen ame As String) As Boolean
On Error GoTo FileDoesNotExis t
Call FileLen(Filenam e)
FileExist = True
Exit Function
FileDoesNotExis t:
FileExist = False
End Function
-----------------------------------------
Here is a pre-built VB6 program:
http://www.planet-source-code.com/vb...11000&lngWId=1
Another VB6 code:
http://www.a1vbcode.com/app.asp?ID=1438
Sorry, but I haven't found any in VB.NET so far. I will keep looking for
you. The code above is simple to convert though