'---------------------------------------------------------------'
' HTCConverter.vbs                                              '
' Version 1.0 - August 31, 2002                                 '
' Written by Christophe Fontanel                                '
'                                                               '
' Please visit The Dungeon Master & Chaos Strikes Back          '
' Encyclopaedia at http://dmweb.free.fr/ for more information   '
'                                                               '
' Here is information about the LZW algorithm:                  '
' http://dogma.net/markn/articles/lzw/lzw.htm                   '
'---------------------------------------------------------------'




Option Explicit
On Error Resume Next

Const ForReading = 1, ForWriting = 2

Dim i, j, t, buffer
Dim ScriptArguments, FileSystemObject, RegularExpression, Matches
Dim SourceFileName, SourceFile, SourceFileType, DestinationFileName, DestinationFile, DestinationFileContent

' The following variables will contain the RAW contents of an .htc file
Dim FileSignature
Dim NumberOfLocationRecords, SizeOfLocationRecord, ListOfLocationRecords()
Dim NumberOfHintRecords, SizeOfHintRecord, ListOfHintRecords()
Dim NumberOfPages, ListOfHintContentLengths(), HintContents()




Set ScriptArguments = WScript.Arguments
If ScriptArguments.Count = 0 Then
	MsgBox 	"Converts files between .htc (or .hct) and .txt formats." & vbCrLf & vbCrLf & _
		"Usage example: at a command prompt, type either command line:" & vbCrLf & _
		"   HTCConverter.vbs HCSB.HTC" & vbCrLf & _
		"   HTCConverter.vbs HCSB.HTC /raw" & vbCrLf & _
		"   HTCConverter.vbs HCSB.TXT" & vbCrLf & _
		"You can also drag and drop a .htc, .hct or .txt file on HTCConverter.vbs in Windows Explorer." & vbCrLf & vbCrLf &  _
		"The converted file will be saved in the script's folder." & vbCrLf & vbCrLf & _
		"When converting a .htc or .hct file:" & vbCrLf & _
		"  Use the /raw command line parameter to export all the data from the file." & vbCrLf & _
		"  Note that you cannot convert a raw .txt file back to .htc format." & vbCrLf & vbCrLf & _
		"When converting a .txt file:" & vbCrLf & _
		"  The input .txt file must have a specific format. Convert a .htc file to .txt and look at the file format for an example." & vbCrLf & _
		"  The first line must read ""HTCConverter Hints File""." & vbCrLf & _
		"  For each hint declaration, use one blank line to start the declaration, one line for the name, one line for locations" & vbCrLf & _
		"  defined like this: ""(Level,X,Y)"", and one line for each page.", vbOKOnly + vbInformation, "HTCConverter Help"
Else
	SourceFileName = ScriptArguments(0)
	SourceFileType = UCase(Right(SourceFileName, 4))
	If (SourceFileType <> ".HTC") And (SourceFileType <> ".HCT") And (SourceFileType <> ".TXT") Then
		MsgBox "Incorrect file extension (use .htc, .hct or .txt).", vbOKOnly + vbCritical, "HTCConverter Error"
	Else
		Set FileSystemObject = CreateObject("Scripting.FileSystemObject")
		If Not FileSystemObject.FileExists(SourceFileName) Then
			MsgBox "File not found: " & SourceFileName, vbOKOnly + vbCritical, "HTCConverter Error"
		Else
			Err.Clear
			Set SourceFile = FileSystemObject.OpenTextFile(SourceFileName, ForReading)
			If Err.Number <> 0 Then
				MsgBox "Unable to open file: " & SourceFileName & vbCrLf & Err.Description, vbOKOnly + vbCritical, "HTCConverter Error"
			Else
				If (SourceFileType = ".HTC") Or (SourceFileType = ".HCT") Then
					FileSignature = SourceFile.Read(6)
					If FileSignature <> Chr(&h00) & Chr(&h02) & Chr(&h00) & Chr(&h0D) & Chr(&h00) & Chr(&h03) Then
						MsgBox "Invalid signature of .htc or .hct file.", vbOKOnly + vbCritical, "HTCConverter Error"
					Else
						ReadHTC
						If ScriptArguments.Count > 1 Then
							If UCase(ScriptArguments(1)) <> "/RAW" Then
								MsgBox "Invalid command line parameter: " & ScriptArguments(1), vbOKOnly + vbCritical, "HTCConverter Error"
							Else
								SaveAsTXTRaw
							End If
						Else
							SaveAsTXT
						End If
					End If
				End If
				If SourceFileType = ".TXT" Then
					If SourceFile.ReadLine <> "HTCConverter Hints File" Then
						MsgBox "Invalid .txt file. (look at a converted .htc or .hct file for an example)." & vbCrLf, vbOKOnly + vbCritical, "HTCConverter Error"
					Else
						If ScriptArguments.Count > 1 Then
							MsgBox "Invalid command line parameter." & vbCrLf, vbOKOnly + vbCritical, "HTCConverter Error"
						Else
							ReadTXT
							SaveAsHTC
						End If
					End If
				End If
				SourceFile.Close
			End If
		End If
	End If
End If

Sub ReadHTC
	NumberOfLocationRecords = 256 * Asc(SourceFile.Read(1)) + Asc(SourceFile.Read(1))
	SizeOfLocationRecord = 256 * Asc(SourceFile.Read(1)) + Asc(SourceFile.Read(1))
	If (SizeOfLocationRecord <> 6) Then
		MsgBox "The size of location records seems incorrect. It should be 6 bytes. The value in the file is '" & SizeOfLocationRecord & "'.", vbOKOnly, "Warning"
	End If
	
	ReDim ListOfLocationRecords(NumberOfLocationRecords - 1, 4)
	For i = 0 To NumberOfLocationRecords - 1
		ListOfLocationRecords(i, 0) = Asc(SourceFile.Read(1))
		ListOfLocationRecords(i, 1) = Asc(SourceFile.Read(1))
		ListOfLocationRecords(i, 2) = Asc(SourceFile.Read(1))
		ListOfLocationRecords(i, 3) = Asc(SourceFile.Read(1))
		If (ListOfLocationRecords(i, 3) <> 0) Then
			MsgBox "The fourth byte of the location record number " & i & " should be '00'. The value in the file is '" & ListOfLocationRecords(i, 3) & "'.", vbOKOnly, "Warning"
		End If
		ListOfLocationRecords(i, 4) = 256 * Asc(SourceFile.Read(1)) + Asc(SourceFile.Read(1))
	Next
	
	NumberOfHintRecords = 256 * Asc(SourceFile.Read(1)) + Asc(SourceFile.Read(1))
	SizeOfHintRecord = 256 * Asc(SourceFile.Read(1)) + Asc(SourceFile.Read(1))
	If (SizeOfHintRecord <> 26) Then
		MsgBox "The size of hint records seems incorrect. It should be 26 bytes. The value in the file is '" & SizeOfHintRecord & "'.", vbOKOnly, "Warning"
	End If
	
	ReDim ListOfHintRecords(NumberOfHintRecords - 1, 2)
	For i = 0 To NumberOfHintRecords - 1
		ListOfHintRecords(i, 0) = SourceFile.Read(22)
		ListOfHintRecords(i, 1) = 256 * Asc(SourceFile.Read(1)) + Asc(SourceFile.Read(1))
		ListOfHintRecords(i, 2) = 256 * Asc(SourceFile.Read(1)) + Asc(SourceFile.Read(1))
	Next
	
	NumberOfPages = 256 * Asc(SourceFile.Read(1)) + Asc(SourceFile.Read(1))
	
	ReDim ListOfHintContentLengths(NumberOfPages - 1)
	For i = 0 To NumberOfPages - 1
		ListOfHintContentLengths(i) = 256 * Asc(SourceFile.Read(1)) + Asc(SourceFile.Read(1))
	Next
	
	ReDim HintContents(NumberOfHintRecords - 1)
	For i = 0 To NumberOfHintRecords - 1
		HintContents(i) = SourceFile.Read(ListOfHintContentLengths(ListOfHintRecords(i, 1)))
	Next
End Sub

Function SaveAsHTC
	' Build destination HTC file name with full path
	DestinationFileName = WScript.ScriptFullName						' Get script full name with path
	DestinationFileName = Left(DestinationFileName, InStrRev(DestinationFileName, "\"))	' Remove script file name
	DestinationFileName = DestinationFileName & Right(SourceFileName, Len(SourceFileName) - InStrRev(SourceFileName, "\"))	' Add source file name without path
	DestinationFileName = Left(DestinationFileName, Len(DestinationFileName) - 4)		' Remove the .txt file extension
	DestinationFileName = DestinationFileName & ".htc"					' Add the .htc extension

	Err.Clear
	Set DestinationFile = FileSystemObject.OpenTextFile(DestinationFileName, ForWriting, True)
	If Err.Number <> 0 Then
		MsgBox "Unable to create the .htc file: " & DestinationFileName & vbCrLf & Err.Description, vbOKOnly + vbCritical, "HTCConverter Error"
	Else
		' Build the content of the destination .htc file
		DestinationFileContent = FileSignature
		DestinationFileContent = DestinationFileContent & Chr((NumberOfLocationRecords \ 256) And 255) & Chr(NumberOfLocationRecords And 255)
		DestinationFileContent = DestinationFileContent & Chr((SizeOfLocationRecord \ 256) And 255) & Chr(SizeOfLocationRecord And 255)
		For i = 0 To NumberOfLocationRecords - 1
			DestinationFileContent = DestinationFileContent & Chr(ListOfLocationRecords(i, 0)) & Chr(ListOfLocationRecords(i, 1)) & Chr(ListOfLocationRecords(i, 2)) & Chr(ListOfLocationRecords(i, 3)) & Chr((ListOfLocationRecords(i, 4) \ 256) And 255) & Chr(ListOfLocationRecords(i, 4) And 255)
		Next
		DestinationFileContent = DestinationFileContent & Chr((NumberOfHintRecords \ 256) And 255) & Chr(NumberOfHintRecords And 255)
		DestinationFileContent = DestinationFileContent & Chr((SizeOfHintRecord \ 256) And 255) & Chr(SizeOfHintRecord And 255)
		For i = 0 To NumberOfHintRecords - 1
			DestinationFileContent = DestinationFileContent & ListOfHintRecords(i, 0)
			DestinationFileContent = DestinationFileContent & Chr((ListOfHintRecords(i, 1) \ 256) And 255) & Chr(ListOfHintRecords(i, 1) And 255)
			DestinationFileContent = DestinationFileContent & Chr((ListOfHintRecords(i, 2) \ 256) And 255) & Chr(ListOfHintRecords(i, 2) And 255)
		Next
		DestinationFileContent = DestinationFileContent & Chr((NumberOfPages \ 256) And 255) & Chr(NumberOfPages And 255)
		For i = 0 To NumberOfPages - 1
			DestinationFileContent = DestinationFileContent & Chr((ListOfHintContentLengths(i) \ 256) And 255) & Chr(ListOfHintContentLengths(i) And 255)
		Next
		For i = 0 To NumberOfHintRecords - 1
			DestinationFileContent = DestinationFileContent & HintContents(i)
		Next

		' Write the contents of the destination .htc file
		Err.Clear
		DestinationFile.Write(DestinationFileContent)
		If Err.Number <> 0 Then
			MsgBox "Unable to write the .htc file." & vbCrLf & Err.Description, vbOKOnly + vbCritical, "HTCConverter Error"
		Else
			MsgBox "The file " & vbCrLf & vbCrLf & DestinationFileName & vbCrLf & vbCrLf & " was successfully created." & vbCrLf & vbCrLf & _
			"(" & NumberOfLocationRecords & " locations, " & NumberOfHintRecords & " hints, " & NumberOfPages & " pages)", vbOKOnly + vbInformation, "HTCConverter Information"
		End If
		DestinationFile.Close
	End If
End Function

Sub ReadTXT
	Dim SourceFileLine, LineNumber, HintName, HintLocations, HintPages, TotalNumberOfPages, NumberOfHintPages, Location
	LineNumber = 2		' The first line was already read as a file signature ("HTCConverter Hints File")

	' Initialize variables
	FileSignature = Chr(&h00) & Chr(&h02) & Chr(&h00) & Chr(&h0D) & Chr(&h00) & Chr(&h03)
	NumberOfLocationRecords = 0
	SizeOfLocationRecord = 6
	ReDim ListOfLocationRecords(65535, 4)
	NumberOfHintRecords = 0
	SizeOfHintRecord = 26
	ReDim ListOfHintRecords(65536, 2)
	NumberOfPages = 0
	ReDim ListOfHintContentLengths(65535)
	ReDim HintContents(65535)
	For i = 0 To 65535
		ListOfHintContentLengths(i) = 0
	Next
	
	SourceFileLine = SourceFile.ReadLine			' Read the first blank line after the file signature
	While Not SourceFile.AtEndOfStream			' While there are lines to read
		' A new hint declaration starts
		HintName = SourceFile.ReadLine			' Read the hint name
		HintLocations = SourceFile.ReadLine		' Read the hint locations
		HintPages = SourceFile.ReadLine & Chr(0)	' Read the hint contents
		NumberOfHintPages = 1
		SourceFileLine = SourceFile.ReadLine
		While (SourceFileLine <> "") And Not SourceFile.AtEndOfStream
			HintPages = HintPages & SourceFileLine & Chr(0)
			NumberOfHintPages = NumberOfHintPages + 1
			SourceFileLine = SourceFile.ReadLine
		Wend

		HintName = Left(HintName, 21)	' Keep only the first 21 characters
		' Pad with 00 bytes
		For i = 1 To 22 - Len(HintName)
			HintName = HintName & Chr(0)
		Next
		
		' Fill the list of hint records with a new entry
		ListOfHintRecords(NumberOfHintRecords, 0) = HintName
		ListOfHintRecords(NumberOfHintRecords, 1) = NumberOfPages
		ListOfHintRecords(NumberOfHintRecords, 2) = NumberOfHintPages

		' Replace ")(" sequences in the hint locations list by "|"
		HintLocations = Replace(HintLocations, ")(", "|")
		' Remove remaining "(" or ")"
		HintLocations = Replace(HintLocations, "(", "")
		HintLocations = Replace(HintLocations, ")", "")
		' Split the list of hint locations
		HintLocations = Split(HintLocations, "|")

		' Fill the list of location records with new entries
		For i = 0 To UBound(HintLocations)
			Location = Split(HintLocations(i), ",")
			ListOfLocationRecords(NumberOfLocationRecords + i, 0) = Location(1)
			ListOfLocationRecords(NumberOfLocationRecords + i, 1) = Location(2)
			ListOfLocationRecords(NumberOfLocationRecords + i, 2) = Location(0)
			ListOfLocationRecords(NumberOfLocationRecords + i, 3) = 0
			ListOfLocationRecords(NumberOfLocationRecords + i, 4) = NumberOfHintRecords
		Next
		NumberOfLocationRecords = NumberOfLocationRecords + UBound(HintLocations) + 1

		' Fill the hint contents table with the compressed hint content and update the content length table
		HintContents(NumberOfHintRecords) = CompressHint(HintPages)
		ListOfHintContentLengths(NumberOfPages) = Len(HintContents(NumberOfHintRecords))

		' Update counters
		NumberOfPages = NumberOfPages + NumberOfHintPages
		NumberOfHintRecords = NumberOfHintRecords + 1
	Wend
End Sub

Function SaveAsTXT
	Dim LocationRecords(), HintContent

	' Build destination TXT file name with full path
	DestinationFileName = WScript.ScriptFullName						' Get script full name with path
	DestinationFileName = Left(DestinationFileName, InStrRev(DestinationFileName, "\"))	' Remove script file name
	DestinationFileName = DestinationFileName & Right(SourceFileName, Len(SourceFileName) - InStrRev(SourceFileName, "\"))	' Add source file name without path
	DestinationFileName = Left(DestinationFileName, Len(DestinationFileName) - 4)		' Remove the .htc or .hct file extension
	DestinationFileName = DestinationFileName & ".txt"					' Add the .txt extension

	Err.Clear
	Set DestinationFile = FileSystemObject.OpenTextFile(DestinationFileName, ForWriting, True)
	If Err.Number <> 0 Then
		MsgBox "Unable to create the .txt file: " & DestinationFileName & vbCrLf & Err.Description, vbOKOnly + vbCritical, "HTCConverter Error"
	Else
		DestinationFileContent = "HTCConverter Hints File" & vbCrLf & vbCrLf

		' Build the list of location records associated to each hint
		ReDim LocationRecords(NumberOfHintRecords - 1)
		For i = 0 To NumberOfLocationRecords - 1
			LocationRecords(ListOfLocationRecords(i, 4)) = LocationRecords(ListOfLocationRecords(i, 4)) & "(" & ListOfLocationRecords(i, 2) & "," & ListOfLocationRecords(i, 0) & "," & ListOfLocationRecords(i, 1) & ")"
		Next
		
		' Build the content of the destination .txt file
		For i = 0 To NumberOfHintRecords - 1
			DestinationFileContent = DestinationFileContent & Left(ListOfHintRecords(i, 0), InStr(ListOfHintRecords(i, 0), Chr(0)) - 1) & vbCrLf
			DestinationFileContent = DestinationFileContent & LocationRecords(i) & vbCrLf
			HintContent = UncompressHint(HintContents(i))			' Uncompress the hint contents
			DestinationFileContent = DestinationFileContent & Replace(HintContent, Chr(0), vbCrLf) & vbCrLf	' Replace the 00 bytes by new line characters to separate each page
		Next

		' Write the contents of the destination .txt file
		Err.Clear
		DestinationFile.Write(DestinationFileContent)
		If Err.Number <> 0 Then
			MsgBox "Unable to write the .txt file." & vbCrLf & Err.Description, vbOKOnly + vbCritical, "HTCConverter Error"
		Else
			MsgBox "The file " & vbCrLf & vbCrLf & DestinationFileName & vbCrLf & vbCrLf & " was successfully created." & vbCrLf & vbCrLf & _
			"(" & NumberOfLocationRecords & " locations, " & NumberOfHintRecords & " hints, " & NumberOfPages & " pages)", vbOKOnly + vbInformation, "HTCConverter Information"
		End If
		DestinationFile.Close
	End If
End Function

Sub SaveAsTxtRaw
	' Build destination TXT file name with full path
	DestinationFileName = WScript.ScriptFullName	' Get script full name with path
	DestinationFileName = Left(DestinationFileName, InStrRev(DestinationFileName, "\"))	' Remove script file name
	DestinationFileName = DestinationFileName & Right(SourceFileName, Len(SourceFileName) - InStrRev(SourceFileName, "\"))	' Add source file name without path
	DestinationFileName = Left(DestinationFileName, Len(DestinationFileName) - 4)	' Remove the .htc or .hct file extension
	DestinationFileName = DestinationFileName & " RAW.txt"	' Add the .txt extension

	Err.Clear
	Set DestinationFile = FileSystemObject.OpenTextFile(DestinationFileName, ForWriting, True)
	If Err.Number <> 0 Then
		MsgBox "Unable to create the .txt file: " & DestinationFileName & vbCrLf & Err.Description, vbOKOnly + vbCritical, "HTCConverter Error"
	Else
		DestinationFileContent = "HTCConverter Hints File RAW" & vbCrLf & vbCrLf

		DestinationFileContent = DestinationFileContent & "File signature (6 bytes):"
		For i= 1 To Len(FileSignature)
			DestinationFileContent = DestinationFileContent & " " & Hex(Asc(Mid(FileSignature, i, 1)))
		Next
		
		DestinationFileContent = DestinationFileContent & vbCrLf & "Number of location records (2 bytes): " & NumberOfLocationRecords & vbCrLf
		DestinationFileContent = DestinationFileContent & "Size of each location record (2 bytes): " & SizeOfLocationRecord & vbCrLf
		DestinationFileContent = DestinationFileContent & "List of location records (" & NumberOfLocationRecords * SizeOfLocationRecord & " bytes):" & vbCrLf & "X" & vbTab & "Y" & vbTab & "Level" & vbTab & "Unused" & vbTab & "Hint Number" & vbCrLf
		For i = 0 To NumberOfLocationRecords - 1
			DestinationFileContent = DestinationFileContent & ListOfLocationRecords(i, 0) & vbTab & ListOfLocationRecords(i, 1) & vbTab & ListOfLocationRecords(i, 2) & vbTab & ListOfLocationRecords(i, 3) & vbTab & ListOfLocationRecords(i, 4) & vbCrLf
		Next
		
		DestinationFileContent = DestinationFileContent & "Number of hint records (2 bytes): " & NumberOfHintRecords & vbCrLf
		DestinationFileContent = DestinationFileContent & "Size of each hint record (2 bytes): " & SizeOfHintRecord & vbCrLf
		DestinationFileContent = DestinationFileContent & "List of hint records (" & NumberOfHintRecords * SizeOfHintRecord & " bytes): (00 bytes are replaced by ""¤"" characters)" & vbCrLf & "Hint #	Hint name             	Page	Number of Pages" & vbCrLf
		For i = 0 To NumberOfHintRecords - 1
			DestinationFileContent = DestinationFileContent & i & vbTab & Replace(ListOfHintRecords(i, 0), Chr(0), "¤") & vbTab & ListOfHintRecords(i, 1) & vbTab & ListOfHintRecords(i, 2) & vbCrLf
		Next
		
		DestinationFileContent = DestinationFileContent & "Total number of pages for all hints (2 bytes): " & NumberOfPages & vbCrLf
		DestinationFileContent = DestinationFileContent & "List of hint content lengths (" & 2 * NumberOfPages & " bytes): (one line per hint)"
		For i = 0 To NumberOfPages - 1
			If ListOfHintContentLengths(i) <> 0 Then
				DestinationFileContent = DestinationFileContent & vbCrLf & ListOfHintContentLengths(i)
			Else
				DestinationFileContent = DestinationFileContent & vbTab & ListOfHintContentLengths(i)
			End If
			
		Next
		DestinationFileContent = DestinationFileContent & vbCrLf
	
		DestinationFileContent = DestinationFileContent & "List of uncompressed hint contents: (00 bytes are replaced by ""¤"" characters)" & vbCrLf & "Hint #	Hint contents" & vbCrLf
		For i = 0 To NumberOfHintRecords - 1
			DestinationFileContent = DestinationFileContent & i & vbTab & Replace(UncompressHint(HintContents(i)), Chr(0), "¤") & vbCrLf
		Next

		Err.Clear
		DestinationFile.Write(DestinationFileContent)
		If Err.Number <> 0 Then
			MsgBox "Unable to write the .txt file." & vbCrLf & Err.Description, vbOKOnly + vbCritical, "HTCConverter Error"
		Else
			MsgBox "The file " & vbCrLf & vbCrLf & DestinationFileName & vbCrLf & vbCrLf & " was successfully created." & vbCrLf & vbCrLf & _
			"(" & NumberOfLocationRecords & " locations, " & NumberOfHintRecords & " hints, " & NumberOfPages & " pages)", vbOKOnly + vbInformation, "HTCConverter Information"
		End If
		DestinationFile.Close
	End If
End Sub

Function UncompressHint(CompressedHint)
	Dim Dictionary, i, j, LZWString, LZWChar, Codes(1023), NumberOfCodes, BitBuffer, BitsInBuffer, BitsInCode, OldCode, NewCode

	UncompressHint = ""
	If Len(CompressedHint) > 1 Then		' We need at least one 9 bits code, which means at least two bytes
		' First step is to build an array of variable length codes from the input string of 8 bits characters
		BitBuffer = 0			' The BitBuffer is empty
		BitsInBuffer = 0		' So there are no bits stored in the buffer
		BitsInCode = 9			' Codes are 9 bits long at the beginning
		NumberOfCodes = 0		' No input codes have been read yet
		i = 0				' Index of input characters
		While (i < Len(CompressedHint)) Or (BitsInBuffer > BitsInCode)		' While there are input characters to read or output codes to write
			If BitsInBuffer > BitsInCode Then				' If there are enough bits in the buffer to make a code
				Codes(NumberOfCodes) = BitBuffer And (2^BitsInCode - 1)	' Add to the list of codes the code made with the BitsInCode most significant bits in the buffer
				NumberOfCodes = NumberOfCodes + 1			' That is one more output code
				BitBuffer = BitBuffer \ (2^BitsInCode)			' Remove the output bits from the buffer by shifting the buffer to the right
				BitsInBuffer = BitsInBuffer - BitsInCode		' The number of bits in the buffer is decreased
				If NumberOfCodes + 256 = 2^BitsInCode Then		' If there are not anymore enough bits in a code to store the code's value
					BitsInCode = BitsInCode + 1			' Add a bit to the code length
				End If
			Else
				BitBuffer = BitBuffer + (Asc(Mid(CompressedHint, i + 1, 1)) * 2^BitsInBuffer)	' Add the next character to the left of the BitBuffer (hence the shift to the left)
				BitsInBuffer = BitsInBuffer + 8				' 8 bits were added to the buffer
				i = i + 1						' Go to the next input character
			End If
		Wend
		If BitsInBuffer = BitsInCode Then				' If the buffer contains just enough bits for a code
			Codes(NumberOfCodes) = BitBuffer And (2^BitsInCode - 1)	' Output the last code
			NumberOfCodes = NumberOfCodes + 1			' That is one more output code
		End If

		' Create and populate the dictionary for the LZW algorithm
		Set Dictionary = CreateObject("Scripting.Dictionary")
		For i = 0 To 255
			Dictionary.Add Dictionary.Count, Chr(i)
		Next
		Dictionary.Add 256, "Unused code"

		' Now that the Codes() array is filled with all the variable length codes, it is time to perform the LZW uncompression
		OldCode = Codes(0)						' Get the first code
		UncompressHint = Dictionary.Item(OldCode)			' Output the string (which is a character) associated with the first code
		LZWChar = Dictionary.Item(OldCode)				' Get the string associate with the first code
		For i = 1 To NumberOfCodes - 1					' For each code in the Codes() array
			If Codes(i) <> 256 Then					' If the code is not the special value 256
				NewCode = Codes(i)				' Get the current code
				If Dictionary.Exists(NewCode) Then		' If the current code is already in the dictionary
					LZWString = Dictionary.Item(NewCode)	' Get the string associated with that current code
				Else
					LZWString = Dictionary.Item(OldCode)	' Get the string associated with the previously read code
					LZWString = LZWString & LZWChar		' Add the latest input character read to the string
				End If
				UncompressHint = UncompressHint + LZWString	' Output the string
				LZWChar = Left(LZWString, 1)			' Get the first character of the string
				Dictionary.Add Dictionary.Count, Dictionary.Item(OldCode) & LZWChar	' Add the new string to the dictionary
				OldCode = NewCode				' Go on to next code
			Else
				MsgBox "Code 256 found, but the flush feature is not implemented!", vbOKOnly + vbExclamation, "Error"
			End If
		Next
	End If
End Function

Function CompressHint(UncompressedHint)
	Dim Dictionary, i, j, LZWString, LZWChar, Codes(1023), NumberOfCodes, BitBuffer, BitsInBuffer, BitsInCode

	' Create and populate the dictionary for the LZW algorithm
	Set Dictionary = CreateObject("Scripting.Dictionary")
	For i = 0 To 255
		Dictionary.Add Chr(i), Dictionary.Count
	Next
	Dictionary.Add "Unused code", 256
	NumberOfCodes = 0

	' Perform the LZW compression. The result is a list of codes stored in the Codes() array
	LZWString = Left(UncompressedHint, 1)					' Get the first input character
	For i = 2 To Len(UncompressedHint)					' For each remaining input character
		LZWChar = Mid(UncompressedHint, i, 1)				' Get the current character
		If Dictionary.Exists(LZWString & LZWChar) Then			' If LZWString & LZWChar is already in the dictionary
			LZWString = LZWString & LZWChar				' Add LZWChar at the end of LZWString
		Else
			Codes(NumberOfCodes) = Dictionary.Item(LZWString)	' Output the code for the longest already known string
			NumberOfCodes = NumberOfCodes + 1			' That is one more output code
			Dictionary.Add LZWString & LZWChar, Dictionary.Count	' Add the newly formed string to the dictionary
			LZWString = LZWChar					' Start over with a new string
		End If
	Next
	Codes(NumberOfCodes) = Dictionary.Item(LZWString)			' Output the code for the latest input string found
	NumberOfCodes = NumberOfCodes + 1					' That is one more output code

	' Build the output data (bytes, 8 bits) from the array of input codes (variable length starting at 9 bits)
	BitBuffer = 0								' The BitBuffer is empty,
	BitsInBuffer = 0							' So there are no bits stored in the buffer
	BitsInCode = 9								' Codes are 9 bits long at the beginning
	CompressHint = ""							' The compressed output is empty
	i = 0									' Code index
	While (i < NumberOfCodes) Or (BitsInBuffer > 7)				' While there are input codes to read or output bytes to write
		If BitsInBuffer > 7 Then					' If there are enough bits in the buffer to make a byte
			CompressHint = CompressHint & Chr(BitBuffer And 255)	' Output the byte made with the 8 least significant bits
			BitBuffer = BitBuffer \ 256				' Shift the BitBuffer to the right to remove the output byte
			BitsInBuffer = BitsInBuffer - 8				' 8 bits were removed from the buffer
		Else
			BitBuffer = BitBuffer + (Codes(i) * 2^BitsInBuffer)	' Add the next code to the left of the BitBuffer (hence a shift to the left)
			If i = 2^(BitsInCode - 1) Then				' If there are not anymore enough bits in a code to store the code's value
				BitsInCode = BitsInCode + 1			' Add a bit to the code length
			End If
			BitsInBuffer = BitsInBuffer + BitsInCode		' Add the number of bits in the code just read to the number of bits in the buffer
			i = i + 1						' Go to the next code
		End If
	Wend
	If BitsInBuffer > 0 Then						' If the buffer is not empty (and contains less than 8 bits)
		CompressHint = CompressHint & Chr(BitBuffer And 255)		' Output the last character
	End If
End Function
