本文介绍了如何创建一个应该解密.huffman文件的"huffman文件"的处理方法,对大家解决问题具有一定的参考价值,需要的朋友们下面随着小编来一起学习吧!

问题描述

这是霍夫曼课程的模块,请帮助:]

显式选项

''霍夫曼压缩算法
''作者:David Midkiff(mznull@earthlink.net)
''
''这是霍夫曼压缩的有效实现方式
'' 算法.加密文件时,我建议压缩
''首先使用这种算法来节省移动
时的空间''通过Internet等介质加密的文件.

私人监工PROGRESS_CALCFREQUENCY = 7
私有常量PROGRESS_CALCCRC = 5
私人监工PROGRESS_ENCODING = 88
私人监工PROGRESS_DECODING = 89
私有常量PROGRESS_CHECKCRC = 11

活动进度(以整数形式表示)

私有类型HUFFMANTREE
ParentNode作为整数
RightNode作为整数
LeftNode作为整数
整数值
重量一样长
端部类型

私有类型ByteArray
计数为字节
以字节为单位的Data()
端部类型

私有声明子CopyMem库"kernel32"别名"RtlMoveMemory"(目标为任意,源​​为任意,ByVal长度为长)

Public Sub EncodeFile(源文件为字符串,目标文件为字符串)
昏暗的ByteArray()作为字节,Filenr作为整数

如果(Not FileExist(SourceFile))然后Err.Raise vbObjectError,"clsHuffman.EncodeFile()",源文件不存在"

Filenr = FreeFile
将二进制文件作为#Filenr打开SourceFile
ReDim ByteArray(0至LOF(Filenr)-1)
获取#Filenr,ByteArray()
关闭#Filenr

呼叫EncodeByte(ByteArray(),UBound(ByteArray)+ 1)

如果(FileExist(DestFile))然后杀死DestFile

以#Filenr格式打开DestFile二进制文件
将#Filenr,ByteArray()
关闭#Filenr
结束子
Public Sub DecodeFile(源文件为字符串,目标文件为字符串)
昏暗的ByteArray()作为字节,Filenr作为整数

如果(Not FileExist(SourceFile))然后Err.Raise vbObjectError,"clsHuffman.DecodeFile()",源文件不存在"

Filenr = FreeFile
将二进制文件作为#Filenr打开SourceFile
ReDim ByteArray(0至LOF(Filenr)-1)
获取#Filenr,ByteArray()
关闭#Filenr

呼叫DecodeByte(ByteArray(),UBound(ByteArray)+ 1)

如果(FileExist(DestFile))然后杀死DestFile

以#Filenr的格式打开DestFile的二进制文件
将#Filenr,ByteArray()
关闭#Filenr
结束子
私有子CreateTree(Nodes()为HUFFMANTREE,NodesCount为long,Char为long,字节为ByteArray)
将Dim设置为整数,将NodeIndex设置为Long

NodeIndex = 0
对于a = 0到(Bytes.Count-1)
如果(Bytes.Data(a)= 0)然后
如果(Nodes(NodeIndex).LeftNode = -1)然后
Nodes(NodeIndex).LeftNode = NodesCount
Nodes(NodesCount).ParentNode = NodeIndex
Nodes(NodesCount).LeftNode = -1
Nodes(NodesCount).RightNode = -1
Nodes(NodesCount).Value = -1
NodesCount = NodesCount + 1
如果结束
NodeIndex = Nodes(NodeIndex).LeftNode
ElseIf(Bytes.Data(a)= 1)然后
如果(Nodes(NodeIndex).RightNode = -1)然后
Nodes(NodeIndex).RightNode = NodesCount
Nodes(NodesCount).ParentNode = NodeIndex
Nodes(NodesCount).LeftNode = -1
Nodes(NodesCount).RightNode = -1
Nodes(NodesCount).Value = -1
NodesCount = NodesCount + 1
如果结束
NodeIndex = Nodes(NodeIndex).RightNode
其他
停止
如果结束
下一个
Nodes(NodeIndex).Value =字符
结束子
Public Sub EncodeByte(ByteArray()as Byte,ByteLen as Long)
昏暗的i长,j的长,Char的字节,BitPos的字节,lNode1的长 昏暗的lNode2长,lNode长,lLength长,计数为整数
昏暗的lWeight1长,lWeight2长,Result()作为字节,ByteValue作为字节
昏暗的ResultLen长,字节的大小为ByteArray,NodesCount的大小为整数,NewProgress的大小为整数
Dim CurrProgress为整数,BitValue(0至7)作为字节,CharCount(0至255)作为长整数
昏暗的节点(0至511)为HUFFMANTREE,字符值(0至255)为ByteArray

如果(ByteLen = 0)然后
ReDim保留ByteArray(0到ByteLen + 3)
如果(ByteLen> 0),则调用CopyMem(ByteArray(4),ByteArray(0),ByteLen)
ByteArray(0)= 72
ByteArray(1)= 69
ByteArray(2)= 48
ByteArray(3)= 13
退出子
如果结束

ReDim结果(0到522)
结果(0)= 72
结果(1)= 69
结果(2)= 51
结果(3)= 13
ResultLen = 4

对于i = 0到(ByteLen-1)
CharCount(ByteArray(i))= CharCount(ByteArray(i))+1
如果(i Mod 1000 = 0)那么
NewProgress = i/ByteLen * PROGRESS_CALCFREQUENCY
如果(NewProgress<> CurrProgress)那么
CurrProgress = NewProgress
RaiseEvent Progress(CurrProgress)
如果结束
如果结束
下一个
对于i = 0到255
如果(CharCount(i)> 0),则
使用Nodes(NodesCount)
.Weight = CharCount(i)
值= i
.LeftNode = -1
.RightNode = -1
.ParentNode = -1
结尾为
NodesCount = NodesCount + 1
如果结束
下一个

对于lNodes = NodesCount到2步骤-1
lNode1 = -1:lNode2 = -1
对于i = 0到(NodesCount-1)
如果(Nodes(i).ParentNode = -1)然后
如果(lNode1 = -1)那么
lWeight1 =节点(i).Weight
lNode1 = i
ElseIf(lNode2 = -1)然后
lWeight2 =节点(i).Weight
lNode2 = i
ElseIf(Nodes(i).Weight< lWeight1)然后
如果(Nodes(i).Weight 如果(lWeight1 lWeight2 =节点(i).Weight
lNode2 = i
其他
lWeight1 =节点(i).Weight
lNode1 = i
如果结束
其他
lWeight1 =节点(i).Weight
lNode1 = i
如果结束
ElseIf(Nodes(i).Weight< lWeight2)然后
lWeight2 =节点(i).Weight
lNode2 = i
如果结束
如果结束
下一个

使用Nodes(NodesCount)
.Weight = lWeight1 + lWeight2
.LeftNode = lNode1
.RightNode = lNode2
.ParentNode = -1
.值= -1
结尾为

Nodes(lNode1).ParentNode = NodesCount
Nodes(lNode2).ParentNode = NodesCount
NodesCount = NodesCount + 1
下一个

ReDim Bytes.Data(0到255)
调用CreateBitSequences(Nodes(),NodesCount-1,Bytes,CharValue)

对于i = 0到255
如果(CharCount(i)> 0),则lLength = lLength + CharValue(i).Count * CharCount(i)
下一个
lLength = IIf(lLength Mod 8 = 0,lLength \ 8,lLength \ 8 +1)

如果((lLength = 0)或(lLength> ByteLen))然后
ReDim保留ByteArray(0到ByteLen + 3)
呼叫CopyMem(ByteArray(4),ByteArray(0),ByteLen)
ByteArray(0)= 72
ByteArray(1)= 69
ByteArray(2)= 48
ByteArray(3)= 13
退出子
如果结束

字符= 0
对于i = 0到(ByteLen-1)
Char = Char Xor ByteArray(i)
如果(i Mod 10000 = 0)那么
NewProgress = i/ByteLen * PROGRESS_CALCCRC + PROGRESS_CALCFREQUENCY
如果(NewProgress<> CurrProgress)那么
CurrProgress = NewProgress
RaiseEvent Progress(CurrProgress)
如果结束
如果结束
下一个
Result(ResultLen)=字符
ResultLen = ResultLen +1
呼叫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
计数= 0
对于i = 0到255
如果(CharValue(i).Count> 0)则Count = Count + 1
下一个
呼叫CopyMem(Result(ResultLen),Count,2)
ResultLen = ResultLen + 2
计数= 0
对于i = 0到255
如果(CharValue(i).Count> 0)然后
Result(ResultLen)= i
ResultLen = ResultLen +1
Result(ResultLen)= CharValue(i).Count
ResultLen = ResultLen +1
Count = Count + 16 + CharValue(i).Count
如果结束
下一个

ReDim保留结果(0到ResultLen + Count \ 8)

BitPos = 0
字节值= 0
对于i = 0到255
使用CharValue(i)
如果(.Count> 0)然后
对于j = 0 To(.Count-1)
如果是(.Data(j)),则ByteValue = ByteValue + BitValue(BitPos)
BitPos = BitPos +1
如果(BitPos = 8)那么
Result(ResultLen)=字节值
ResultLen = ResultLen +1
字节值= 0
BitPos = 0
如果结束
下一个
如果结束
结尾为
下一个
如果(BitPos> 0)然后
Result(ResultLen)=字节值
ResultLen = ResultLen +1
如果结束

ReDim保留结果(0到ResultLen-1 + lLength)

字符= 0
BitPos = 0
对于i = 0到(ByteLen-1)
使用CharValue(ByteArray(i))
对于j = 0 To(.Count-1)
如果(.Data(j)= 1)则Char = Char + BitValue(BitPos)
BitPos = BitPos +1
如果(BitPos = 8)那么
Result(ResultLen)=字符
ResultLen = ResultLen +1
BitPos = 0
字符= 0
如果结束
下一个
结尾为
如果(i Mod 10000 = 0)那么
NewProgress = i/ByteLen * PROGRESS_ENCODING + PROGRESS_CALCCRC + PROGRESS_CALCFREQUENCY
如果(NewProgress<> CurrProgress)那么
CurrProgress = NewProgress
RaiseEvent Progress(CurrProgress)
如果结束
如果结束
下一个

如果(BitPos> 0)然后
Result(ResultLen)=字符
ResultLen = ResultLen +1
如果结束
ReDim ByteArray(0到ResultLen-1)
呼叫CopyMem(ByteArray(0),Result(0),ResultLen)
如果(CurrProgress<> 100),则RaiseEvent Progress(100)
结束子
公共函数DecodeString(文本为字符串)为字符串
昏暗的ByteArray()作为字节
ByteArray()= StrConv(文本,vbFromUnicode)
呼叫DecodeByte(ByteArray,Len(Text))
DecodeString = StrConv(ByteArray(),vbUnicode)
最终功能
公共函数EncodeString(文本作为字符串)作为字符串
昏暗的ByteArray()作为字节
ByteArray()= StrConv(文本,vbFromUnicode)
呼叫EncodeByte(ByteArray,Len(Text))
EncodeString = StrConv(ByteArray(),vbUnicode)
最终功能
Public Sub DecodeByte(ByteArray()as Byte,ByteLen as Long)
Dim i Long,j Long,Pos Long,Char as Byte,CurrPos Long
昏暗计数为整数,校验和为字节,Result()为字节,BitPos为整数
Dim NodeIndex长,ByteValue长字节,ResultLen长,NodesCount长
Dim lResultLen长,NewProgress为整数,CurrProgress为整数,BitValue(0到7)作为字节
昏暗的节点(0至511)为HUFFMANTREE,字符值(0至255)为ByteArray

如果(ByteArray(0)<> 72)或(ByteArray(1)<> 69)或(ByteArray(3)<> 13)则
ElseIf(ByteArray(2)= 48)然后
呼叫CopyMem(ByteArray(0),ByteArray(4),ByteLen-4)
ReDim保留ByteArray(0到ByteLen-5)
退出子
ElseIf(ByteArray(2)<> 51)然后
Err.Raise vbObjectError,"HuffmanDecode()",数据未使用HE3压缩或损坏(找不到标识字符串)"
退出子
如果结束

CurrPos = 5
CheckSum = ByteArray(CurrPos-1)
CurrPos = CurrPos +1

呼叫CopyMem(ResultLen,ByteArray(CurrPos-1),4)
CurrPos = CurrPos + 4
lResultLen = ResultLen
如果(ResultLen = 0)则退出Sub
ReDim结果(0到ResultLen-1)
呼叫CopyMem(Count,ByteArray(CurrPos-1),2)
CurrPos = CurrPos + 2

对于i = 1进行计数
使用CharValue(ByteArray(CurrPos-1))
CurrPos = CurrPos +1
.Count = ByteArray(CurrPos-1)
CurrPos = CurrPos +1
ReDim .Data(0至.Count-1)
结尾为
下一个

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(CurrPos-1)
CurrPos = CurrPos +1
BitPos = 0

对于i = 0到255
使用CharValue(i)
如果(.Count> 0)然后
对于j = 0 To(.Count-1)
如果(ByteValue和BitValue(BitPos))然后.Data(j)= 1
BitPos = BitPos +1
如果(BitPos = 8)那么
ByteValue = ByteArray(CurrPos-1)
CurrPos = CurrPos +1
BitPos = 0
如果结束
下一个
如果结束
结尾为
下一个

如果(BitPos = 0),则CurrPos = CurrPos-1

NodesCount = 1
节点数(0).LeftNode = -1
节点(0).RightNode = -1
节点(0).ParentNode = -1
节点数(0).值= -1

对于i = 0到255
调用CreateTree(Nodes(),NodesCount,i,CharValue(i))
下一个

ResultLen = 0
对于CurrPos = CurrPos到ByteLen
ByteValue = ByteArray(CurrPos-1)
对于BitPos = 0到7
如果是(ByteValue和BitValue(BitPos)),则NodeIndex =节点(NodeIndex).RightNode否则NodeIndex =节点(NodeIndex).LeftNode
如果(Nodes(NodeIndex).Value> -1)然后
Result(ResultLen)=节点(NodeIndex).Value
ResultLen = ResultLen +1
如果(ResultLen = lResultLen),则转到DecodeFinished
NodeIndex = 0
如果结束
下一个
如果(CurrPos Mod 10000 = 0)那么
NewProgress = CurrPos/ByteLen * PROGRESS_DECODING
如果(NewProgress<> CurrProgress)那么
CurrProgress = NewProgress
RaiseEvent Progress(CurrProgress)
如果结束
如果结束
下一个

DecodeFinished:
字符= 0
对于i = 0到(ResultLen-1)
Char = Char Xor结果(i)
如果(i Mod 10000 = 0)那么
NewProgress = i/ResultLen * PROGRESS_CHECKCRC + PROGRESS_DECODING
如果(NewProgress<> CurrProgress)那么
CurrProgress = NewProgress
RaiseEvent Progress(CurrProgress)
如果结束
如果结束
下一个
如果(Char<> CheckSum),则Err.Raise vbObjectError,"clsHuffman.Decode()",数据可能已损坏(校验和与期望值不匹配)"
ReDim ByteArray(0到ResultLen-1)
呼叫CopyMem(ByteArray(0),Result(0),ResultLen)
如果(CurrProgress<> 100),则RaiseEvent Progress(100)
结束子
私有子CreateBitSequences(Nodes()为HUFFMANTREE,ByVal NodeIndex为整数,字节为ByteArray,CharValue()为ByteArray)
将NewBytes调为ByteArray
如果(Nodes(NodeIndex).Value> -1)然后
CharValue(Nodes(NodeIndex).Value)=字节
退出子
如果结束
如果(Nodes(NodeIndex).LeftNode> -1)然后
NewBytes =字节
NewBytes.Data(NewBytes.Count)= 0
NewBytes.Count = NewBytes.Count +1
调用CreateBitSequences(Nodes(),Nodes(NodeIndex).LeftNode,NewBytes,CharValue)
如果结束
如果(Nodes(NodeIndex).RightNode> -1)然后
NewBytes =字节
NewBytes.Data(NewBytes.Count)= 1
NewBytes.Count = NewBytes.Count +1
调用CreateBitSequences(Nodes(),Nodes(NodeIndex).RightNode,NewBytes,CharValue)
如果结束
结束子

私有函数FileExist(文件名作为字符串)作为布尔值
出错时转到FileDoesNotExist
调用FileLen(Filename)
FileExist = True
退出功能

FileDoesNotExist:
FileExist = False
结束功能

This is the huffman class module please help :]

Option Explicit

'' Huffman Compression Algorithm
'' By: David Midkiff (mznull@earthlink.net)
''
'' This is a working implementation of the Huffman compression
'' algorithm. When encrypting files I would recommend compressing
'' it first with this algorithm to save space when moving the
'' encrypted file over mediums such as the Internet.

Private Const PROGRESS_CALCFREQUENCY = 7
Private Const PROGRESS_CALCCRC = 5
Private Const PROGRESS_ENCODING = 88
Private Const PROGRESS_DECODING = 89
Private Const PROGRESS_CHECKCRC = 11

Event Progress(Procent 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 "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Public Sub EncodeFile(SourceFile As String, DestFile As String)
Dim ByteArray() As Byte, Filenr As Integer

If (Not FileExist(SourceFile)) Then Err.Raise vbObjectError, "clsHuffman.EncodeFile()", "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(ByteArray(), UBound(ByteArray) + 1)

If (FileExist(DestFile)) Then Kill DestFile

Open DestFile For Binary As #Filenr
Put #Filenr, , ByteArray()
Close #Filenr
End Sub
Public Sub DecodeFile(SourceFile As String, DestFile As String)
Dim ByteArray() As Byte, Filenr As Integer

If (Not FileExist(SourceFile)) Then Err.Raise vbObjectError, "clsHuffman.DecodeFile()", "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(ByteArray(), UBound(ByteArray) + 1)

If (FileExist(DestFile)) Then Kill DestFile

Open DestFile For Binary As #Filenr
Put #Filenr, , ByteArray()
Close #Filenr
End Sub
Private Sub CreateTree(Nodes() 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(NodeIndex).LeftNode = -1) Then
Nodes(NodeIndex).LeftNode = NodesCount
Nodes(NodesCount).ParentNode = NodeIndex
Nodes(NodesCount).LeftNode = -1
Nodes(NodesCount).RightNode = -1
Nodes(NodesCount).Value = -1
NodesCount = NodesCount + 1
End If
NodeIndex = Nodes(NodeIndex).LeftNode
ElseIf (Bytes.Data(a) = 1) Then
If (Nodes(NodeIndex).RightNode = -1) Then
Nodes(NodeIndex).RightNode = NodesCount
Nodes(NodesCount).ParentNode = NodeIndex
Nodes(NodesCount).LeftNode = -1
Nodes(NodesCount).RightNode = -1
Nodes(NodesCount).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(ByteArray() 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(ByteArray(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(ByteArray(i)) = CharCount(ByteArray(i)) + 1
If (i Mod 1000 = 0) Then
NewProgress = i / ByteLen * PROGRESS_CALCFREQUENCY
If (NewProgress <> CurrProgress) Then
CurrProgress = NewProgress
RaiseEvent Progress(CurrProgress)
End If
End If
Next
For i = 0 To 255
If (CharCount(i) > 0) Then
With Nodes(NodesCount)
.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).ParentNode = -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).Weight < lWeight1) Then
If (Nodes(i).Weight < 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).Weight < lWeight2) Then
lWeight2 = Nodes(i).Weight
lNode2 = i
End If
End If
Next

With Nodes(NodesCount)
.Weight = lWeight1 + lWeight2
.LeftNode = lNode1
.RightNode = lNode2
.ParentNode = -1
.Value = -1
End With

Nodes(lNode1).ParentNode = NodesCount
Nodes(lNode2).ParentNode = NodesCount
NodesCount = NodesCount + 1
Next

ReDim Bytes.Data(0 To 255)
Call CreateBitSequences(Nodes(), NodesCount - 1, Bytes, CharValue)

For i = 0 To 255
If (CharCount(i) > 0) Then lLength = lLength + CharValue(i).Count * 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(ByteArray(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_CALCCRC + PROGRESS_CALCFREQUENCY
If (NewProgress <> CurrProgress) Then
CurrProgress = NewProgress
RaiseEvent Progress(CurrProgress)
End If
End If
Next
Result(ResultLen) = 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).Count > 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).Count > 0) Then
Result(ResultLen) = i
ResultLen = ResultLen + 1
Result(ResultLen) = CharValue(i).Count
ResultLen = ResultLen + 1
Count = Count + 16 + CharValue(i).Count
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(ResultLen) = ByteValue
ResultLen = ResultLen + 1
ByteValue = 0
BitPos = 0
End If
Next
End If
End With
Next
If (BitPos > 0) Then
Result(ResultLen) = 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(ByteArray(i))
For j = 0 To (.Count - 1)
If (.Data(j) = 1) Then Char = Char + BitValue(BitPos)
BitPos = BitPos + 1
If (BitPos = 8) Then
Result(ResultLen) = Char
ResultLen = ResultLen + 1
BitPos = 0
Char = 0
End If
Next
End With
If (i Mod 10000 = 0) Then
NewProgress = i / ByteLen * PROGRESS_ENCODING + PROGRESS_CALCCRC + PROGRESS_CALCFREQUENCY
If (NewProgress <> CurrProgress) Then
CurrProgress = NewProgress
RaiseEvent Progress(CurrProgress)
End If
End If
Next

If (BitPos > 0) Then
Result(ResultLen) = Char
ResultLen = ResultLen + 1
End If
ReDim ByteArray(0 To ResultLen - 1)
Call CopyMem(ByteArray(0), Result(0), ResultLen)
If (CurrProgress <> 100) Then RaiseEvent Progress(100)
End Sub
Public Function DecodeString(Text As String) As String
Dim ByteArray() As Byte
ByteArray() = StrConv(Text, vbFromUnicode)
Call DecodeByte(ByteArray, Len(Text))
DecodeString = StrConv(ByteArray(), vbUnicode)
End Function
Public Function EncodeString(Text As String) As String
Dim ByteArray() As Byte
ByteArray() = StrConv(Text, vbFromUnicode)
Call EncodeByte(ByteArray, Len(Text))
EncodeString = StrConv(ByteArray(), vbUnicode)
End Function
Public Sub DecodeByte(ByteArray() 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(ByteArray(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(CurrPos - 1)
CurrPos = CurrPos + 1

Call CopyMem(ResultLen, ByteArray(CurrPos - 1), 4)
CurrPos = CurrPos + 4
lResultLen = ResultLen
If (ResultLen = 0) Then Exit Sub
ReDim Result(0 To ResultLen - 1)
Call CopyMem(Count, ByteArray(CurrPos - 1), 2)
CurrPos = CurrPos + 2

For i = 1 To Count
With CharValue(ByteArray(CurrPos - 1))
CurrPos = CurrPos + 1
.Count = ByteArray(CurrPos - 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(CurrPos - 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(CurrPos - 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).LeftNode = -1
Nodes(0).RightNode = -1
Nodes(0).ParentNode = -1
Nodes(0).Value = -1

For i = 0 To 255
Call CreateTree(Nodes(), NodesCount, i, CharValue(i))
Next

ResultLen = 0
For CurrPos = CurrPos To ByteLen
ByteValue = ByteArray(CurrPos - 1)
For BitPos = 0 To 7
If (ByteValue And BitValue(BitPos)) Then NodeIndex = Nodes(NodeIndex).RightNode Else NodeIndex = Nodes(NodeIndex).LeftNode
If (Nodes(NodeIndex).Value > -1) Then
Result(ResultLen) = 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_DECODING
If (NewProgress <> CurrProgress) Then
CurrProgress = NewProgress
RaiseEvent Progress(CurrProgress)
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_CHECKCRC + PROGRESS_DECODING
If (NewProgress <> CurrProgress) Then
CurrProgress = NewProgress
RaiseEvent Progress(CurrProgress)
End If
End If
Next
If (Char <> CheckSum) Then Err.Raise vbObjectError, "clsHuffman.Decode()", "The data might be corrupted (checksum did not match expected value)"
ReDim ByteArray(0 To ResultLen - 1)
Call CopyMem(ByteArray(0), Result(0), ResultLen)
If (CurrProgress <> 100) Then RaiseEvent Progress(100)
End Sub
Private Sub CreateBitSequences(Nodes() As HUFFMANTREE, ByVal NodeIndex As Integer, Bytes As ByteArray, CharValue() As ByteArray)
Dim NewBytes As ByteArray
If (Nodes(NodeIndex).Value > -1) Then
CharValue(Nodes(NodeIndex).Value) = Bytes
Exit Sub
End If
If (Nodes(NodeIndex).LeftNode > -1) Then
NewBytes = Bytes
NewBytes.Data(NewBytes.Count) = 0
NewBytes.Count = NewBytes.Count + 1
Call CreateBitSequences(Nodes(), Nodes(NodeIndex).LeftNode, NewBytes, CharValue)
End If
If (Nodes(NodeIndex).RightNode > -1) Then
NewBytes = Bytes
NewBytes.Data(NewBytes.Count) = 1
NewBytes.Count = NewBytes.Count + 1
Call CreateBitSequences(Nodes(), Nodes(NodeIndex).RightNode, NewBytes, CharValue)
End If
End Sub

Private Function FileExist(Filename As String) As Boolean
On Error GoTo FileDoesNotExist
Call FileLen(Filename)
FileExist = True
Exit Function

FileDoesNotExist:
FileExist = False
End Function

推荐答案


这篇关于如何创建一个应该解密.huffman文件的"huffman文件"的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持!

05-28 22:48
查看更多