Why use pen and paper when you have vbscript?
First, I use this script:
Code: Select all
Dim objFSO, objTextFile, objHexFile
Dim strCharacter
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objHexFile = objFSO.OpenTextFile ("C:\Huffman\B0.txt", 1)
Set objTextFile = objFSO.OpenTextFile ("C:\Huffman\Binary.txt", 8, True)
Do Until objHexFile.AtEndOfStream
strCharacter = objHexFile.Read(1)
if strCharacter <= "9" then
OneDigit = asc(strCharacter) - asc("0")
else
OneDigit = asc(strCharacter) - asc("A") + 10
end if
PowerOfTwo = 8
while PowerOfTwo >= 1
if OneDigit >= PowerOfTwo then
objTextFile.Write("1")
OneDigit = OneDigit - PowerOfTwo
else
objTextFile.Write("0")
end if
PowerOfTwo = PowerOfTwo / 2
wend
LoopIn order to get this work, you need the hex values of any Bard's Tale Huffman file in a text file, except the first 8 bytes since they're not part of the Huffman encoding.
Next I run following script:
Code: Select all
Dim objFSO, objCodeFile, objDecodeFile
Dim strCharacters, code, hexvalue
Dim nrArray, nrHuffman, nrCode
Dim HuffmanCode, Huffmanhex
dim lngResult
dim intIndex
dim hexcodearray()
dim bincodearray()
dim hufcodearray()
dim TempBin
dim TotalBin, TempLength, MaxLength
dim FindRight, Number
dim Match
dim FinalHex
dim FoundIt
code = ""
hexvalue = ""
nrArray = 0
HuffmanCode = ""
nrCode = 0
Huffmanhex = ""
lngResult = 0
TotalBin = 0
TempLenght = 0
MaxLength = 0
TempBin = ""
FindRight = 0
Number = 1
Match = ""
FinalHex = ""
FoundIt = 0
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile("C:\Huffman\Binary.txt", 1)
Set objCodeFile = objFSO.OpenTextFile ("C:\Huffman\Code.txt", 8, True)
Do Until objFile.AtEndOfStream
strCharacters = objFile.Read(1) 'Start reading the file, bit by bit
if strCharacters = "0" then
code = code + "0" 'If a bit = 0, add it to the code
TotalBin = TotalBin + 1
else
TotalBin = TotalBin + 1
code = code + "1" 'We hit a leaf!
if len(code) = 1 then 'End of the Huffman tree
exit do 'Bye bye
end if
hexvalue = objfile.read(8) '8 bits = 1 byte, need to translate to Hex still
TotalBin = TotalBin + 8
If nrArray = 0 then 'This is just the first few bits, start of Huffman code
nrHuffman = Len(code) - 1
Huffmancode = Left(code, nrHuffman)
Else 'All the other codes are built here
do while Right(Huffmancode, 1)="1" ' If there's any "1", remove them
nrHuffman = Len(Huffmancode) - 1
Huffmancode = Left(Huffmancode, nrHuffman)
loop
nrHuffman = Len(Huffmancode) - 1
If nrHuffman < 0 then 'Added safety check
exit do
End if
Huffmancode = Left(Huffmancode, nrHuffman)
Huffmancode = Huffmancode + "1" 'Replace the last "0" by a "1"
nrCode = Len(code) - 2 'Remove 2, the first "0" and the last "1"
if nrCode > 0 then
for j = 1 to nrCode
Huffmancode = Huffmancode + "0" 'Add a "0" for each remaining "0"
next
End if
End if
for intIndex = len(hexvalue) to 1 step -1
strDigit = mid(hexvalue, intIndex, 1)
select case strDigit
case "0"
' do nothing
case "1"
lngResult = lngResult + (2 ^ (len(hexvalue)-intIndex))
case else
' invalid binary digit, so the whole thing is invalid
lngResult = 0
intIndex = 0 ' stop the loop
end select
next
Huffmanhex = hex(lngResult)
If Len(HuffmanHex) = 1 then
Huffmanhex = "0" + Huffmanhex
End if
redim preserve hexcodearray(nrarray) 'rebuild the array and preserve previous data
redim preserve bincodearray(nrarray)
redim preserve hufcodearray(nrarray)
hexcodearray(nrarray) = Huffmanhex 'add values to the array
bincodearray(nrarray) = hexvalue
hufcodearray(nrarray) = Huffmancode
TempLength = len(hufcodearray(nrarray)) 'This is used during the actual decoding process
if TempLength > MaxLength then 'determining which Huffman code has the most bits
MaxLength = TempLength
else
TempLength = 0
End if
objCodeFile.WriteLine(chr(40) & code & chr(41) & chr(9) & hexvalue & chr(9) & Huffmancode & chr(9) & Huffmanhex)
code = ""
hexvalue = ""
nrHuffman = 0
nrCode = 0
nrArray = nrArray + 1
lngResult = 0
end if
Loop
objFile.close
Set objDecodeFile = objFSO.OpenTextFile("C:\Huffman\Binary.txt", 1)
TempBin = objDecodeFile.ReadAll 'Read the entire file and put it in a variable
TempBin = Mid(TempBin, TotalBin) 'Start to read from where the Huffman tree stops
nrarray = nrarray - 1
MaxLength = MaxLength - 1
FindRight = len(TempBin)
do while FindRight > 0
for i = 0 to MaxLength
Match = left(TempBin,Number) 'Start adding bits to the Match variable
for j = 0 to nrArray 'check all the Huffmancodes if we have a match
if Match = hufcodearray(j) then
FinalHex = FinalHex + hexcodearray(j) 'We have a match! Add the decoded hex to the FinalHex variable
FOundIt = 1 'used for quiting 'for..next', otherwise Match keeps on growing
exit for
end if
next
if FoundIt = 1 then 'quiting for..next here
exit for
end if
Number = Number + 1
next
FindRight = FindRight - Number
if FindRight < 1 then 'We reached the end of the file!
exit do
end if
TempBin = right(TempBin,FindRight) 'remove the bits we just matched
Number = 1
FoundIt = 0
Match = ""
loop
objCodeFile.Write(FinalHex) 'write the decoded hex to file
objDecodeFile.Close
objCodeFile.CloseEDIT: corrected a little error.
) I used to program in Basic. A lot of those commands and logics are in scripting as well. But for exact commands and formatting, I need the internet.