Option Explicit

Const ForReading = 1, ForWriting = 2, ForAppending = 8
Const LITTLE_ENDIAN = 0, BIG_ENDIAN = 1

Dim objDataFile
Dim fItem, objDumpFile
Dim Endian, DataFileName
Dim j, k
Dim strCommonReport

Dim arrStrings3(448)
Dim arrStrings4(39)
Dim arrStrings5(100)
Dim arrStrings6(24)
Dim arrStrings7(14)
Dim arrStrings, arrCurrentStringArray
arrStrings = Array(arrStrings3, arrStrings4, arrStrings5, arrStrings6, arrStrings7)

Dim objCharactersDictionaryHTML, objCharactersDictionary
Set objCharactersDictionaryHTML = CreateObject("Scripting.Dictionary")
Set objCharactersDictionary = CreateObject("Scripting.Dictionary")
Dim arrFont0UTF8Chars(290)
Dim arrFont1UTF8Chars(249)
Dim arrFont2UTF8Chars(709)
Dim arrFont256S2DUTF8Chars(241)

Dim arrSPLLSpellDescriptors(24, 27)
Dim arrPLRDChampionDescriptors(19, 40)
Dim arrTABLData(215)

Dim objStructure1A, objStructure1B, objStructure1C, objStructure1E, objStructure1Fa, objStructure1Fb
Dim objStructure1Fc, objStructure1Fd, objStructure1Fe, objStructure1Ff, objStructure1G1, objStructure1G2
Set objStructure1A = New StringBuilder
Set objStructure1B = New StringBuilder
Set objStructure1C = New StringBuilder
Set objStructure1E = New StringBuilder
Set objStructure1Fa = New StringBuilder
Set objStructure1Fb = New StringBuilder
Set objStructure1Fc = New StringBuilder
Set objStructure1Fd = New StringBuilder
Set objStructure1Fe = New StringBuilder
Set objStructure1Ff = New StringBuilder
Set objStructure1G1 = New StringBuilder
Set objStructure1G2 = New StringBuilder
Dim objStructure2
Set objStructure2 = New StringBuilder
Dim objStructure3a
Dim objStructure3b
Dim objStructure3c
Set objStructure3a = New StringBuilder
Set objStructure3b = New StringBuilder
Set objStructure3c = New StringBuilder

Endian = BIG_ENDIAN

Dim strScriptPath
strScriptPath = Replace(WScript.ScriptFullName, WScript.ScriptName, "")

Dim objFileSystemObject
Set objFileSystemObject = CreateObject("Scripting.FileSystemObject")

BuildCharactersDictionary

Dim objScriptArguments
Set objScriptArguments = WScript.Arguments
If objScriptArguments.Count = 0 Then
	MsgBox 	"Decodes Dungeon Master Nexus data files." & vbCrLf & vbCrLf & _
		"Drag and drop the folder containing the Dungeon Master Nexus files on this script to start decoding.", vbOKOnly + vbInformation, "Help"
Else
  If objScriptArguments.Count <= 1 Then
  	MsgBox "Please click OK and wait while the data files are decoded..." & vbCrLf & _
  	       "This may take several minutes.", vbOKOnly + vbInformation, "Help"
  End If
  
  Dim strNexusFolder
	strNexusFolder = objScriptArguments(0)

  Dim index, strFileName, dtmBefore
  dtmBefore = Now
  
  For index = 0 To 15
    strFileName = "SMAP" & Pad(CStr(index), 2, "0") & ".BIN"
    If objFileSystemObject.FileExists(strNexusFolder & "\" & strFileName) Then
      DecodeSMAPxxBIN strNexusFolder, strFileName, strScriptPath
    Else
      MsgBox strFileName & " not found in specified folder", vbOKOnly + vbExclamation, "Warning"
    End If
  Next

  For index = 0 To 15
    strFileName = "SNDLEV" & Pad(CStr(index), 2, "0") & ".MAP"
    If objFileSystemObject.FileExists(strNexusFolder & "\" & strFileName) And _
       objFileSystemObject.FileExists(strNexusFolder & "\" & Replace(UCase(strFileName), ".MAP", ".SAL")) Then
      DecodeSNDLEVxxMAP strNexusFolder, strFileName, strScriptPath
    Else
      MsgBox strFileName & " or " & Replace(UCase(strFileName), ".MAP", ".SAL") & " not found in specified folder", vbOKOnly + vbExclamation, "Warning"
    End If
  Next

  If objFileSystemObject.FileExists(strNexusFolder & "\GAMEOVER.BIN") Then
    DecodeRES strNexusFolder, "GAMEOVER.BIN", strScriptPath
  Else
    MsgBox "GAMEOVER.BIN not found in specified folder", vbOKOnly + vbExclamation, "Warning"
  End If

  If objFileSystemObject.FileExists(strNexusFolder & "\POTEFT.BIN") Then
    DecodeRES strNexusFolder, "POTEFT.BIN", strScriptPath
  Else
    MsgBox "POTEFT.BIN not found in specified folder", vbOKOnly + vbExclamation, "Warning"
  End If

  If objFileSystemObject.FileExists(strNexusFolder & "\RHIFIX.BIN") Then
    DecodeRES strNexusFolder, "RHIFIX.BIN", strScriptPath
  Else
    MsgBox "RHIFIX.BIN not found in specified folder", vbOKOnly + vbExclamation, "Warning"
  End If

  If objFileSystemObject.FileExists(strNexusFolder & "\RLOWFIX.BIN") Then  ' Note decoding RHIFIX.BIN must occur before decoding of RLOWFIX.BIN otherwise spell descriptors will not be decoded
    DecodeRES strNexusFolder, "RLOWFIX.BIN", strScriptPath
  Else
    MsgBox "RLOWFIX.BIN not found in specified folder", vbOKOnly + vbExclamation, "Warning"
  End If

  If objFileSystemObject.FileExists(strNexusFolder & "\TITLE.BIN") And _
     objFileSystemObject.FileExists(strNexusFolder & "\TITLE.CG") Then
    DecodeRES strNexusFolder, "TITLE.BIN", strScriptPath
  Else
    MsgBox "TITLE.BIN or TITLE.CG not found in specified folder", vbOKOnly + vbExclamation, "Warning"
  End If

  If objFileSystemObject.FileExists(strNexusFolder & "\WARNING.BIN") Then
    DecodeRES strNexusFolder, "WARNING.BIN", strScriptPath
  Else
    MsgBox "WARNING.BIN not found in specified folder", vbOKOnly + vbExclamation, "Warning"
  End If

  If objFileSystemObject.FileExists(strNexusFolder & "\DEATH.BIN") Then
    DecodeRawPPpp strNexusFolder, "DEATH.BIN", strScriptPath
  Else
    MsgBox "DEATH.BIN not found in specified folder", vbOKOnly + vbExclamation, "Warning"
  End If

  If objFileSystemObject.FileExists(strNexusFolder & "\LOGOBG.DG2") Then
    DecodeRawPPpp strNexusFolder, "LOGOBG.DG2", strScriptPath
  Else
    MsgBox "LOGOBG.DG2 not found in specified folder", vbOKOnly + vbExclamation, "Warning"
  End If

  If objFileSystemObject.FileExists(strNexusFolder & "\STONE.BIN") Then
    DecodeRawPPpp strNexusFolder, "STONE.BIN", strScriptPath
  Else
    MsgBox "STONE.BIN not found in specified folder", vbOKOnly + vbExclamation, "Warning"
  End If

  If objFileSystemObject.FileExists(strNexusFolder & "\FONT256.S2D") Then
    DecodeFONT256S2D strNexusFolder, "FONT256.S2D", strScriptPath
  Else
    MsgBox "FONT256.S2D not found in specified folder", vbOKOnly + vbExclamation, "Warning"
  End If

  If objFileSystemObject.FileExists(strNexusFolder & "\NBG3.BIN") Then
    DecodeNBG3BIN strNexusFolder, "NBG3.BIN", strScriptPath
  Else
    MsgBox "NBG3.BIN not found in specified folder", vbOKOnly + vbExclamation, "Warning"
  End If

  If objFileSystemObject.FileExists(strNexusFolder & "\MENU.BPK") Then
    DecodeMENUBPK strNexusFolder, "MENU.BPK", strScriptPath
  Else
    MsgBox "MENU.BPK not found in specified folder", vbOKOnly + vbExclamation, "Warning"
  End If

  If objFileSystemObject.FileExists(strNexusFolder & "\ITEM.IBS") Then
    DecodeITEMIBS strNexusFolder, "ITEM.IBS", strScriptPath
  Else
    MsgBox "ITEM.IBS not found in specified folder", vbOKOnly + vbExclamation, "Warning"
  End If

  If objFileSystemObject.FileExists(strNexusFolder & "\STABG.BIN") Then
    DecodeSTABGBIN strNexusFolder, "STABG.BIN", strScriptPath
  Else
    MsgBox "STABG.BIN not found in specified folder", vbOKOnly + vbExclamation, "Warning"
  End If

  If objFileSystemObject.FileExists(strNexusFolder & "\FACE.BIN") Then
    DecodeFACEBIN strNexusFolder, "FACE.BIN", strScriptPath
  Else
    MsgBox "FACE.BIN not found in specified folder", vbOKOnly + vbExclamation, "Warning"
  End If

  If objFileSystemObject.FileExists(strNexusFolder & "\DM.BIN") Then
    DecodeDMBIN strNexusFolder, "DM.BIN", strScriptPath
  Else
    MsgBox "DM.BIN not found in specified folder", vbOKOnly + vbExclamation, "Warning"
  End If


  Dim arrMNSFiles
  arrMNSFiles = Array("ANTMAN.MNS", _
                      "BIGWORM.MNS", _
                      "BORKETH.MNS", _
                      "CHAOS.MNS", _
                      "D_GOLD.MNS", _
                      "D_RED.MNS", _
                      "D_SILVER.MNS", _
                      "DRA_ZOM.MNS", _
                      "GHOST.MNS", _
                      "GIGGLER.MNS", _
                      "GOLEM.MNS", _
                      "GRN_DRA.MNS", _
                      "H_HOUND.MNS", _
                      "LAS_MON.MNS", _
                      "LORD_RIB.MNS", _
                      "MINI_DRA.MNS", _
                      "MUMMY.MNS", _
                      "OBAKE.MNS", _
                      "OITU.MNS", _
                      "RAT.MNS", _
                      "RED_DRA.MNS", _
                      "ROCKPILE.MNS", _
                      "S_SHIELD.MNS", _
                      "S_SWORD.MNS", _
                      "SCORPION.MNS", _
                      "SCREAMER.MNS", _
                      "SN_FLOOR.MNS", _
                      "SN_WALL.MNS", _
                      "VEXIRK.MNS", _
                      "WORM.MNS")
  For index = 0 To UBound(arrMNSFiles)
    If objFileSystemObject.FileExists(strNexusFolder & "\" & arrMNSFiles(index)) Then
      DecodeMNS strNexusFolder, arrMNSFiles(index), strScriptPath
    Else
      MsgBox arrMNSFiles(index) & " not found in specified folder", vbOKOnly + vbExclamation, "Warning"
    End If
  Next

  objStructure1A.Append "Structure1A" & vbCrLf
  objStructure1B.Append "Structure1B" & vbCrLf
  objStructure1C.Append "Structure1C" & vbCrLf
  objStructure1E.Append "Structure1E" & vbCrLf
  objStructure1Fa.Append "Structure1Fa" & vbCrLf
  objStructure1Fb.Append "Structure1Fb" & vbCrLf
  objStructure1Fc.Append "Structure1Fc" & vbCrLf
  objStructure1Fd.Append "Structure1Fd" & vbCrLf
  objStructure1Fe.Append "Structure1Fe" & vbCrLf
  objStructure1Ff.Append "Structure1Ff" & vbCrLf
  objStructure1G1.Append "Structure1G Part1" & vbCrLf
  objStructure1G2.Append "Structure1G Part2" & vbCrLf
  objStructure2.Append "Structure2" & vbCrLf
  objStructure3a.Append "Structure3a" & vbCrLf
  objStructure3b.Append "Structure3b" & vbCrLf
  objStructure3c.Append "Structure3c" & vbCrLf

  For index = 0 To 15
'  For index = 1 To 1
    strFileName = "LEV" & Pad(CStr(index), 2, "0") & ".DGN"
    If objFileSystemObject.FileExists(strNexusFolder & "\" & strFileName) Then
      DecodeDGN strNexusFolder, strFileName, strScriptPath
    Else
      MsgBox strFileName & " not found in specified folder", vbOKOnly + vbExclamation, "Warning"
    End If
  Next

  Dim objDGNReports
  Set objDGNReports = objFileSystemObject.OpenTextFile(strScriptPath & "\DGNReports.txt", ForWriting, True)
  objDGNReports.WriteLine objStructure1A.ToString & _
                          objStructure1B.ToString & _
                          objStructure1C.ToString & _
                          objStructure1E.ToString & _
                          objStructure1Fa.ToString & _
                          objStructure1Fb.ToString & _
                          objStructure1Fc.ToString & _
                          objStructure1Fd.ToString & _
                          objStructure1Fe.ToString & _
                          objStructure1Ff.ToString & _
                          objStructure1G1.ToString & _
                          objStructure1G2.ToString & _
                          objStructure2.ToString & _
                          objStructure3a.ToString & _
                          objStructure3b.ToString & _
                          objStructure3c.ToString
  objDGNReports.Close

  If objScriptArguments.Count <= 1 Then
  	MsgBox "Data file decoding done." & vbCrLf & vbCrLf & _
  	       "Started at " & dtmBefore & vbCrLf & _
  	       "Completed at " & Now, vbOKOnly + vbInformation, "Help"
  End If
End If

Sub DecodeDGN(pstrFolder, pstrFileName, pstrOutputFolder)
  Dim index, j, tmp

	Set objDataFile = objFileSystemObject.OpenTextFile(pstrFolder & "\" & pstrFileName, ForReading, False)

	If Not objFileSystemObject.FolderExists(pstrOutputFolder & pstrFileName & " - Decoded") Then
		objFileSystemObject.CreateFolder(pstrOutputFolder & pstrFileName & " - Decoded")
	End If

	Set objDumpFile = objFileSystemObject.OpenTextFile(pstrOutputFolder & pstrFileName & " - Decoded\zzzz Dump.txt", ForWriting, True)

  objDumpFile.WriteLine "**** Block: Header"
  objDumpFile.WriteLine "Byte 0: " & Pad(Hex(ReadByteOfData), 2, "0")
  objDumpFile.WriteLine "Dungeon level number: " & Pad(Hex(ReadByteOfData), 2, "0")
  objDumpFile.Write "Bytes 2-10:"
  For index = 0 To 9
    objDumpFile.Write " " & Pad(Hex(ReadByteOfData), 2, "0")
  Next
  objDumpFile.WriteLine

  Dim intStructure1Offset, intStructure1Size, intStructure1UsefulData
  Dim intStructure2Offset, intStructure2Size, intStructure2UsefulData
  Dim intStructure3Offset, intStructure3Size, intStructure3UsefulData
  Dim arrStructure1(), arrStructure3(), intCursorPosition
  intStructure1Offset = ReadWordOfData  * 2048
  intStructure1Size =   ReadWordOfData * 2048
  intStructure1UsefulData = ReadDWordOfData
  intStructure2Offset = ReadWordOfData * 2048
  intStructure2Size =   ReadWordOfData * 2048
  intStructure2UsefulData = ReadDWordOfData
  intStructure3Offset = ReadWordOfData * 2048
  intStructure3Size =   ReadWordOfData * 2048
  intStructure3UsefulData = ReadDWordOfData

  ReDim arrStructure1(intStructure1Size - 1)
  ReDim arrStructure3(intStructure3Size - 1)

  ' Padding until end of next 2KB block
  objDataFile.Read(2012)

  Set fItem = objFileSystemObject.OpenTextFile(pstrOutputFolder & pstrFileName & " - Decoded\Structure1.bin", ForWriting, True)
  For index = 0 To UBound(arrStructure1)
    arrStructure1(index) = ReadByteOfData
    fItem.Write Chr(arrStructure1(index))
  Next
  fItem.Close

  objDumpFile.WriteLine vbCrLf & "**** Block: Structure1"
  objDumpFile.Write "Bytes 0-7:"
  For index = 0 To 7
    objDumpFile.Write " " & Pad(Hex(arrStructure1(index)), 2, "0")
  Next
  intCursorPosition = 8
  objDumpFile.WriteLine

  strCommonReport = strCommonReport & vbCrLf
  Dim arrStructure1Offsets(11)
  For index = 0 To 11
    arrStructure1Offsets(index) = (arrStructure1(4 * index + 8) * 2^24) + (arrStructure1(4 * index + 9) * 2^16) + (arrStructure1(4 * index + 10) * 2^8) + arrStructure1(4 * index + 11)
    objDumpFile.WriteLine " " & Pad(Hex(arrStructure1Offsets(index)), 8, "0")
    strCommonReport = strCommonReport & vbTab & Pad(Hex(arrStructure1Offsets(index)), 8, "0")
  Next
'  objDumpFile.WriteLine strCommonReport

  'tmp = (arrStructure1(12) * 256 + arrStructure1(13)) * 256 + arrStructure1(14) * 256 + arrStructure1(15)
  objDumpFile.WriteLine "Structure1A: 24 bytes entries. Number of entries from header: " & arrStructure1Offsets(1)
  For index = 0 To arrStructure1Offsets(1) - 1
    objStructure1A.Append pstrFileName & vbTab & index
    For j = 0 To 23
      objDumpFile.Write Pad(Hex(arrStructure1(24 * index + j + 56)), 2, "0") & " "
      objStructure1A.Append vbTab & Pad(Hex(arrStructure1(24 * index + j + 56)), 2, "0")
    Next
    objStructure1A.Append vbCrLf
    objDumpFile.WriteLine
  Next

  objDumpFile.WriteLine "Structure1B: 64x64 grid of 8 bytes entries"
  Dim intStructure1BOffset, objImageStructure1B, objFakePalette, intX, intY, blnEmptyTile
  intStructure1BOffset = (256 * arrStructure1(20) + arrStructure1(21)) * 65536 + (256 * arrStructure1(22) + arrStructure1(23))
  Set objFakePalette = New Palette
  objFakePalette.SetProperties 256, 8
  Set objImageStructure1B = New Image
'  objImageStructure1B.SetProperties 512, 64, 8
  objImageStructure1B.SetProperties 64, 64, 8
  For intY = 0 To 63
    For intX = 0 To 63
      objStructure1B.Append pstrFileName & vbTab & intX & vbTab & intY
      blnEmptyTile = True
      For index = 0 To 7
        'objImageStructure1B.SetPixel 8 * intX + index, intY, arrStructure1(intStructure1BOffset + 512 * intY + 8 * intX + index)
        objDumpFile.Write Pad(Hex(arrStructure1(intStructure1BOffset + 512 * intY + 8 * intX + index)), 2, "0") & " "
        objStructure1B.Append vbTab & Pad(Hex(arrStructure1(intStructure1BOffset + 512 * intY + 8 * intX + index)), 2, "0")
        If arrStructure1(intStructure1BOffset + 512 * intY + 8 * intX + index) <> 0 Then blnEmptyTile = False
      Next
      If blnEmptyTile Then
        objImageStructure1B.SetPixel intX, intY, 0
      Else
        objImageStructure1B.SetPixel intX, intY, 255
      End If
      objStructure1B.Append vbCrLf
      objDumpFile.Write vbTab
    Next
    objDumpFile.WriteLine
  Next

  ' SHOW EDGES ONLY  (8 bytes ending with xFFFh)
  'objImageStructure1B.SetProperties 64, 64, 8
  'For intY = 0 To 63
  '  For intX = 0 To 63
  '      If ((arrStructure1(intStructure1BOffset + 512 * intY + 8 * intX + 6) And &H0F) = &H0F) And _
  '          (arrStructure1(intStructure1BOffset + 512 * intY + 8 * intX + 7) = &HFF) Then
  '        objImageStructure1B.SetPixel intX, intY, 255
  '      Else
  '        objImageStructure1B.SetPixel intX, intY, 0
  '      End If
  '    objDumpFile.Write vbTab
  '  Next
  '  objDumpFile.WriteLine
  'Next

  objImageStructure1B.ExportToBMP pstrOutputFolder & pstrFileName & " - Decoded\Structure1B.bmp", objFakePalette

  objDumpFile.WriteLine "Structure1C: dwords. Number of dwords + 1 (1 byte): " & arrStructure1(arrStructure1Offsets(4))
  objDumpFile.WriteLine "Next 3 bytes: " & arrStructure1(arrStructure1Offsets(4) + 1) & " " & _
                                           arrStructure1(arrStructure1Offsets(4) + 2) & " " & _
                                           arrStructure1(arrStructure1Offsets(4) + 3)
  For index = 0 To arrStructure1(arrStructure1Offsets(4)) - 2
    objStructure1C.Append pstrFileName & vbTab & index
    For j = 0 To 3
      objDumpFile.Write Pad(Hex(arrStructure1(arrStructure1Offsets(4) + 4 + 4 * index + j)), 2, "0") & " "
      objStructure1C.Append vbTab & Pad(Hex(arrStructure1(arrStructure1Offsets(4) + 4 + 4 * index + j)), 2, "0")
    Next
    objStructure1C.Append vbCrLf
    objDumpFile.WriteLine
  Next

  objDumpFile.WriteLine "Structure1D: 128 bytes"
  For index = 0 To 127
    objDumpFile.Write Pad(Hex(arrStructure1(arrStructure1Offsets(7) + index)), 2, "0") & " "
    'If arrStructure1(arrStructure1Offsets(7) + index) <> 0 Then MsgBox "Structure1D byte <> 0 in " & pstrFileName
  Next
  objDumpFile.WriteLine

  objDumpFile.WriteLine "Structure1E: 16 bytes entries"
  Dim blnStructure1EComplete
  blnStructure1EComplete = False
  index = 0
  While Not blnStructure1EComplete
    objStructure1E.Append pstrFileName & vbTab & index
    For j = 0 To 15
      objDumpFile.Write Pad(Hex(arrStructure1(arrStructure1Offsets(10) + 16 * index + j)), 2, "0") & " "
      objStructure1E.Append vbTab & Pad(Hex(arrStructure1(arrStructure1Offsets(10) + 16 * index + j)), 2, "0")
    Next
    objStructure1E.Append vbCrLf
    objDumpFile.WriteLine
    If arrStructure1(arrStructure1Offsets(10) + 16 * index) = &HFF Then
      blnStructure1EComplete = True
    End If
    index = index + 1
  Wend

  objDumpFile.WriteLine "Structure1F"
  Dim intS1FUnknown1
  Dim intS1FUnknown2
  Dim intNumberOfEntriesStructure1Fa
  Dim intNumberOfEntriesStructure1Fb
  Dim intNumberOfEntriesStructure1Fc
  Dim intNumberOfEntriesStructure1Fd
  Dim intNumberOfEntriesStructure1Fe
  Dim intNumberOfEntriesStructure1Ff

  Dim intOffsetStructure1Fa
  Dim intOffsetStructure1Fb
  Dim intOffsetStructure1Fc
  Dim intOffsetStructure1Fd
  Dim intOffsetStructure1Fe
  Dim intOffsetStructure1Ff

  intS1FUnknown1 = arrStructure1(arrStructure1Offsets(11)) * 256 + arrStructure1(arrStructure1Offsets(11) + 1)
  intS1FUnknown2 = arrStructure1(arrStructure1Offsets(11) + 2) * 256 + arrStructure1(arrStructure1Offsets(11) + 3)
  intNumberOfEntriesStructure1Fa = arrStructure1(arrStructure1Offsets(11) + 4) * 256 + arrStructure1(arrStructure1Offsets(11) + 5)
  intNumberOfEntriesStructure1Fb = arrStructure1(arrStructure1Offsets(11) + 6) * 256 + arrStructure1(arrStructure1Offsets(11) + 7)
  intNumberOfEntriesStructure1Fc = arrStructure1(arrStructure1Offsets(11) + 8) * 256 + arrStructure1(arrStructure1Offsets(11) + 9)
  intNumberOfEntriesStructure1Fd = arrStructure1(arrStructure1Offsets(11) + 10) * 256 + arrStructure1(arrStructure1Offsets(11) + 11)
  intNumberOfEntriesStructure1Fe = arrStructure1(arrStructure1Offsets(11) + 12) * 256 + arrStructure1(arrStructure1Offsets(11) + 13)
  intNumberOfEntriesStructure1Ff = arrStructure1(arrStructure1Offsets(11) + 14) * 256 + arrStructure1(arrStructure1Offsets(11) + 15)
  intOffsetStructure1Fa = arrStructure1Offsets(11) + 16
  intOffsetStructure1Fb = intOffsetStructure1Fa + 8 * intNumberOfEntriesStructure1Fa
  intOffsetStructure1Fc = intOffsetStructure1Fb + 12 * intNumberOfEntriesStructure1Fb
  intOffsetStructure1Fd = intOffsetStructure1Fc + 16 * intNumberOfEntriesStructure1Fc
  intOffsetStructure1Fe = intOffsetStructure1Fd + 12 * intNumberOfEntriesStructure1Fd
  intOffsetStructure1Ff = intOffsetStructure1Fe + 12 * intNumberOfEntriesStructure1Fe

  objDumpFile.WriteLine "intS1FUnknown1: " & intS1FUnknown1
  objDumpFile.WriteLine "intS1FUnknown2: " & intS1FUnknown2
  objDumpFile.WriteLine "intNumberOfEntriesStructure1Fa: " & intNumberOfEntriesStructure1Fa
  objDumpFile.WriteLine "intNumberOfEntriesStructure1Fb: " & intNumberOfEntriesStructure1Fb
  objDumpFile.WriteLine "intNumberOfEntriesStructure1Fc: " & intNumberOfEntriesStructure1Fc
  objDumpFile.WriteLine "intNumberOfEntriesStructure1Fd: " & intNumberOfEntriesStructure1Fd
  objDumpFile.WriteLine "intNumberOfEntriesStructure1Fe: " & intNumberOfEntriesStructure1Fe
  objDumpFile.WriteLine "intNumberOfEntriesStructure1Ff: " & intNumberOfEntriesStructure1Ff
  objDumpFile.WriteLine "intOffsetStructure1Fa: " & intOffsetStructure1Fa
  objDumpFile.WriteLine "intOffsetStructure1Fb: " & intOffsetStructure1Fb
  objDumpFile.WriteLine "intOffsetStructure1Fc: " & intOffsetStructure1Fc
  objDumpFile.WriteLine "intOffsetStructure1Fd: " & intOffsetStructure1Fd
  objDumpFile.WriteLine "intOffsetStructure1Fe: " & intOffsetStructure1Fe
  objDumpFile.WriteLine "intOffsetStructure1Ff: " & intOffsetStructure1Ff

  objDumpFile.WriteLine "Structure1Fa"
  objDumpFile.WriteLine "Always10h" & vbTab & "XCoordinate" & vbTab & "YCoordinate" & vbTab & "TileLocation" & vbTab & "ItemNumber" & vbTab & "ItemAttribute1" & vbTab & "Always00h" & vbTab & "ItemAttribute2"
  For index = 0 To intNumberOfEntriesStructure1Fa - 1
    objStructure1Fa.Append pstrFileName & vbTab & index & vbTab
    'For j = 0 To 7
      objDumpFile.Write arrStructure1(intOffsetStructure1Fa + 8 * index + 0) & vbTab
      objDumpFile.Write arrStructure1(intOffsetStructure1Fa + 8 * index + 1) & vbTab
      objDumpFile.Write arrStructure1(intOffsetStructure1Fa + 8 * index + 2) & vbTab
      objDumpFile.Write arrStructure1(intOffsetStructure1Fa + 8 * index + 3) & vbTab
      objDumpFile.Write arrStructure1(intOffsetStructure1Fa + 8 * index + 4) & vbTab
      objDumpFile.Write arrStructure1(intOffsetStructure1Fa + 8 * index + 5) & vbTab
      objDumpFile.Write arrStructure1(intOffsetStructure1Fa + 8 * index + 6) & vbTab
      objDumpFile.Write arrStructure1(intOffsetStructure1Fa + 8 * index + 7)

      objStructure1Fa.Append arrStructure1(intOffsetStructure1Fa + 8 * index + 0) & vbTab
      objStructure1Fa.Append arrStructure1(intOffsetStructure1Fa + 8 * index + 1) & vbTab
      objStructure1Fa.Append arrStructure1(intOffsetStructure1Fa + 8 * index + 2) & vbTab
      objStructure1Fa.Append arrStructure1(intOffsetStructure1Fa + 8 * index + 3) & vbTab
      objStructure1Fa.Append arrStructure1(intOffsetStructure1Fa + 8 * index + 4) & vbTab
      objStructure1Fa.Append arrStructure1(intOffsetStructure1Fa + 8 * index + 5) & vbTab
      objStructure1Fa.Append arrStructure1(intOffsetStructure1Fa + 8 * index + 6) & vbTab
      objStructure1Fa.Append arrStructure1(intOffsetStructure1Fa + 8 * index + 7)
      

      'If arrStructure1(intOffsetStructure1Fa + 8 * index + 0) <> 16 Then MsgBox "Not 10 in Structure1Fa"
      'If arrStructure1(intOffsetStructure1Fa + 8 * index + 6) <> 0 Then MsgBox "Not 0 in Structure1Fa"
      
    '  objDumpFile.Write Pad(Hex(arrStructure1(intOffsetStructure1Fa + 8 * index + j)), 2, "0") & vbTab
    'Next
    objStructure1Fa.Append vbCrLf
    objDumpFile.WriteLine
  Next

  objDumpFile.WriteLine "Structure1Fb"
  For index = 0 To intNumberOfEntriesStructure1Fb - 1
    objStructure1Fb.Append pstrFileName & vbTab & index
    For j = 0 To 11
      objDumpFile.Write Pad(Hex(arrStructure1(intOffsetStructure1Fb + 12 * index + j)), 2, "0") & " "
      objStructure1Fb.Append vbTab & Pad(Hex(arrStructure1(intOffsetStructure1Fb + 12 * index + j)), 2, "0")
    Next
    objStructure1Fb.Append vbCrLf
    objDumpFile.WriteLine
  Next

  objDumpFile.WriteLine "Structure1Fc"
  For index = 0 To intNumberOfEntriesStructure1Fc - 1
    objStructure1Fc.Append pstrFileName & vbTab & index
    For j = 0 To 15
      objDumpFile.Write Pad(Hex(arrStructure1(intOffsetStructure1Fc + 16 * index + j)), 2, "0") & " "
      objStructure1Fc.Append vbTab & Pad(Hex(arrStructure1(intOffsetStructure1Fc + 16 * index + j)), 2, "0")
    Next
    objStructure1Fc.Append vbCrLf
    objDumpFile.WriteLine
  Next

  objDumpFile.WriteLine "Structure1Fd"
  For index = 0 To intNumberOfEntriesStructure1Fd - 1
    objStructure1Fd.Append pstrFileName & vbTab & index
    For j = 0 To 11
      objDumpFile.Write Pad(Hex(arrStructure1(intOffsetStructure1Fd + 12 * index + j)), 2, "0") & " "
      objStructure1Fd.Append vbTab & Pad(Hex(arrStructure1(intOffsetStructure1Fd + 12 * index + j)), 2, "0")
    Next
    objStructure1Fd.Append vbCrLf
    objDumpFile.WriteLine
  Next

  objDumpFile.WriteLine "Structure1Fe"
  For index = 0 To intNumberOfEntriesStructure1Fe - 1
    objStructure1Fe.Append pstrFileName & vbTab & index
    For j = 0 To 11
      objDumpFile.Write Pad(Hex(arrStructure1(intOffsetStructure1Fe + 12 * index + j)), 2, "0") & " "
      objStructure1Fe.Append vbTab & Pad(Hex(arrStructure1(intOffsetStructure1Fe + 12 * index + j)), 2, "0")
    Next
    objStructure1Fe.Append vbCrLf
    objDumpFile.WriteLine
  Next

  objDumpFile.WriteLine "Structure1Ff"
  For index = 0 To intNumberOfEntriesStructure1Ff - 1
    objStructure1Ff.Append pstrFileName & vbTab & index
    For j = 0 To 15
      objDumpFile.Write Pad(Hex(arrStructure1(intOffsetStructure1Ff + 16 * index + j)), 2, "0") & " "
      objStructure1Ff.Append vbTab & Pad(Hex(arrStructure1(intOffsetStructure1Ff + 16 * index + j)), 2, "0")
    Next
    objStructure1Ff.Append vbCrLf
    objDumpFile.WriteLine
  Next

  objDumpFile.WriteLine "Structure1G"
  If arrStructure1Offsets(5) = 0 Then
    objDumpFile.WriteLine "This DGN file does not contain any data in Structure1G."
  Else
    Dim intNumberOfEntriesStructure1G, intOffsetStructure1GPart2
    intNumberOfEntriesStructure1G = arrStructure1(arrStructure1Offsets(5)) * 256 + arrStructure1(arrStructure1Offsets(5) + 1)
    intOffsetStructure1GPart2 = arrStructure1(arrStructure1Offsets(5) + 2) * 256 + arrStructure1(arrStructure1Offsets(5) + 3) + arrStructure1Offsets(5)
    objDumpFile.WriteLine "intNumberOfEntriesStructure1G: " & intNumberOfEntriesStructure1G
    objDumpFile.WriteLine "intOffsetStructure1GPart2: " & intOffsetStructure1GPart2

    objDumpFile.WriteLine "Structure1GPart1"
    For index = 0 To intNumberOfEntriesStructure1G - 1
      objStructure1G1.Append pstrFileName & vbTab & index
      For j = 0 To 7
        objDumpFile.Write Pad(Hex(arrStructure1(arrStructure1Offsets(5) + 4 + 8 * index + j)), 2, "0") & " "
        objStructure1G1.Append vbTab & Pad(Hex(arrStructure1(arrStructure1Offsets(5) + 4 + 8 * index + j)), 2, "0")
      Next
      objStructure1G1.Append vbCrLf
      objDumpFile.WriteLine
    Next

    'Dim arrPart1DwordOffsets
    'ReDim arrPart1DwordOffsets(intNumberOfEntriesStructure1G - 2)
    'For index = 0 To UBound(arrPart1DwordOffsets)
    '  arrPart1DwordOffsets(index) = arrStructure1(arrStructure1(arrStructure1Offsets(5) + 4) + 6) * 256 + arrStructure1(arrStructure1(arrStructure1Offsets(5) + 4) + 7)
    'Next

    objDumpFile.WriteLine "Structure1GPart2"
    j = -1
    For index = 0 To intNumberOfEntriesStructure1G - 2
      objStructure1G2.Append pstrFileName & " " & index & vbTab
      Do
        j = j + 1
        For k = 0 To 3
          objDumpFile.Write Pad(Hex(arrStructure1(intOffsetStructure1GPart2 + 4 * j + k)), 2, "0") & " "
          objStructure1G2.Append Pad(Hex(arrStructure1(intOffsetStructure1GPart2 + 4 * j + k)), 2, "0")
        Next
        objStructure1G2.Append vbTab
      Loop Until (arrStructure1(intOffsetStructure1GPart2 + 4 * j + 0) = &HFF) And _
                  (arrStructure1(intOffsetStructure1GPart2 + 4 * j + 1) = &HFF)

      objStructure1G2.Append vbCrLf
      objDumpFile.WriteLine
    Next
    objStructure1G2.Append pstrFileName & vbCrLf
  End If

  objDumpFile.WriteLine vbCrLf & "**** Block: Structure2 (Textures)"
  'objDataFile.Read(intStructure2Size)

  objDumpFile.WriteLine "Texture descriptors"

  Dim Palettes
  Set Palettes = CreateObject("Scripting.Dictionary")

  ' Descriptor 0
  Dim arrDescriptor0(7)
  Dim strReport
  strReport = ""
  objStructure2.Append pstrFileName & vbTab & "0"
  For j = 0 To 5
    arrDescriptor0(j) = ReadWordOfData
    objStructure2.Append vbTab & Pad(Hex(arrDescriptor0(j)), 4, "0")
    strReport = strReport & arrDescriptor0(j) & vbTab
  Next
  For j = 6 To 7
    arrDescriptor0(j) = ReadDWordOfData
    objStructure2.Append vbTab & Pad(Hex(arrDescriptor0(j)), 8, "0")
    strReport = strReport & arrDescriptor0(j) & vbTab
  Next
  objStructure2.Append vbCrLf
  objDumpFile.WriteLine strReport
  'Palettes.Add arrDescriptor0(2), arrDescriptor0(7)

  Dim intNumberOfTextures
  intNumberOfTextures = (arrDescriptor0(6) \ 20) - 1
  
  Dim arrTextureDescriptors()
  ReDim arrTextureDescriptors(intNumberOfTextures, 7)   ' Number of descriptors = Number of textures + 1
  ' Copy descriptor 0 in new array
  For j = 0 To 7
    arrTextureDescriptors(0, j) = arrDescriptor0(j)
  Next


  For index = 1 To intNumberOfTextures  ' Start at 1 because Descriptor0 was already read. End at intNumberOfTextures to read last descriptor (starting with FFFFh )
    strReport = ""
    objStructure2.Append pstrFileName & vbTab & index
    For j = 0 To 5
      arrTextureDescriptors(index, j) = ReadWordOfData
      objStructure2.Append vbTab & Pad(Hex(arrTextureDescriptors(index, j)), 4, "0")
      strReport = strReport & arrTextureDescriptors(index, j) & vbTab
    Next
    For j = 6 To 7
      arrTextureDescriptors(index, j) = ReadDWordOfData
      objStructure2.Append vbTab & Pad(Hex(arrTextureDescriptors(index, j)), 8, "0")
      strReport = strReport & arrTextureDescriptors(index, j) & vbTab
    Next
    If arrTextureDescriptors(index, 7) <> 0 Then
      Palettes.Add arrTextureDescriptors(index, 2), arrTextureDescriptors(index, 7)
    End If
    objStructure2.Append vbCrLf
    objDumpFile.WriteLine strReport
  Next

  objDumpFile.WriteLine "Number of color palettes for textures: " & Palettes.Count

  Dim intTextureRawDataSize
  intTextureRawDataSize = intStructure2UsefulData - (20 * (intNumberOfTextures + 1))
  objDumpFile.WriteLine "intTextureRawDataSize: " & intTextureRawDataSize

  Dim arrTextureRawData
  ReDim arrTextureRawData(intTextureRawDataSize - 1)
  For index = 0 To UBound(arrTextureRawData)
    arrTextureRawData(index) = ReadByteOfData
  Next

  Dim PaletteOffset
  Dim objTextureImage
  Dim objTexturePalette
  Dim strPalette
  
  Set objTexturePalette = New Palette
  objTexturePalette.SetProperties 16, 5
  Set objTextureImage = New Image

  For index = 0 To intNumberOfTextures - 1   ' Last entry marks the end of table and is not an image
    If arrTextureDescriptors(index, 1) = 8 Then  ' Encoding = 08h  ==> 4bits per pixel
      strPalette = ""
      For j = 0 To 15
        PaletteOffset = Palettes(arrTextureDescriptors(index, 2))
        tmp = 256 * arrTextureRawData(PaletteOffset - (20 * (intNumberOfTextures + 1)) + 2 * j) + arrTextureRawData(PaletteOffset - (20 * (intNumberOfTextures + 1)) + 2 * j + 1)
        objTexturePalette.SetColor j, (tmp And &H001F), ((tmp \ 32) And &H001F), ((tmp \ 1024) And &H001F), 0
      Next

      objTextureImage.SetProperties arrTextureDescriptors(index, 3), arrTextureDescriptors(index, 4), 4

      For j = 0 To arrTextureDescriptors(index, 4) - 1
        For k = 0 To (arrTextureDescriptors(index, 3) / 2) - 1
          tmp = arrTextureRawData(arrTextureDescriptors(index, 6) - (20 * (intNumberOfTextures + 1)) + ((j * (arrTextureDescriptors(index, 3) / 2)) + k))
          objTextureImage.SetPixel 2 * k, j, (tmp \ 16) And &H0F
          objTextureImage.SetPixel 2 * k + 1, j, tmp And &H0F
        Next
      Next
      objTextureImage.ExportToBMP pstrOutputFolder & pstrFileName & " - Decoded\Texture " & Pad(index, 3, "0") & ".bmp", objTexturePalette
    Else ' Encoding = 28h  ==> 2 bytes per pixel, each pixel color is defined like a color palette entry
      objTextureImage.SetProperties arrTextureDescriptors(index, 3), arrTextureDescriptors(index, 4), 24
      For j = 0 To arrTextureDescriptors(index, 4) - 1
        For k = 0 To arrTextureDescriptors(index, 3) - 1
          tmp = arrTextureRawData(arrTextureDescriptors(index, 6) - (20 * (intNumberOfTextures + 1)) + (2 * (j * arrTextureDescriptors(index, 3) + k))) * 256 + _
                arrTextureRawData(arrTextureDescriptors(index, 6) - (20 * (intNumberOfTextures + 1)) + (2 * (j * arrTextureDescriptors(index, 3) + k)) + 1)
          objTextureImage.SetPixel k, j, (((tmp       ) And &H001F) * 255 \ 31) + _
                                         (((tmp \   32) And &H001F) * 255 \ 31) * 256 + _
                                         (((tmp \ 1024) And &H001F) * 255 \ 31) * 65536
        Next
      Next
      objTextureImage.ExportToBMP pstrOutputFolder & pstrFileName & " - Decoded\Texture " & Pad(index, 3, "0") & ".bmp", Null
    End If
  Next

  ' Padding after textures
  objDataFile.Read(intStructure2Size - intStructure2UsefulData)
  

  objDumpFile.WriteLine vbCrLf & "*** Block: Structure3"

  Set fItem = objFileSystemObject.OpenTextFile(pstrOutputFolder & pstrFileName & " - Decoded\Structure3.bin", ForWriting, True)
  For index = 0 To UBound(arrStructure3)
    arrStructure3(index) = ReadByteOfData
    fItem.Write Chr(arrStructure3(index))
  Next
  fItem.Close

  Dim intStructure3NumberOfOffsets, arrStructure3Offsets()
  intStructure3NumberOfOffsets = (arrStructure3(0) * 256 + arrStructure3(1)) * 65536 + arrStructure3(2) * 256 + arrStructure3(3)

  objDumpFile.WriteLine "intStructure3NumberOfOffsets :" & intStructure3NumberOfOffsets
  objDumpFile.WriteLine "Offsets:"
  ReDim arrStructure3Offsets(intStructure3NumberOfOffsets - 1)
  For index = 0 To intStructure3NumberOfOffsets - 1
    tmp = (arrStructure3(4 * index + 4) * 256 + arrStructure3(4 * index + 5)) * 65536 + (arrStructure3(4 * index + 6) * 256) + arrStructure3(4 * index + 7)
    arrStructure3Offsets(index) = tmp
    objDumpFile.WriteLine Pad(Hex(tmp), 8, "0")
  Next
  objDumpFile.WriteLine "Sizes:"

  Dim intUnknownFlags
  Dim intNumberOfEntriesStructure3a
  Dim intNumberOfEntriesStructure3bc
  Dim intOffsetStructure3a
  Dim intStructure3HeaderValue1
  Dim intOffsetStructure3b
  Dim intOffsetStructure3c
  Dim intStructure3HeaderValue2
  Dim intStructure3HeaderValue3
  Dim intStructure3HeaderValue4
  Dim intStructure3HeaderValue5
  Dim arrVertices, arrFaces, arrNormals
  Dim objX3DFile, strX3DFile, strX3DCoordinatePoint

'  Dim intStructure3EntrySize
  For index = 0 To intStructure3NumberOfOffsets - 1
    'If index = intStructure3NumberOfOffsets - 1 Then
    '  intStructure3EntrySize = intStructure3UsefulData - arrStructure3Offsets(intStructure3NumberOfOffsets - 1)
    'Else
    '  intStructure3EntrySize = arrStructure3Offsets(index + 1) - arrStructure3Offsets(index)
    'End If
    'objDumpFile.WriteLine "Structure3 entry #" & index & " - Size = " & intStructure3EntrySize & " bytes"
    'For j = 0 To intStructure3EntrySize - 1
    '  objDumpFile.Write Pad(Hex(arrStructure3(arrStructure3Offsets(index) + j)), 2, "0") & " "
    'Next

    objDumpFile.WriteLine "Structure3 entry #" & index & ". Starting Offset: " & Pad(Hex(arrStructure3Offsets(index)), 8, "0")

    intUnknownFlags = (arrStructure3(arrStructure3Offsets(index)) * 256 + arrStructure3(arrStructure3Offsets(index) + 1)) * 65536 + arrStructure3(arrStructure3Offsets(index) + 2) * 256 + arrStructure3(arrStructure3Offsets(index) + 3)
    intNumberOfEntriesStructure3a = arrStructure3(arrStructure3Offsets(index) + 4) * 256 + arrStructure3(arrStructure3Offsets(index) + 5)
    intNumberOfEntriesStructure3bc = arrStructure3(arrStructure3Offsets(index) + 6) * 256 + arrStructure3(arrStructure3Offsets(index) + 7)
    intOffsetStructure3a = (arrStructure3(arrStructure3Offsets(index) + 8) * 256 + arrStructure3(arrStructure3Offsets(index) + 9)) * 65536 + arrStructure3(arrStructure3Offsets(index) + 10) * 256 + arrStructure3(arrStructure3Offsets(index) + 11)
    intStructure3HeaderValue1 = (arrStructure3(arrStructure3Offsets(index) + 12) * 256 + arrStructure3(arrStructure3Offsets(index) + 13)) * 65536 + arrStructure3(arrStructure3Offsets(index) + 14) * 256 + arrStructure3(arrStructure3Offsets(index) + 15)
    intOffsetStructure3b = (arrStructure3(arrStructure3Offsets(index) + 16) * 256 + arrStructure3(arrStructure3Offsets(index) + 17)) * 65536 + arrStructure3(arrStructure3Offsets(index) + 18) * 256 + arrStructure3(arrStructure3Offsets(index) + 19)
    intOffsetStructure3c = (arrStructure3(arrStructure3Offsets(index) + 20) * 256 + arrStructure3(arrStructure3Offsets(index) + 21)) * 65536 + arrStructure3(arrStructure3Offsets(index) + 22) * 256 + arrStructure3(arrStructure3Offsets(index) + 23)
    intStructure3HeaderValue2 = (arrStructure3(arrStructure3Offsets(index) + 24) * 256 + arrStructure3(arrStructure3Offsets(index) + 25)) * 65536 + arrStructure3(arrStructure3Offsets(index) + 26) * 256 + arrStructure3(arrStructure3Offsets(index) + 27)
    intStructure3HeaderValue3 = (arrStructure3(arrStructure3Offsets(index) + 28) * 256 + arrStructure3(arrStructure3Offsets(index) + 29)) * 65536 + arrStructure3(arrStructure3Offsets(index) + 30) * 256 + arrStructure3(arrStructure3Offsets(index) + 31)
    intStructure3HeaderValue4 = (arrStructure3(arrStructure3Offsets(index) + 32) * 256 + arrStructure3(arrStructure3Offsets(index) + 33)) * 65536 + arrStructure3(arrStructure3Offsets(index) + 34) * 256 + arrStructure3(arrStructure3Offsets(index) + 35)
    intStructure3HeaderValue5 = (arrStructure3(arrStructure3Offsets(index) + 36) * 256 + arrStructure3(arrStructure3Offsets(index) + 37)) * 65536 + arrStructure3(arrStructure3Offsets(index) + 38) * 256 + arrStructure3(arrStructure3Offsets(index) + 39)

    objDumpFile.WriteLine "intUnknownFlags: " & intUnknownFlags
    objDumpFile.WriteLine "intNumberOfEntriesStructure3a: " & intNumberOfEntriesStructure3a
    objDumpFile.WriteLine "intNumberOfEntriesStructure3bc: " & intNumberOfEntriesStructure3bc
    objDumpFile.WriteLine "intOffsetStructure3a: " & Pad(Hex(intOffsetStructure3a), 4, "0")
    objDumpFile.WriteLine "intStructure3HeaderValue1: " & intStructure3HeaderValue1
    objDumpFile.WriteLine "intOffsetStructure3b: " & Pad(Hex(intOffsetStructure3b), 4, "0")
    objDumpFile.WriteLine "intOffsetStructure3c: " & Pad(Hex(intOffsetStructure3c), 4, "0")
    objDumpFile.WriteLine "intStructure3HeaderValue2: " & intStructure3HeaderValue2
    objDumpFile.WriteLine "intStructure3HeaderValue3: " & intStructure3HeaderValue3
    objDumpFile.WriteLine "intStructure3HeaderValue4: " & intStructure3HeaderValue4
    objDumpFile.WriteLine "intStructure3HeaderValue5: " & intStructure3HeaderValue5
    'If intStructure3HeaderValue1 <> 0 Then MsgBox "intStructure3HeaderValue1 <> 0 in " & pstrFileName
    'If intStructure3HeaderValue3 <> 0 Then MsgBox "intStructure3HeaderValue3 <> 0 in " & pstrFileName
    'If intStructure3HeaderValue4 <> 0 Then MsgBox "intStructure3HeaderValue4 <> 0 in " & pstrFileName
    'If intStructure3HeaderValue5 <> 0 Then MsgBox "intStructure3HeaderValue5 <> 0 in " & pstrFileName

    ReDim arrVertices(intNumberOfEntriesStructure3a, 2)
    ReDim arrFaces(intNumberOfEntriesStructure3bc, 5)
    ReDim arrNormals(intNumberOfEntriesStructure3bc, 2)

    objDumpFile.WriteLine "Structure3a (vertices) - " & intNumberOfEntriesStructure3a & " entries"
    For k = 0 To intNumberOfEntriesStructure3a - 1
      objStructure3a.Append pstrFileName & vbTab & index & vbTab & k
      For j = 0 To 2
        'objDumpFile.Write Pad(Hex(arrStructure3(intOffsetStructure3a + 12 * k + j)), 2, "0") & " "
        tmp = (arrStructure3(intOffsetStructure3a + 12 * k + 4 * j + 0) * 256 + arrStructure3(intOffsetStructure3a + 12 * k + 4 * j + 1)) * 65536 + arrStructure3(intOffsetStructure3a + 12 * k + 4 * j + 2) * 256 + arrStructure3(intOffsetStructure3a + 12 * k + 4 * j + 3)
        If tmp >= 2147483648 Then
          tmp = tmp - 4294967296
        End If
        arrVertices(k, j) = tmp
        objDumpFile.Write Round(tmp / 65536, 4) & ", "
        objStructure3a.Append vbTab & Round(tmp / 65536, 4) & vbTab & Pad(Hex(arrStructure3(intOffsetStructure3a + 12 * k + 4 * j + 0)), 2, "0") & Pad(Hex(arrStructure3(intOffsetStructure3a + 12 * k + 4 * j + 1)), 2, "0") & Pad(Hex(arrStructure3(intOffsetStructure3a + 12 * k + 4 * j + 2)), 2, "0") & Pad(Hex(arrStructure3(intOffsetStructure3a + 12 * k + 4 * j + 3)), 2, "0")
      Next
      objStructure3a.Append vbCrLf
      objDumpFile.WriteLine
    Next

    objDumpFile.WriteLine "Structure3b (Faces) - " & intNumberOfEntriesStructure3bc & " entries"
    For k = 0 To intNumberOfEntriesStructure3bc - 1
      objStructure3b.Append pstrFileName & vbTab & index & vbTab & k
      For j = 0 To 3
        tmp = arrStructure3(intOffsetStructure3b + 12 * k + 2 * j) * 256 + arrStructure3(intOffsetStructure3b + 12 * k + 2 * j + 1)
        arrFaces(k, j) = tmp
        objDumpFile.Write tmp & " "
        objStructure3b.Append vbTab & tmp
      Next
      For j = 4 To 5
        tmp = Pad(Hex(arrStructure3(intOffsetStructure3b + 12 * k + 2 * j) * 256 + arrStructure3(intOffsetStructure3b + 12 * k + 2 * j + 1)), 4, "0")
        arrFaces(k, j) = tmp
        objDumpFile.Write tmp & " "
        objStructure3b.Append vbTab & tmp
      Next
      objStructure3b.Append vbCrLf
      objDumpFile.WriteLine
    Next

    objDumpFile.WriteLine "Structure3c (Face normal vectors?) - " & intNumberOfEntriesStructure3bc & " entries"
    For k = 0 To intNumberOfEntriesStructure3bc - 1
      objStructure3c.Append pstrFileName & vbTab & index & vbTab & k
      For j = 0 To 2
        'objDumpFile.Write Pad(Hex(arrStructure3(intOffsetStructure3c + 12 * k + j)), 2, "0") & " "
        tmp = (arrStructure3(intOffsetStructure3c + 12 * k + 4 * j + 0) * 256 + arrStructure3(intOffsetStructure3c + 12 * k + 4 * j + 1)) * 65536 + arrStructure3(intOffsetStructure3c + 12 * k + 4 * j + 2) * 256 + arrStructure3(intOffsetStructure3c + 12 * k + 4 * j + 3)
        If tmp >= 2147483648 Then
          tmp = tmp - 4294967296
        End If
        arrNormals(k, j) = tmp
        objDumpFile.Write Round(tmp / 65536, 4) & ", "
        objStructure3c.Append vbTab & Round(tmp / 65536, 4) & vbTab & Pad(Hex(arrStructure3(intOffsetStructure3c + 12 * k + 4 * j + 0)), 2, "0") & Pad(Hex(arrStructure3(intOffsetStructure3c + 12 * k + 4 * j + 1)), 2, "0") & Pad(Hex(arrStructure3(intOffsetStructure3c + 12 * k + 4 * j + 2)), 2, "0") & Pad(Hex(arrStructure3(intOffsetStructure3c + 12 * k + 4 * j + 3)), 2, "0")
      Next
      objStructure3c.Append vbCrLf
      objDumpFile.WriteLine
    Next
    objDumpFile.WriteLine

    ' Output an x3d file for the model
    strX3DFile = "<?xml version=""1.0"" encoding=""UTF-8""?>" & VbCrLf & _
                 "<!DOCTYPE X3D PUBLIC ""ISO//Web3D//DTD X3D 3.0//EN"" ""http://www.web3d.org/specifications/x3d-3.0.dtd"">" & VbCrLf & _
                 "<X3D profile='Interchange' version='3.0' xmlns:xsd='http://www.w3.org/2001/XMLSchema-instance' xsd:noNamespaceSchemaLocation='http://www.web3d.org/specifications/x3d-3.0.xsd'>" & VbCrLf & _
                 "  <head>" & VbCrLf & _
                 "  </head>" & VbCrLf & _
                 "  <Scene>" & VbCrLf & _
                 "    <Viewpoint description='Far away' position='0 65536 524288'/>" & VbCrLf & _
                 "    <Group>" & VbCrLf

    Dim NormalX, NormalY, NormalZ, NormalFactor, Vertex1X, Vertex1Y, Vertex1Z, Vertex2X, Vertex2Y, Vertex2Z, Vertex3X, Vertex3Y, Vertex3Z
    Dim OriginalNormalX, OriginalNormalY, OriginalNormalZ
    Dim OneOffColorRed, OneOffColorGreen, OneOffColorBlue
    For k = 0 To intNumberOfEntriesStructure3bc - 1
      ' Computer surface normal vector to determine in which order vertices are declared (clockwise or counter clockwise)
      ' Only the first three vertices are used to computer normal vector
      Vertex1X = arrVertices(arrFaces(k, 0), 0)
      Vertex1Y = arrVertices(arrFaces(k, 0), 1)
      Vertex1Z = arrVertices(arrFaces(k, 0), 2)
      Vertex2X = arrVertices(arrFaces(k, 1), 0)
      Vertex2Y = arrVertices(arrFaces(k, 1), 1)
      Vertex2Z = arrVertices(arrFaces(k, 1), 2)
      Vertex3X = arrVertices(arrFaces(k, 2), 0)
      Vertex3Y = arrVertices(arrFaces(k, 2), 1)
      Vertex3Z = arrVertices(arrFaces(k, 2), 2)
      NormalX = (Vertex1Z - Vertex2Z) * (Vertex3Y - Vertex2Y) - (Vertex1Y - Vertex2Y) * (Vertex3Z - Vertex2Z)
      NormalY = (Vertex1X - Vertex2X) * (Vertex3Z - Vertex2Z) - (Vertex1Z - Vertex2Z) * (Vertex3X - Vertex2X)
      NormalZ = (Vertex1Y - Vertex2Y) * (Vertex3X - Vertex2X) - (Vertex1X - Vertex2X) * (Vertex3Y - Vertex2Y)

      'NormalX = (z1-z2)*(y3-y2)-(y1-y2)*(z3-z2)
      'NormalY = (x1-x2)*(z3-z2)-(z1-z2)*(x3-x2)
      'NormalZ = (y1-y2)*(x3-x2)-(x1-x2)*(y3-y2)

      If (NormalX = 0) And (NormalY = 0) And (NormalZ = 0) Then
        'MsgBox "NormalXYZ=0" & vbCrLf & "Model #" & index & vbCrLf & "Face #" & k
      Else
        NormalFactor = Sqr(NormalX^2 + NormalY^2 + NormalZ^2)
'        On Error Resume Next
        NormalX = Round(NormalX / NormalFactor, 3)
        'If Err.Number <> 0 Then
        '  MsgBox NormalX & vbCrLf & NormalFactor & vbCrLf & "Model #" & index & vbCrLf & "Face #" & k
        '  Exit Sub
        'End If
        NormalY = Round(NormalY / NormalFactor, 3)
        NormalZ = Round(NormalZ / NormalFactor, 3)
      End If

      strX3DFile = strX3DFile & "      <Shape>" & vbCrLf & _
                                "        <Appearance>" & vbCrLf

      If Left(arrFaces(k, 5), 2) = "00" Then
        ' Normal Texture
        strX3DFile = strX3DFile & "          <ImageTexture url='Texture " & Pad(CLng("&H" & Right(arrFaces(k, 5), 2)), 3, "0") & ".bmp'/>" & vbCrLf & _
                                  "          <Material diffuseColor='0 0.5 1'/>" & vbCrLf
      ElseIf Left(arrFaces(k, 5), 2) = "08" Then
        ' Animated Texture
        strX3DFile = strX3DFile & "          <Material diffuseColor='1 0.5 0'/>" & vbCrLf
      Else
        ' Simple color
        tmp = CLng("&H" & arrFaces(k, 5))
        OneOffColorRed =   ((tmp       ) And &H001F) / 31
        OneOffColorGreen = ((tmp \   32) And &H001F) / 31
        OneOffColorBlue =  ((tmp \ 1024) And &H001F) / 31
        strX3DFile = strX3DFile & "          <Material diffuseColor='" & OneOffColorRed & " " & OneOffColorGreen & " " & OneOffColorBlue & "'/>" & vbCrLf
      End If

      OriginalNormalX = Round(arrNormals(k, 0) / 65536, 3)
      OriginalNormalY = Round(arrNormals(k, 1) / 65536, 3)
      OriginalNormalZ = Round(arrNormals(k, 2) / 65536, 3)

      strX3DFile = strX3DFile & "        </Appearance>" & vbCrLf & _
                                "        <IndexedFaceSet "

      'If ((OriginalNormalX > 0) And (NormalX < 0) And (OriginalNormalX > 0.5)) Or _
      '   ((OriginalNormalX < 0) And (NormalX > 0) And (OriginalNormalX > 0.5)) Or _
      '   ((OriginalNormalY > 0) And (NormalY < 0) And (OriginalNormalY > 0.5)) Or _
      '   ((OriginalNormalY < 0) And (NormalY > 0) And (OriginalNormalY > 0.5)) Or _
      '   ((OriginalNormalZ > 0) And (NormalZ < 0) And (OriginalNormalZ > 0.5)) Or _
      '   ((OriginalNormalZ < 0) And (NormalZ > 0) And (OriginalNormalZ > 0.5)) Then
      '  strX3DFile = strX3DFile & "ccw='false' "
      'End If
      'strX3DFile = strX3DFile & "coordIndex='0 1 2 3' normalPerVertex='false' normalIndex='0' texCoordIndex='3 2 1 0'>" & vbCrLf & _
      '                          "          <Coordinate point='"
      strX3DFile = strX3DFile & "coordIndex='0 1 2 3' solid='false' texCoordIndex='3 2 1 0'>" & vbCrLf & _
                                "          <Coordinate point='"


      strX3DCoordinatePoint = ""
      For j = 0 To 3
        Dim v
        For v = 0 To 2
          strX3DCoordinatePoint = strX3DCoordinatePoint & " " & arrVertices(arrFaces(k, j), v)
        Next
      Next

      strX3DFile = strX3DFile & Trim(strX3DCoordinatePoint) & _
                                "'/>" & vbCrLf & _
                                "          <TextureCoordinate point='0 0 1 0 1 1 0 1'/>" & vbCrLf
                                ' & _
                                '"          <Normal vector='"

      strX3DCoordinatePoint = ""
      For j = 0 To 2
        strX3DCoordinatePoint = strX3DCoordinatePoint & " " & Replace(CStr(Round(arrNormals(k, j) / 65536, 3)), ",", ".")
      Next

      'strX3DCoordinatePoint = Replace(NormalX, ",", ".") & " " & Replace(NormalY, ",", ".") & " " & Replace(NormalZ, ",", ".")

' & " || " & NormalX & " " & NormalY & " " & NormalZ
'      strX3DFile = strX3DFile & Trim(strX3DCoordinatePoint) & _
      strX3DFile = strX3DFile & "        </IndexedFaceSet>" & vbCrLf & _
                                "      </Shape>" & vbCrLf
    Next

    strX3DFile = strX3DFile & "   </Group>" & vbCrLf & _
                              "  </Scene>" & vbCrLf & _
                             "</X3D>"

    Set objX3DFile = objFileSystemObject.OpenTextFile(pstrOutputFolder & pstrFileName & " - Decoded\Model" & index & ".x3d", ForWriting, True)
    objX3DFile.Write strX3DFile
    objX3DFile.Close
  Next
  objDumpFile.WriteLine
End Sub

Sub DecodeMNS(pstrFolder, pstrFileName, pstrOutputFolder)
  Dim index
	Set objDataFile = objFileSystemObject.OpenTextFile(pstrFolder & "\" & pstrFileName, ForReading, False)

	If Not objFileSystemObject.FolderExists(pstrOutputFolder & pstrFileName & " - Decoded") Then
		objFileSystemObject.CreateFolder(pstrOutputFolder & pstrFileName & " - Decoded")
	End If

	Set objDumpFile = objFileSystemObject.OpenTextFile(pstrOutputFolder & pstrFileName & " - Decoded\zzzz Dump.txt", ForWriting, True)

  objDumpFile.WriteLine "File Signature: " & objDataFile.Read(4)
  objDumpFile.WriteLine "File size: " & ReadDwordOfData
  objDumpFile.WriteLine "Dword1: " & ReadDwordOfData
  objDumpFile.WriteLine "Dword2: " & ReadDwordOfData
  objDumpFile.WriteLine "Dword3: " & ReadDwordOfData
  objDumpFile.WriteLine "Dword4: " & ReadDwordOfData
  objDumpFile.WriteLine "Dword5: " & ReadDwordOfData
  objDumpFile.WriteLine "Dword6: " & ReadDwordOfData

  Dim intMOTNOffset, intTEXTOffset
  intMOTNOffset = ReadDwordOfData
  intTEXTOffset = ReadDwordOfData

  objDumpFile.WriteLine "intMOTNOffset: " & intMOTNOffset
  objDumpFile.WriteLine "intTEXTOffset: " & intTEXTOffset
  objDumpFile.WriteLine "Unknown: " & ReadDwordOfData

  objDataFile.Read(intTEXTOffset - 44)  ' Already 44 bytes read in file

  objDumpFile.WriteLine "TEXT Signature: " & objDataFile.Read(4)
  objDumpFile.WriteLine "TEXT size: " & ReadDwordOfData

  Dim intNumberOfTEXTEntries
  intNumberOfTEXTEntries = ReadDwordOfData
  objDumpFile.WriteLine "TEXTDword1: " & ReadDwordOfData
  objDumpFile.WriteLine "TEXTDword2: " & ReadDwordOfData
  objDumpFile.WriteLine "TEXTDword3: " & ReadDwordOfData
  objDumpFile.WriteLine "TEXTDword4: " & ReadDwordOfData
  objDumpFile.WriteLine "TEXTDword5: " & ReadDwordOfData
  objDumpFile.WriteLine "TEXTDword6: " & ReadDwordOfData
  
  Dim arrTEXTEntriesDescriptors, intWordIndex
  ReDim arrTEXTEntriesDescriptors(intNumberOfTEXTEntries, 9)
  For index = 0 To intNumberOfTEXTEntries
    For intWordIndex = 0 To 9
      arrTEXTEntriesDescriptors(index, intWordIndex) = ReadWordOfData
      objDumpFile.Write arrTEXTEntriesDescriptors(index, intWordIndex) & vbtab
    Next
    objDumpFile.WriteLine
  Next

  Dim OutputTEXTImage, intPixel, intX, intY, int24bPixel

  For index = 0 To intNumberOfTEXTEntries - 1
    Set OutputTEXTImage = New Image
    OutputTEXTImage.SetProperties arrTEXTEntriesDescriptors(index, 3), arrTEXTEntriesDescriptors(index, 4), 24

    For intY = 0 To arrTEXTEntriesDescriptors(index, 4) - 1
      For intX = 0 To arrTEXTEntriesDescriptors(index, 3) - 1
        intPixel = ReadWordOfData
        int24bPixel = (((intPixel       ) And &H001F) * 255 \ 31) + _
                      (((intPixel \   32) And &H001F) * 255 \ 31) * 256 + _
                      (((intPixel \ 1024) And &H001F) * 255 \ 31) * 65536
        OutputTEXTImage.SetPixel intX, intY, int24bPixel
      Next
    Next
    OutputTEXTImage.ExportToBMP pstrOutputFolder & pstrFileName & " - Decoded\TEXTImage " & index & ".bmp", Null
  Next
End Sub

Sub DecodeSNDLEVxxMAP(pstrFolder, pstrFileName, pstrOutputFolder)
  Dim index, intRawIndex
	Set objDataFile = objFileSystemObject.OpenTextFile(pstrFolder & "\" & pstrFileName, ForReading, False)

  Dim objDataSALFile
	Set objDataSALFile = objFileSystemObject.OpenTextFile(pstrFolder & "\" & Replace(UCase(strFileName), ".MAP", ".SAL"), ForReading, False)

	If Not objFileSystemObject.FolderExists(pstrOutputFolder & Replace(UCase(strFileName), ".MAP", ".SAL") & " - Decoded") Then
		objFileSystemObject.CreateFolder(pstrOutputFolder & Replace(UCase(strFileName), ".MAP", ".SAL") & " - Decoded")
	End If

	Set objDumpFile = objFileSystemObject.OpenTextFile(pstrOutputFolder & Replace(UCase(strFileName), ".MAP", ".SAL") & " - Decoded\zzzz Dump.txt", ForWriting, True)

  Dim intByte, intDataID, intIDNumber, intL, intStartAddress, intAreaSize, strSALPart
  objDumpFile.WriteLine "DataID: 0: Tone bank data, 1: Sequence data, 2: DSP program, 3: DSP work RAM"
  objDumpFile.WriteLine "ID number: 0-15 Identification number when there are several entries with the same DataID"
  objDumpFile.WriteLine "intDataID" & vbTab & "intIDNumber" & vbTab & "intL" & vbTab & "intStartAddress" & vbTab & "intAreaSize"

  Dim arrRawSamples, intOffset, intEntriesOffset, intNumberOfEntries, intK
  intByte = ReadByteOfData
  index = 0
  While Not intByte = &HFF
    intDataID = (intByte \ 16 ) And &H07
    intIDNumber = intByte And &H0F
    intStartAddress = (ReadByteOfData And &H0F) * 65536 + ReadWordOfData
    intL = ReadByteOfData
    intAreaSize = (ReadByteOfData And &H0F) * 65536 + ReadWordOfData
    objDumpFile.WriteLine intDataID & vbTab & intIDNumber & vbTab & intL & vbTab & intStartAddress & vbTab & intAreaSize

    If intDataID = 0 Then
      Dim objEntryOffsets
      Set objEntryOffsets = CreateObject("Scripting.Dictionary")
      
      intEntriesOffset = Asc(objDataSALFile.Read(1)) * 256 + Asc(objDataSALFile.Read(1))
      intRawIndex = 0
      objEntryOffsets.Add intRawIndex, intEntriesOffset
      intRawIndex = intRawIndex + 1
      intOffset = 2
      intNumberOfEntries = intEntriesOffset \ 2
      objDumpFile.WriteLine "intEntriesOffset : " & intEntriesOffset & vbCrLf & _
                            "intNumberOfEntries : " & intNumberOfEntries
      While intOffset < intEntriesOffset
        objEntryOffsets.Add intRawIndex, Asc(objDataSALFile.Read(1)) * 256 + Asc(objDataSALFile.Read(1))
        objDumpFile.WriteLine objEntryOffsets(intRawIndex)
        intOffset = intOffset + 2
        intRawIndex = intRawIndex + 1
      Wend

      objDumpFile.WriteLine "Entries:"

      Dim objEntries
      Set objEntries = CreateObject("Scripting.Dictionary")
      
      Dim intEntrySize, strReport

      For intRawIndex = 0 To 3                       ' First 4 entries
        intEntrySize = objEntryOffsets(intRawIndex + 1) - objEntryOffsets(intRawIndex)
        Dim arrEntryData
        ReDim arrEntryData(intEntrySize - 1)
        strReport = ""
        For intK = 0 To intEntrySize - 1
          arrEntryData(intK) = Asc(objDataSALFile.Read(1))
          intOffset = intOffset + 1
          strReport = strReport & " " & Pad(Hex(arrEntryData(intK)), 2, "0")
        Next
        objEntries.Add intRawIndex, arrEntryData
        objDumpFile.WriteLine strReport
      Next

      For intRawIndex = 4 To intNumberOfEntries - 1  ' Other entries
        ReDim arrEntryData(3)
        arrEntryData(0) = Asc(objDataSALFile.Read(1))
        arrEntryData(1) = Asc(objDataSALFile.Read(1))
        arrEntryData(2) = Asc(objDataSALFile.Read(1))
        arrEntryData(3) = Asc(objDataSALFile.Read(1))
        strReport = Pad(Hex(arrEntryData(0)), 2, "0") & " " & Pad(Hex(arrEntryData(1)), 2, "0") & " " & Pad(Hex(arrEntryData(2)), 2, "0") & " " & Pad(Hex(arrEntryData(3)), 2, "0")
        intOffset = intOffset + 4
        intEntrySize = 4 + 32 * (arrEntryData(2) + 1)

        ReDim Preserve arrEntryData(intEntrySize - 1)
        For intK = 4 To intEntrySize - 1
          arrEntryData(intK) = Asc(objDataSALFile.Read(1))
          intOffset = intOffset + 1
          strReport = strReport & " " & Pad(Hex(arrEntryData(intK)), 2, "0")
        Next
        objEntries.Add intRawIndex, arrEntryData
        objDumpFile.WriteLine strReport
      Next

      ' Offset now contains the starting offset of sample data
      ReDim arrRawSamples(intAreaSize - intOffset - 1)
      For intRawIndex = 0 To UBound(arrRawSamples)
        arrRawSamples(intRawIndex) = Asc(objDataSALFile.Read(1))
      Next

      Dim intLayerStartAddress, intLoopStartAddress, intLoopEndAddress, intSoundSourceControl, intNumberOfBytesPerSample
      For intRawIndex = 4 To intNumberOfEntries - 1
        arrEntryData = objEntries(intRawIndex)
        
        If ((arrEntryData(7) \ 16) And &H01) = 1 Then  ' PCM 8 or 16 bits
          objDumpFile.Write "8" & vbTab
          intNumberOfBytesPerSample = 1
        Else
          objDumpFile.Write "16" & vbTab
          intNumberOfBytesPerSample = 2
        End If
'        If arrEntryData(6) = 0 Then
          intSoundSourceControl = 2 * (arrEntryData(6) And &H01) + (arrEntryData(7) \ 128)
          intLayerStartAddress = (arrEntryData(7) And &H0F) * 65536 + arrEntryData(8) * 256 + arrEntryData(9)
          intLoopStartAddress = arrEntryData(10) * 256 + arrEntryData(11)
          intLoopEndAddress = arrEntryData(12) * 256 + arrEntryData(13)
          Dim intNumberOfSoundBytes
          intNumberOfSoundBytes = (intLoopEndAddress + 1) * intNumberOfBytesPerSample
          
          objDumpFile.WriteLine "intSoundSourceControl : " & vbTab & intSoundSourceControl & vbTab & _
                                "intLayerStartAddress: " & vbTab & intLayerStartAddress & vbTab & _
                                "intLoopStartAddress: " & vbTab & intLoopStartAddress & vbTab & _
                                "intLoopEndAddress : " & vbTab & intLoopEndAddress & vbTab & _
                                "intNumberOfSoundBytes : " & vbTab & intNumberOfSoundBytes
          If intSoundSourceControl = 0 Then
            ' This entry uses sample data in memory, dump to file
            
            Dim objSoundItem
            Set objSoundItem = objFileSystemObject.OpenTextFile(pstrOutputFolder & Replace(UCase(strFileName), ".MAP", ".SAL") & " - Decoded\SALPart" & index & "DataID" & intDataID & "IDNumber" & intIDNumber & "Sound" & intRawIndex & "BPS" & 8*intNumberOfBytesPerSample & ".wav", ForWriting, True)
            objSoundItem.Write BuildWAVHeader(intNumberOfSoundBytes, 11025, 8*intNumberOfBytesPerSample)
            Dim intN, tmpSample
            If intNumberOfBytesPerSample = 1 Then
              For intN = 0 To intNumberOfSoundBytes - 1
                ' Convert samples from signed bytes to unsigned bytes
                tmpSample = arrRawSamples(intLayerStartAddress - intOffset + intN)
                If tmpSample < 128 Then
                  tmpSample = tmpSample + 128
                Else
                  tmpSample = tmpSample - 128
                End If
                objSoundItem.Write Chr(tmpSample)
              Next
            Else
              For intN = 0 To (intNumberOfSoundBytes / 2) - 1    
                ' Reverse bytes from big endian to little endian
                objSoundItem.Write Chr(arrRawSamples(intLayerStartAddress - intOffset + 2 * intN + 1)) & _
                                   Chr(arrRawSamples(intLayerStartAddress - intOffset + 2 * intN))
              Next
            End If
            objSoundItem.Close
          Else
            ' This entry uses noise generator, nothing to dump
          End If

'        End If
      Next
    Else
      Dim objSALPartFile
      Set objSALPartFile = objFileSystemObject.OpenTextFile(pstrOutputFolder & Replace(UCase(strFileName), ".MAP", ".SAL") & " - Decoded\SALPart" & index & "DataID" & intDataID & "IDNumber" & intIDNumber & ".bin", ForWriting, True)
      objSALPartFile.Write objDataSALFile.Read(intAreaSize)
      objSALPartFile.Close
    End If

    If index = 0 Then 
      Set objSALPartFile = objFileSystemObject.OpenTextFile(pstrOutputFolder & Replace(UCase(strFileName), ".MAP", ".SAL") & " - Decoded\SALPart" & index & "PaddingAfterFirstEntry.bin", ForWriting, True)
      objSALPartFile.Write objDataSALFile.Read(2752) ' Padding between firt part and second part
      objSALPartFile.Close
    End If

    intByte = ReadByteOfData
    index = index + 1
  Wend

  objDataSALFile.Close
	objDataFile.Close
	objDumpFile.Close
End Sub

Function BuildWAVHeader(SoundDataSize, SampleRate, BitsPerSample)
	If BitsPerSample = 8 Then
		BuildWAVHeader = "RIFF" & IntToString(36 + SoundDataSize) & "WAVEfmt " & _
				Chr(&h10) & Chr(&h00) & Chr(&h00) & Chr(&h00) & Chr(&h01) & _
				Chr(&h00) & Chr(&h01) & Chr(&h00) & IntToString(SampleRate)& _
				IntToString(SampleRate) & Chr(&h01) & Chr(&h00) & Chr(&h08) & _
				Chr(&h00) & "data" & IntToString(SoundDataSize)
	ElseIf BitsPerSample = 16 Then
		BuildWAVHeader = "RIFF" & IntToString(36 + SoundDataSize) & "WAVEfmt " & _
				Chr(&h10) & Chr(&h00) & Chr(&h00) & Chr(&h00) & Chr(&h01) & _
				Chr(&h00) & Chr(&h01) & Chr(&h00) & IntToString(SampleRate)& _
				IntToString(SampleRate * 2) & Chr(&h02) & Chr(&h00) & Chr(&h10) & _
				Chr(&h00) & "data" & IntToString(SoundDataSize)
	Else
		MsgBox "Invalid BitsPerSample value in BuildWAVHeader: " & BitsPerSample
	End If
End Function

Sub DecodeSMAPxxBIN(pstrFolder, pstrFileName, pstrOutputFolder)
  Dim index
	Set objDataFile = objFileSystemObject.OpenTextFile(pstrFolder & "\" & pstrFileName, ForReading, False)

	If Not objFileSystemObject.FolderExists(pstrOutputFolder & "SMAPxxBIN - Decoded") Then
		objFileSystemObject.CreateFolder(pstrOutputFolder & "SMAPxxBIN - Decoded")
	End If

  Dim BlockID, FileSize, OffsetPart1, SizePart1, OffsetPart2, SizePart2, OffsetPart3, SizePart3

  BlockID = objDataFile.Read(4)
  FileSize = ReadDWordOfData
  OffsetPart1 = ReadDWordOfData ' Part 1 is a tilemap (1 word per tile)
  SizePart1 = ReadDWordOfData
  OffsetPart2 = ReadDWordOfData ' Part 2 is a color palette 256 colors, 1 word per color, 5 bits per component RGB + bit 15 ignored
  SizePart2 = ReadDWordOfData
  OffsetPart3 = ReadDWordOfData ' Part 3 is a tileset (8x8 pixels tiles, 1 byte per pixel which is the index in the 256 colors palette)
  SizePart3 = ReadDWordOfData

  Dim Part1()
  ReDim Part1((SizePart1 / 2) - 1)

  For index = 0 To UBound(Part1)
    Part1(index) = ReadWordOfData
  Next

  Dim objOutputPalette
  Set objOutputPalette = LoadSaturnPalette(objDataFile, 256, BIG_ENDIAN)
  
  Dim objTiles(), intX, intY
  ReDim objTiles((SizePart3 / 64) - 1)
  For index = 0 To UBound(objTiles)
    Set objTiles(index) = New Image
    objTiles(index).SetProperties 8, 8, 8
    For intY = 0 To 7
      For intX = 0 To 7
        objTiles(index).SetPixel intX, intY, ReadByteOfData
      Next
    Next
  Next

  Dim objOutputImage, xOutput, yOutput, intTileIndex, blnHorizontalFlip, blnVerticalFlip
  Set objOutputImage = New Image
  objOutputImage.SetProperties 80*8, 76*8, 8
  For yOutput = 0 To 75
    For xOutput = 0 To 79
      intTileIndex = (Part1(yOutput * 80 + xOutput) / 2) And &H1FFF
      blnHorizontalFlip = (Part1(yOutput * 80 + xOutput) \ 16384) And &H0001
      blnVerticalFlip = Part1(yOutput * 80 + xOutput) \ 32768
      objOutputImage.PutImage 8 * xOutput, 8 * yOutput, objTiles(intTileIndex), blnHorizontalFlip, blnVerticalFlip
    Next
  Next

  objOutputImage.ExportToBMP pstrOutputFolder & "SMAPxxBIN - Decoded\" & pstrFileName & ".bmp", objOutputPalette

	objDataFile.Close
End Sub

Sub DecodeRES(pstrFolder, pstrFileName, pstrOutputFolder)
  Dim index
	Set objDataFile = objFileSystemObject.OpenTextFile(pstrFolder & "\" & pstrFileName, ForReading, False)

	If Not objFileSystemObject.FolderExists(pstrOutputFolder & pstrFileName & " - Decoded") Then
		objFileSystemObject.CreateFolder(pstrOutputFolder & pstrFileName & " - Decoded")
	End If

	Set objDumpFile = objFileSystemObject.OpenTextFile(pstrOutputFolder & pstrFileName & " - Decoded\zzzz Dump.txt", ForWriting, True)

  Dim BlockID, FileSize, NumberOfParts, UnusedHeaderword

  BlockID = objDataFile.Read(4)
  If BlockID <> "RES*" Then
    MsgBox "Wrong file format! Not a RES* file!"
  End If
  FileSize = ReadDWordOfData
  NumberOfParts = ReadWordOfData
  UnusedHeaderword = ReadWordOfData
  
  Dim HeaderPartIDs(), HeaderPartIndex(), HeaderPartOffsets()
  ReDim HeaderPartIDs(NumberOfParts)
  ReDim HeaderPartIndex(NumberOfParts)
  ReDim HeaderPartOffsets(NumberOfParts)

	objDumpFile.WriteLine "BlockID: " & BlockID & vbCrLf & _
                        "FileSize: " & FileSize & vbCrLf & _
                        "NumberOfParts: " & NumberOfParts & vbCrLf & _
                        "UnusedHeaderword: " & UnusedHeaderword & vbCrLf

  objDumpFile.WriteLine "Header"
  For index = 0 To NumberOfParts
    HeaderPartIDs(index) = objDataFile.Read(4)
    HeaderPartIndex(index) = ReadDWordOfData
    HeaderPartOffsets(index) = ReadDWordOfData
    objDumpFile.WriteLine HeaderPartIDs(index) & vbTab & HeaderPartIndex(index) & vbTab & HeaderPartOffsets(index)
  Next

  Dim tmp
  Dim BitmapData()
  Dim OutputData
  Dim intNumberOfStrings
  Dim objOutputImage, objOutputPalette
  Dim arrStringsOffsets(), intTextDataSize, arrTextData()
  Dim objCharactersFoundInTexts
  Set objCharactersFoundInTexts = CreateObject("Scripting.Dictionary")
  Dim intChampionIndex
  Dim intSpellIndex
  For index = 0 To NumberOfParts - 1
    tmp = objDataFile.Read(4)
    If tmp <> HeaderPartIDs(index) Then
      MsgBox "The ID of block " & index & " in the file does not correspond to header block declaration"
    End If

    tmp = ReadDWordOfData

    If tmp <> HeaderPartIndex(index) Then
      MsgBox "The index of block " & index & " in the file does not correspond to header block declaration"
    End If

    Select Case HeaderPartIDs(index)
    Case "MAPD"
      ' Read tiles from TITLE.CG
      Dim fTitleCG
      Set fTitleCG = objFileSystemObject.OpenTextFile(pstrFolder & "\" & pstrFileName & "\..\TITLE.CG", ForReading, False)
      Dim TitleCG(5248), intX, intY
      For j = 0 To UBound(TitleCG)
        Set TitleCG(j) = New Image
        TitleCG(j).SetProperties 8, 8, 4
        For intY = 0 To 7
          For intX = 0 To 3
            tmp = Asc(fTitleCG.Read(1))
            TitleCG(j).SetPixel 2 * intX, intY, (tmp And &HF0) \ 16
            TitleCG(j).SetPixel 2 * intX + 1, intY, (tmp And &H0F)
          Next
        Next
      Next
      fTitleCG.Close

      ' Read tilemaps in MAPD item
      Dim TitleTilemaps(4, 3585)
      objDataFile.Read(56)
      For k = 0 To 4
        objDumpFile.WriteLine "TitleTilemaps"
        For j = 0 To 1792
          TitleTilemaps(k, 2 * j) = ReadWordOfData
          TitleTilemaps(k, 2 * j + 1) = ReadWordOfData

          objDumpFile.WriteLine TitleTilemaps(k, 2 * j) & vbTab & _
                          TitleTilemaps(k, 2 * j + 1) & vbTab & _
                          (TitleTilemaps(k, 2 * j + 1) And &H01FF) & vbTab & _
                          (TitleTilemaps(k, 2 * j + 1) And &HFE00) \ 256
        Next
      Next

      Set objOutputPalette = LoadSaturnPalette(objDataFile, 16, BIG_ENDIAN)

      Dim xOutput, yOutput, intTileIndex
      Set objOutputImage = New Image
      objOutputImage.SetProperties 64*8, 28*8, 4
      For j = 0 To 4
        For yOutput = 0 To 27
          For xOutput = 0 To 63
            intTileIndex = (TitleTilemaps(j, (2 * (yOutput * 64 + xOutput)) + 3) And &H7FFF) - 4608
            objOutputImage.PutImage 8 * xOutput, 8 * yOutput, TitleCG(intTileIndex), False, False
          Next
        Next

        If Not objFileSystemObject.FolderExists(pstrOutputFolder & pstrFileName & "-TITLE.CG - Decoded") Then
          objFileSystemObject.CreateFolder(pstrOutputFolder & pstrFileName & "-TITLE.CG - Decoded")
        End If

        objOutputImage.ExportToBMP pstrOutputFolder & pstrFileName & "-TITLE.CG - Decoded\Item" & j & ".bmp", objOutputPalette
      Next

    Case "PALT"
      Dim objPALT, objPALTImage
      Set objPALT = LoadSaturnPalette(objDataFile, 256, BIG_ENDIAN)
      Set objPALTImage = New Image
      objPALTImage.SetProperties 16, 16, 8
      For j = 0 To 15
        For k = 0 To 15
          objPALTImage.SetPixel j, k, 16 * j + k
        Next
      Next
      objPALTImage.ExportToBMP pstrOutputFolder & pstrFileName & " - Decoded\PALT" & index & ".bmp", objPALT

    Case "FONT"
      Dim intNumberOfCharacters, intCharacterWidth, intCharacterHeight, intBytesPerLine

      objDataFile.Read(12)
      intNumberOfCharacters = ReadWordOfData
      intCharacterWidth = ReadWordOfData
      intCharacterHeight = ReadWordOfData
      ReadWordOfData
      Set objOutputPalette = LoadSaturnPalette(objDataFile, 4, BIG_ENDIAN)
      
      If (intCharacterWidth Mod 4) <> 0 Then
        intBytesPerLine = (intCharacterWidth \ 4) + 1
      Else
        intBytesPerLine = intCharacterWidth \ 4
      End If
      
      Set objOutputImage = New Image
      objOutputImage.SetProperties intCharacterWidth, intNumberOfCharacters * intCharacterHeight, 4
      For j = 0 To objOutputImage.Height - 1
        tmp = 0
        For k = 0 To intBytesPerLine - 1
          tmp = tmp * 256 + ReadByteOfData
        Next
        For k = 0 To intCharacterWidth - 1
          objOutputImage.SetPixel k, j, 3 - ((tmp \ 2^(8*intBytesPerLine - 2 - 2 * k)) And &H03)
        Next
      Next
      objOutputImage.ExportToBMP pstrOutputFolder & pstrFileName & " - Decoded\FONT" & index & ".bmp", objOutputPalette

      Dim objCharacterImage, intPixelX, intPixelY
      Set objCharacterImage = New Image
      objCharacterImage.SetProperties intCharacterWidth, intCharacterHeight, 4
      For j = 0 To intNumberOfCharacters - 1
        For intPixelY = 0 To intCharacterHeight - 1
          For intPixelX = 0 To intCharacterWidth - 1
            objCharacterImage.SetPixel intPixelX, intPixelY, objOutputImage.GetPixel(intPixelX, intCharacterHeight * j + intPixelY)
          Next
        Next
        objCharacterImage.ExportToBMP pstrOutputFolder & pstrFileName & " - Decoded\FONT" & index & "-" & Pad(j, 3, "0") & ".bmp", objOutputPalette
      Next

    'Case "CRET"
      ' Not yet implemented. Most probably creatures descriptors (96 bytes entries)

    Case "SPLL"
      ' Not yet implemented. Spell descriptors
      For intSpellIndex = 0 To 24
        For j = 0 To 27
          arrSPLLSpellDescriptors(intSpellIndex, j) = ReadByteOfData
        Next
      Next

      'Output spell descriptors
      Set fItem = objFileSystemObject.OpenTextFile(pstrOutputFolder & pstrFileName & " - Decoded\SPLL" & index & " (Spell descriptors).htm", ForWriting, True)
      fItem.WriteLine "<html><head>" & vbCrLf & _
                      "<meta http-equiv=""Content-Type"" content=""text/html; charset=utf-8"" />" & _
                      "</head><body><h1>Spell descriptors</h1>"
      fItem.WriteLine "<table>" & vbCrLf & "<tr><th>Index</th><th>Symbols (images)</th><th>Symbols (text)</th><th>Unknown1?</th><th>Improved skill</th><th>Duration?</th><th>Unknown2?</th><th>Unknown3?</th><th>Unknown4?</th><th>Unknown5?</th><th>Unknown6?</th><th>Spell name (Images)</th><th>Spell name (Text)</th></tr>"

      For intSpellIndex = 0 To 24
        fItem.WriteLine "<tr><td>" & intSpellIndex & "</td>"
        fItem.Write "<td>"
        For j = 0 To 3
          fItem.Write "<img src=""../FONT256.S2D - Decoded/FONT256S2D-" & Pad(arrSPLLSpellDescriptors(intSpellIndex, j), 3, "0") & ".bmp"" />"
        Next
        fItem.WriteLine "</td>"
        fItem.Write "<td>"
        For j = 0 To 3
          fItem.Write arrFont256S2DUTF8Chars(arrSPLLSpellDescriptors(intSpellIndex, j))
        Next
        fItem.WriteLine "</td>"
        For j = 4 To 11
          fItem.Write "<td>"
          fItem.Write arrSPLLSpellDescriptors(intSpellIndex, j)
          fItem.Write "</td>"
        Next

        fItem.Write "<td>"
        For j = 12 To 26  ' Byte 27 is 00 and marks the end of string
          fItem.Write "<img src=""../FONT256.S2D - Decoded/FONT256S2D-" & Pad(arrSPLLSpellDescriptors(intSpellIndex, j), 3, "0") & ".bmp"" />"
        Next
        fItem.WriteLine "</td>"
        fItem.Write "<td>"
        For j = 12 To 26
          fItem.Write arrFont256S2DUTF8Chars(arrSPLLSpellDescriptors(intSpellIndex, j))
        Next
        fItem.WriteLine "</td>"

      Next
      fItem.WriteLine "</table>"
      fItem.Close

    Case "PLRD"
      ' Champions descriptors. Champion names can be decoded using table in TABL
      For intChampionIndex = 0 To 19
        For j = 0 To 5
          arrPLRDChampionDescriptors(intChampionIndex, j) = ReadByteOfData
        Next
        For j = 6 To 8
          arrPLRDChampionDescriptors(intChampionIndex, j) = ReadWordOfData
        Next
        For j = 9 To 20
          arrPLRDChampionDescriptors(intChampionIndex, j) = ReadByteOfData
        Next
        For j = 21 To 40
          arrPLRDChampionDescriptors(intChampionIndex, j) = ReadWordOfData
        Next
      Next

    Case "TABL"
      ' Not yet implemented. Table for text encoding translation byte -> code
      ' Used for champion names in PLRD item and for spell names in SPLL item
      For j = 0 To 215
        arrTABLData(j) = Pad(Hex(ReadByteOfData), 2, "0")
        If arrTABLData(j) = "00" Then
          arrTABLData(j) = Pad(Hex(ReadByteOfData), 2, "0")
        Else
          arrTABLData(j) = arrTABLData(j) & Pad(Hex(ReadByteOfData), 2, "0")
        End If
      Next

      'Output champion descriptors
      Set fItem = objFileSystemObject.OpenTextFile(pstrOutputFolder & pstrFileName & " - Decoded\PLRD" & index & " (Champion descriptors).htm", ForWriting, True)
      fItem.WriteLine "<html><head>" & vbCrLf & _
                      "<meta http-equiv=""Content-Type"" content=""text/html; charset=utf-8"" />" & _
                      "</head><body><h1>Champion descriptors</h1>"
      fItem.WriteLine "<table>" & vbCrLf & "<tr><th>Index</th><th>Champion Name (images)</th><th>Champion Name (text)</th><th>Health</th><th>Stamina</th><th>Mana</th><th>Luck</th><th>Strength</th><th>Dexterity</th><th>Wisdom</th><th>Vitality</th><th>Anti-Magic</th><th>Anti-Fire</th><th>Fighter level</th><th>Ninja level</th><th>Priest level</th><th>Wizard level</th><th>Genre</th><th>Item in left hand</th><th>Item in right hand</th><th>Item in head</th><th>Item in torso</th><th>Item in legs</th><th>Item in feet</th><th>Item in neck</th><th>Item in backpack 1</th><th>Item in backpack 2</th><th>Item in backpack 3</th></tr>"

      For intChampionIndex = 0 To 19
        fItem.WriteLine "<tr><td>" & intChampionIndex & "</td>"
        fItem.Write "<td>"
        For j = 0 To 5
          fItem.Write objCharactersDictionaryHTML(arrTABLData(arrPLRDChampionDescriptors(intChampionIndex, j)))
        Next
        fItem.WriteLine "<br>"
        For j = 0 To 5
          fItem.Write "<img src=""../FONT256.S2D - Decoded/FONT256S2D-" & Pad(arrPLRDChampionDescriptors(intChampionIndex, j), 3, "0") & ".bmp"" />"
        Next

        fItem.WriteLine "</td>"
        fItem.Write "<td>"
        For j = 0 To 5
          fItem.Write objCharactersDictionary(arrTABLData(arrPLRDChampionDescriptors(intChampionIndex, j)))
        Next
        fItem.WriteLine "</td>"
        For j = 6 To 15
          fItem.Write "<td>" & arrPLRDChampionDescriptors(intChampionIndex, j) & "</td>"
        Next
        Dim arrLevelNames
        arrLevelNames = Array("-", "Neophyte", "Novice", "Apprentice", "Journeyman", "Craftsman", "Artisan", "Adept", "Expert", _
                              "<Lo> Master", "<Um> Master", "<On> Master", "<Ee> Master", "<Pal> Master", "<Mon> Master", "Archmaster")
        For j = 16 To 19
          fItem.Write "<td>"
          fItem.Write arrPLRDChampionDescriptors(intChampionIndex, j) & " " & arrLevelNames(arrPLRDChampionDescriptors(intChampionIndex, j))
          fItem.Write "</td>"
        Next

        Select Case arrPLRDChampionDescriptors(intChampionIndex, 20)
          Case 0
            fItem.WriteLine "<td>Male</td>"
          Case 1
            fItem.WriteLine "<td>Female</td>"
          Case 2
            fItem.WriteLine "<td>Animal</td>"
        End Select
        For j = 21 To 39 Step 2
          If arrPLRDChampionDescriptors(intChampionIndex, j) = 65535 Then
            fItem.Write "<td>-</td>"
          Else
            fItem.Write "<td>" & arrPLRDChampionDescriptors(intChampionIndex, j) & "</td>"
          End If
        Next

        fItem.WriteLine "</tr>"
      Next
      fItem.WriteLine "</table>"
      fItem.Close

    Case "TEXT"
      Set fItem = objFileSystemObject.OpenTextFile(pstrOutputFolder & pstrFileName & " - Decoded\TEXT" & index & ".htm", ForWriting, True)
      fItem.Write "<html><head>" & vbCrLf & _
                      "<meta http-equiv=""Content-Type"" content=""text/html; charset=utf-8"" />" & _
                      "</head><body><h1>"
      Select Case index
        Case 3
          fItem.WriteLine "Strings for item names, descriptions, actions L1, L2 and L3</h1>"
        Case 4
          fItem.WriteLine "Strings for menu options</h1>"
        Case 5
          fItem.WriteLine "Strings for dungeon texts (wall inscriptions, character speech)</h1>"
        Case 6
          fItem.WriteLine "Unknown Strings</h1>"
        Case 7
          fItem.WriteLine "Strings for technical messages</h1>"
      End Select
      
      intNumberOfStrings = ReadWordOfData
      objDumpFile.WriteLine
      objDumpFile.WriteLine "**************************************"
      objDumpFile.WriteLine "intNumberOfStrings: " & intNumberOfStrings
      
      ReDim arrStringsOffsets(intNumberOfStrings - 1)
      For j = 0 To intNumberOfStrings - 1
        arrStringsOffsets(j) = ReadWordOfData
      Next
      intTextDataSize = HeaderPartOffsets(index + 1) - HeaderPartOffsets(index) - 8 - 2 - (2 * intNumberOfStrings)

      objDumpFile.WriteLine "intTextDataSize: " & intTextDataSize
      ReDim arrTextData(intTextDataSize - 1)
      For j = 0 To intTextDataSize - 1
        arrTextData(j) = ReadByteOfData
      Next

      arrCurrentStringArray = arrStrings(index - 3)
      For j = 0 To intNumberOfStrings - 1
        objDumpFile.WriteLine

        objDumpFile.WriteLine
        Dim strNextChar
        k = arrStringsOffsets(j) - 2 - 2 * intNumberOfStrings 
        strNextChar = ""
        arrCurrentStringArray(j) = ""
        Dim blnEndOfString
        blnEndOfString = False
        While Not blnEndOfString
          If strNextChar = "E0" Or _
             strNextChar = "E1" Or _
             strNextChar = "E2" Or _
             strNextChar = "E3" Or _
             strNextChar = "E4" Then
            strNextChar = strNextChar & Pad(Hex(arrTextData(k)), 2, "0")
            objDumpFile.WriteLine strNextChar
            arrCurrentStringArray(j) = arrCurrentStringArray(j) & strNextChar & "|"
            AddInDictionaryAndCount objCharactersFoundInTexts, strNextChar
            strNextChar = ""
          ElseIf strNextChar = "03" Then
            strNextChar = strNextChar & Pad(Hex(arrTextData(k)), 2, "0")
          ElseIf Left(strNextChar, 4) = "0306" Then
            If Len(strNextChar) < 12 Then
              strNextChar = strNextChar & Pad(Hex(arrTextData(k)), 2, "0")
            Else
              objDumpFile.WriteLine strNextChar
              arrCurrentStringArray(j) = arrCurrentStringArray(j) & strNextChar & "|"
              AddInDictionaryAndCount objCharactersFoundInTexts, strNextChar
              strNextChar = Pad(Hex(arrTextData(k)), 2, "0")
            End If
          ElseIf Left(strNextChar, 4) = "0308" Then
            If Len(strNextChar) < 8 Then
              strNextChar = strNextChar & Pad(Hex(arrTextData(k)), 2, "0")
            Else
              objDumpFile.WriteLine strNextChar
              arrCurrentStringArray(j) = arrCurrentStringArray(j) & strNextChar & "|"
              AddInDictionaryAndCount objCharactersFoundInTexts, strNextChar
              strNextChar = Pad(Hex(arrTextData(k)), 2, "0")
            End If
          ElseIf Left(strNextChar, 4) = "0309" Then
            If Len(strNextChar) < 20 Then
              strNextChar = strNextChar & Pad(Hex(arrTextData(k)), 2, "0")
            Else
              objDumpFile.WriteLine strNextChar
              arrCurrentStringArray(j) = arrCurrentStringArray(j) & strNextChar & "|"
              AddInDictionaryAndCount objCharactersFoundInTexts, strNextChar
              strNextChar = Pad(Hex(arrTextData(k)), 2, "0")
            End If
          ElseIf strNextChar = "0303" Then
            objDumpFile.WriteLine strNextChar
            arrCurrentStringArray(j) = arrCurrentStringArray(j) & strNextChar & "|"
            AddInDictionaryAndCount objCharactersFoundInTexts, strNextChar
            strNextChar = ""
            strNextChar = Pad(Hex(arrTextData(k)), 2, "0")
          ElseIf strNextChar = "0300" Then
            strNextChar = strNextChar & Pad(Hex(arrTextData(k)), 2, "0")
            objDumpFile.WriteLine strNextChar
            arrCurrentStringArray(j) = arrCurrentStringArray(j) & strNextChar & "|"
            AddInDictionaryAndCount objCharactersFoundInTexts, strNextChar
            strNextChar = ""
          ElseIf strNextChar = "00" Then
            blnEndOfString = True
          ElseIf strNextChar = "" Then
            strNextChar = Pad(Hex(arrTextData(k)), 2, "0")
          Else
            objDumpFile.WriteLine strNextChar
            arrCurrentStringArray(j) = arrCurrentStringArray(j) & strNextChar & "|"
            AddInDictionaryAndCount objCharactersFoundInTexts, strNextChar
            strNextChar = ""
            strNextChar = Pad(Hex(arrTextData(k)), 2, "0")
          End If
          
          k = k + 1
        Wend
        arrCurrentStringArray(j) = arrCurrentStringArray(j) & "00"
        objDumpFile.WriteLine "Full string: " & arrCurrentStringArray(j)

        fItem.WriteLine "<h3>String " & j & "</h3>"
        'fItem.WriteLine "<p>Raw string: " & arrCurrentStringArray(j) & "</p>"
        Dim arrCodes
        arrCodes = Split(arrCurrentStringArray(j), "|")

        fItem.Write "<p>"
        For k = 0 To UBound(arrCodes)
          If objCharactersDictionaryHTML.Exists(arrCodes(k)) Then
            fItem.Write objCharactersDictionaryHTML(arrCodes(k)) '& " "
          ElseIf Left(arrCodes(k), 4) = "0306" Then
            fItem.Write "{Move Cursor To X=" & CLng("&H" & Mid(arrCodes(k), 5, 4)) & ", Y=" & CLng("&H" & Mid(arrCodes(k), 9, 4)) &  "}"
          ElseIf Left(arrCodes(k), 4) = "0309" Then
            fItem.Write "{Set Box X1=" & CLng("&H" & Mid(arrCodes(k), 5, 4)) & ", Y1=" & CLng("&H" & Mid(arrCodes(k), 9, 4)) & ", X2=" & CLng("&H" & Mid(arrCodes(k), 13, 4)) & ", Y2=" & CLng("&H" & Mid(arrCodes(k), 17, 4)) & "}"
          Else
            fItem.Write "[" & arrCodes(k) & "]"
          End If
        Next
        fItem.WriteLine "</p>"

        fItem.Write "<p>"
        For k = 0 To UBound(arrCodes)
          If objCharactersDictionary.Exists(arrCodes(k)) Then
            fItem.Write objCharactersDictionary(arrCodes(k)) '& " "
          ElseIf Left(arrCodes(k), 4) = "0306" Then
            fItem.Write "{Move Cursor To X=" & CLng("&H" & Mid(arrCodes(k), 5, 4)) & ", Y=" & CLng("&H" & Mid(arrCodes(k), 9, 4)) &  "}"
          ElseIf Left(arrCodes(k), 4) = "0309" Then
            fItem.Write "{Set Box X1=" & CLng("&H" & Mid(arrCodes(k), 5, 4)) & ", Y1=" & CLng("&H" & Mid(arrCodes(k), 9, 4)) & ", X2=" & CLng("&H" & Mid(arrCodes(k), 13, 4)) & ", Y2=" & CLng("&H" & Mid(arrCodes(k), 17, 4)) & "}"
          Else
            fItem.Write "[" & arrCodes(k) & "]"
          End If
        Next
        fItem.WriteLine "</p>"
      Next
      fItem.WriteLine "</body></html>"

      objDumpFile.WriteLine "Report of all characters used:"
      Dim varValue
      For Each varValue In objCharactersFoundInTexts
        objDumpFile.WriteLine varValue & vbTab & objCharactersFoundInTexts(varValue)
      Next

    Case "DGT2", "TITL", "CNFD"
      DecodePP objDataFile.Read(2), pstrOutputFolder & pstrFileName & " - Decoded\Item " & index & "-" & HeaderPartIDs(index) & " " & HeaderPartIndex(index) & ".bmp"
      Dim UnusedTrailingWord
      UnusedTrailingWord = ReadWordOfData
      objDumpFile.WriteLine "UnusedTrailingWord:" & UnusedTrailingWord

    Case Else
      If index <> NumberOfParts - 1 Then
        Set fItem = objFileSystemObject.OpenTextFile(pstrOutputFolder & pstrFileName & " - Decoded\Item " & index & "-" & HeaderPartIDs(index) & " " & HeaderPartIndex(index) & ".bin", ForWriting, True)
        fItem.Write objDataFile.Read(HeaderPartOffsets(index + 1) - HeaderPartOffsets(index) - 8)
        fItem.Close
      Else
        Set fItem = objFileSystemObject.OpenTextFile(pstrOutputFolder & pstrFileName & " - Decoded\Item " & index & "-" & HeaderPartIDs(index) & " " & HeaderPartIndex(index) & ".bin", ForWriting, True)
        fItem.Write objDataFile.Read(FileSize - HeaderPartOffsets(index) - 8)
        fItem.Close
      End If
    End Select
  Next


	objDataFile.Close
	objDumpFile.Close
End Sub

Function DecodeCharacter(pstrString)
  Select Case Left(pstrString, 2)
    Case "E0"
    Case "E1"
    Case "E2", "E3", "E4"
      DecodeCharacter = "FONT2-" & Pad(CLng("&H" & pstrString) - CLng("&HE200"), 3, "0")
    Case "03"
      Select Case Left(pstrString, 4)
        Case "0300"
          DecodeCharacter = "Color: " 
        Case "0303"
          DecodeCharacter = "<br />"
        Case "0306"
        Case "0308"
        Case "0309"
        Case Else
      End Select
    Case Else
  End Select

  If strNextChar = "E0" Or _
     strNextChar = "E1" Or _
     strNextChar = "E2" Or _
     strNextChar = "E3" Or _
     strNextChar = "E4" Then
    strNextChar = strNextChar & Pad(Hex(arrTextData(k)), 2, "0")
    objDumpFile.WriteLine strNextChar
    AddInDictionaryAndCount objCharactersFoundInTexts, strNextChar
    strNextChar = ""
  ElseIf strNextChar = "03" Then
    strNextChar = strNextChar & Pad(Hex(arrTextData(k)), 2, "0")
  ElseIf Left(strNextChar, 4) = "0306" Then
    If Len(strNextChar) < 12 Then
      strNextChar = strNextChar & Pad(Hex(arrTextData(k)), 2, "0")
    Else
      objDumpFile.WriteLine strNextChar
      AddInDictionaryAndCount objCharactersFoundInTexts, strNextChar
      strNextChar = Pad(Hex(arrTextData(k)), 2, "0")
    End If
  ElseIf Left(strNextChar, 4) = "0308" Then
    If Len(strNextChar) < 8 Then
      strNextChar = strNextChar & Pad(Hex(arrTextData(k)), 2, "0")
    Else
      objDumpFile.WriteLine strNextChar
      AddInDictionaryAndCount objCharactersFoundInTexts, strNextChar
      strNextChar = Pad(Hex(arrTextData(k)), 2, "0")
    End If
  ElseIf Left(strNextChar, 4) = "0309" Then
    If Len(strNextChar) < 20 Then
      strNextChar = strNextChar & Pad(Hex(arrTextData(k)), 2, "0")
    Else
      objDumpFile.WriteLine strNextChar
      AddInDictionaryAndCount objCharactersFoundInTexts, strNextChar
      strNextChar = Pad(Hex(arrTextData(k)), 2, "0")
    End If
  ElseIf strNextChar = "0303" Then
    objDumpFile.WriteLine strNextChar
    AddInDictionaryAndCount objCharactersFoundInTexts, strNextChar
    strNextChar = ""
    strNextChar = Pad(Hex(arrTextData(k)), 2, "0")
  ElseIf strNextChar = "0300" Then
    strNextChar = strNextChar & Pad(Hex(arrTextData(k)), 2, "0")
    objDumpFile.WriteLine strNextChar
    AddInDictionaryAndCount objCharactersFoundInTexts, strNextChar
    strNextChar = ""
  ElseIf strNextChar = "" Then
    strNextChar = Pad(Hex(arrTextData(k)), 2, "0")
  Else
    objDumpFile.WriteLine strNextChar
    AddInDictionaryAndCount objCharactersFoundInTexts, strNextChar
    strNextChar = ""
    strNextChar = Pad(Hex(arrTextData(k)), 2, "0")
  End If
End Function

Sub AddInDictionaryAndCount(objDictionary, varValue)
  If Not objDictionary.Exists(varValue) Then
    objDictionary.Add varValue, 1
  Else
    objDictionary(varValue) = objDictionary(varValue) + 1
  End If
End Sub

Sub DecodeRawPPpp(pstrFolder, pstrFileName, pstrOutputFolder)
	Set objDataFile = objFileSystemObject.OpenTextFile(pstrFolder & "\" & pstrFileName, ForReading, False)

	If Not objFileSystemObject.FolderExists(pstrOutputFolder & pstrFileName & " - Decoded") Then
		objFileSystemObject.CreateFolder(pstrOutputFolder & pstrFileName & " - Decoded")
	End If

	Set objDumpFile = objFileSystemObject.OpenTextFile(pstrOutputFolder & pstrFileName & " - Decoded\zzzz Dump.txt", ForWriting, True)

  Dim index
  index = 0
  While Not objDataFile.AtEndOfStream
    DecodePP objDataFile.Read(2), pstrOutputFolder & pstrFileName & " - Decoded\Item " & index & ".bmp"
    index = index + 1
  Wend
End Sub

Sub DecodePP(pstrType, pstrOutputFileName)
' pstrType can be 'PP' (256 colors palette, 8bpp) or 'pp' (16 colors palette, 4bpp)
  Dim ImageWidth, ImageHeight
  Dim tmp
  Dim UnusedTrailingWord

  Dim objPalette, objImage

  ImageWidth = ReadWordOfData
  ImageHeight = ReadWordOfData
  objDumpFile.WriteLine "Image dimensions: " & ImageWidth & "x" & ImageHeight
  Set objImage = New Image

  Select Case pstrType
  Case "PP"
    Set objPalette = LoadSaturnPalette(objDataFile, 256, BIG_ENDIAN)

    objImage.SetProperties ImageWidth, ImageHeight, 8
    For j = 0 To ImageHeight - 1
      For k = 0 To ImageWidth - 1
        objImage.SetPixel k, j, ReadByteOfData
      Next
    Next
    objImage.ExportToBMP pstrOutputFileName, objPalette
    
  Case "pp"
    Set objPalette = LoadSaturnPalette(objDataFile, 16, BIG_ENDIAN)

    objImage.SetProperties ImageWidth, ImageHeight, 4
    For j = 0 To ImageHeight - 1
      For k = 0 To (ImageWidth / 2) - 1
        tmp = ReadByteOfData
        objImage.SetPixel 2 * k, j, (tmp \ 16) And &H0F
        objImage.SetPixel 2 * k + 1, j, tmp And &H0F
      Next
    Next
    objImage.ExportToBMP pstrOutputFileName, objPalette


  Case Else
    Msgbox "DecodePP - ImageType is not valid: " & pstrType
  End Select
End Sub

Sub DecodeFACEBIN(pstrFolder, pstrFileName, pstrOutputFolder)
	Set objDataFile = objFileSystemObject.OpenTextFile(pstrFolder & "\" & pstrFileName, ForReading, False)

	If Not objFileSystemObject.FolderExists(pstrOutputFolder & pstrFileName & " - Decoded") Then
		objFileSystemObject.CreateFolder(pstrOutputFolder & pstrFileName & " - Decoded")
	End If

	Set objDumpFile = objFileSystemObject.OpenTextFile(pstrOutputFolder & pstrFileName & " - Decoded\zzzz Dump.txt", ForWriting, True)

  objDumpFile.WriteLine "Block ID: " & objDataFile.Read(4)
  Dim intFileSize
  intFileSize = ReadDWordOfData
  objDumpFile.WriteLine "Block size (file size): " & intFileSize
  objDumpFile.WriteLine "Number of items in file: " & ReadWordOfData
  objDumpFile.WriteLine "Unknown word: " & ReadWordOfData
  objDumpFile.WriteLine "Unknown dword: " & ReadDWordOfData

  Dim arrItemOffsets(19), arrItemSizes(19), intItemIndex
  For intItemIndex = 0 To 19
    arrItemOffsets(intItemIndex) = ReadWordOfData
  Next
  For intItemIndex = 0 To 18
    arrItemSizes(intItemIndex) = arrItemOffsets(intItemIndex + 1) - arrItemOffsets(intItemIndex)
  Next
  arrItemSizes(19) = intFileSize - arrItemOffsets(intItemIndex)

  Dim arrCompressedData, arrUncompressedData, objPalette, objImage
  For intItemIndex = 0 To 19
    objDumpFile.WriteLine "Processing item #" & intItemIndex

    Set objPalette = LoadSaturnPalette(objDataFile, 64, BIG_ENDIAN)
    Set objImage = New Image
    objImage.SetProperties 56, 56, 8

    ReDim arrCompressedData(arrItemSizes(intItemIndex) - 128 - 1)
    Dim intByteIndex
    For intByteIndex = 0 To UBound(arrCompressedData)
      arrCompressedData(intByteIndex) = ReadByteOfData
    Next

    DecodePRS3 arrCompressedData, arrUncompressedData, objDumpFile

    Dim TileX, TileY, PixelX, PixelY
    intByteIndex = 0
    For TileY = 0 To (objImage.Height \ 8) - 1
      For TileX = 0 To (objImage.Width \ 8) - 1
        For PixelY = 0 To 7
          For PixelX = 0 To 7
            objImage.SetPixel 8*TileX + PixelX, 8*TileY + PixelY, arrUncompressedData(intByteIndex)
            intByteIndex = intByteIndex + 1
          Next
        Next
      Next
    Next

    objImage.ExportToBMP pstrOutputFolder & pstrFileName & " - Decoded\ChampionFace" & intItemIndex & ".bmp", objPalette
  Next
End Sub

Sub DecodeDMBIN(pstrFolder, pstrFileName, pstrOutputFolder)
	Set objDataFile = objFileSystemObject.OpenTextFile(pstrFolder & "\" & pstrFileName, ForReading, False)

	If Not objFileSystemObject.FolderExists(pstrOutputFolder & pstrFileName & " - Decoded") Then
		objFileSystemObject.CreateFolder(pstrOutputFolder & pstrFileName & " - Decoded")
	End If

	Set objDumpFile = objFileSystemObject.OpenTextFile(pstrOutputFolder & pstrFileName & " - Decoded\zzzz Dump.txt", ForWriting, True)

  objDataFile.Read(231636)

  Dim j

  Dim objPalette
  Set objPalette = LoadSaturnPalette(objDataFile, 16, BIG_ENDIAN)

  ReDim arrRawData(1012)
  For j = 0 To UBound(arrRawData)
    arrRawData(j) = ReadByteOfData
  Next

  Dim objUncompressedImage
  Set objUncompressedImage = New Image
  objUncompressedImage.SetProperties 128, 64, 8

  Dim arrUnCompressedData
  DecodePRS3 arrRawData, arrUnCompressedData, objDumpFile

  Dim TileX, TileY, PixelX, PixelY
  j = 0
  For TileY = 0 To 7
    For TileX = 0 To 15
      For PixelY = 0 To 7
        For PixelX = 0 To 3
          objUncompressedImage.SetPixel 8 * TileX + 2 * PixelX, 8 * TileY + PixelY, (arrUnCompressedData(j) \ 16) And &H0F
          objUncompressedImage.SetPixel 8 * TileX + 2 * PixelX + 1, 8 * TileY + PixelY, arrUnCompressedData(j) And &H0F
          j = j + 1
        Next
      Next
    Next
  Next
  objUncompressedImage.ExportToBMP pstrOutputFolder & pstrFileName & " - Decoded\PRS3Image.bmp", objPalette

End Sub

Sub DecodeMENUBPK(pstrFolder, pstrFileName, pstrOutputFolder)
	Set objDataFile = objFileSystemObject.OpenTextFile(pstrFolder & "\" & pstrFileName, ForReading, False)

	If Not objFileSystemObject.FolderExists(pstrOutputFolder & pstrFileName & " - Decoded") Then
		objFileSystemObject.CreateFolder(pstrOutputFolder & pstrFileName & " - Decoded")
	End If

	Set objDumpFile = objFileSystemObject.OpenTextFile(pstrOutputFolder & pstrFileName & " - Decoded\zzzz Dump.txt", ForWriting, True)

  objDumpFile.WriteLine "Block signature: " & objDataFile.Read(4)
  objDumpFile.WriteLine "Block size (file size): " & ReadDWordOfData
  objDumpFile.WriteLine "Block attributes: " & ReadDWordOfData
  
  objDumpFile.WriteLine "Item1 signature: " & objDataFile.Read(4)
  Dim intItem1Size
  intItem1Size = ReadDWordOfData
  objDumpFile.WriteLine "Item1 size: " & intItem1Size
  Dim intNumberOfItem1Entries
  intNumberOfItem1Entries = ReadDWordOfData
  objDumpFile.WriteLine "Number of entries in Item1: " & intNumberOfItem1Entries

  Dim Item1Offsets()
  ReDim Item1Offsets(intNumberOfItem1Entries - 1)
  For index = 0 To UBound(Item1Offsets)
    Item1Offsets(index) = ReadDWordOfData
  Next
  
  ReadDWordOfData  ' 0 after list of offsets
  
  Dim Item1Sizes(), intSumOfSizes
  ReDim Item1Sizes(intNumberOfItem1Entries - 1)
  intSumOfSizes = 0
  For index = 0 To UBound(Item1Sizes) - 1
    Item1Sizes(index) = Item1Offsets(index + 1) - Item1Offsets(index)
    intSumOfSizes = intSumOfSizes + Item1Sizes(index)
    objDumpFile.WriteLine Item1Sizes(index)
  Next
  Item1Sizes(UBound(Item1Sizes)) = intItem1Size - intSumOfSizes - 668
  objDumpFile.WriteLine Item1Sizes(UBound(Item1Sizes))

  Dim ItemRawData(), FullItemData, fItem
  Dim arrUnCompressedImages
  ReDim arrUnCompressedImages(intNumberOfItem1Entries - 1)
  For index = 0 To intNumberOfItem1Entries - 1
    If index = 0 Then
      Dim objOutputImage, objOutputPalette
      Set objOutputImage = New Image
      objOutputImage.SetProperties 4, 50, 8
      Set objOutputPalette = New Palette
      objOutputPalette.SetProperties 256, 8
      objOutputPalette.SetColor 0, 0, 0, 0, 0
      objOutputPalette.SetColor 1, 215, 215, 215, 0
      objOutputPalette.SetColor 3, 255, 255, 255, 0
      objDataFile.Read(8)
      For j = 0 To 49
        For k = 0 To 3
          objOutputImage.SetPixel k, j, ReadByteOfData
        Next
      Next
      objOutputImage.ExportToBMP pstrOutputFolder & pstrFileName & " - Decoded\Item " & index & ".bmp", objOutputPalette
    Else
      Dim j

      Dim objPalette
      Set objPalette = New Palette
      objPalette.SetProperties 256, 8
      
      Dim intImaWidth, intImaHeight, intUnknownDword
      intImaWidth = ReadWordOfData
      intImaHeight = ReadWordOfData
      intUnknownDword = ReadDWordOfData

      'If ((intImaWidth Mod 8) <> 0) Or ((intImaHeight Mod 8) <> 0) Then
      '  MsgBox index & vbCrLf & _
      '         "intImaWidth : " & intImaWidth & vbCrLf & _
      '         "intImaHeight : " & intImaHeight
      'End If

      Dim strRawData
      ReDim ItemRawData(Item1Sizes(index) - 9)
      strRawData = ""
      For j = 0 To UBound(ItemRawData)
        ItemRawData(j) = ReadByteOfData
        strRawData = strRawData & Chr(ItemRawData(j))
      Next

      'Set fItem = objFileSystemObject.OpenTextFile(pstrOutputFolder & pstrFileName & " - Decoded\PRS3Item " & index & ".bin", ForWriting, True)
      'fItem.Write strRawData
      'fItem.Close

      objDumpFile.WriteLine "Image #" & index & vbTab & Item1Sizes(index) & vbTab & _
                            intImaWidth & vbTab & _
                            intImaHeight & vbTab & _
                            intUnknownDword & vbTab & _
                            ItemRawData(0) & " " & ItemRawData(1) & " " & ItemRawData(2) & " " & ItemRawData(3) & vbTab & _
                            ItemRawData(4) * 2^24 + ItemRawData(5) * 2^16 + ItemRawData(6) * 2^8 + ItemRawData(7) & vbTab & _
                            ItemRawData(8) * 2^24 + ItemRawData(9) * 2^16 + ItemRawData(10) * 2^8 + ItemRawData(11) & vbTab & _
                            ItemRawData(12) * 2^24 + ItemRawData(13) * 2^16 + ItemRawData(14) * 2^8 + ItemRawData(15) & vbTab & _
                            IntToBin(ItemRawData(16), 8) & vbTab & _
                            IntToBin(ItemRawData(17), 8) & vbTab & _
                            ItemRawData(18) & vbTab & _
                            ItemRawData(19) & vbTab & _
                            ItemRawData(20) & vbTab & _
                            ItemRawData(21) & vbTab & _
                            ItemRawData(22) & vbTab & _
                            ItemRawData(23)

      Dim arrUnCompressedImage
      DecodePRS3 ItemRawData, arrUnCompressedImage, objDumpFile

      Dim objUncompressedImage
      Set objUncompressedImage = New Image
      objUncompressedImage.SetProperties intImaWidth, intImaHeight, 8

      Dim PixelX, PixelY
      j = 0
      For PixelY = 0 To objUncompressedImage.Height - 1
        For PixelX = 0 To objUncompressedImage.Width - 1
          objUncompressedImage.SetPixel PixelX, PixelY, arrUnCompressedImage(j)
          j = j + 1
        Next
      Next

      Set arrUnCompressedImages(index) = objUncompressedImage

      'Set fItem = objFileSystemObject.OpenTextFile(pstrOutputFolder & pstrFileName & " - Decoded\Item " & index & ".bin", ForWriting, True)
      'ReDim ItemRawData(Item1Sizes(index) - 1)
      'FullItemData = ""
      'For j = 0 To UBound(ItemRawData)
      '  ItemRawData(j) = ReadByteOfData
      '  FullItemData = FullItemData & Chr(ItemRawData(j))
      'Next

      'fItem.Write FullItemData

      'fItem.Close
    End If
  Next
  
  ' Read PALT item at the end of the file
  objDataFile.Read(12) ' PALT header
  Dim objPALT, objPALTImage
  Set objPALT = LoadSaturnPalette(objDataFile, 256, BIG_ENDIAN)
  'Set objPALTImage = New Image
  'objPALTImage.SetProperties 16, 16, 8
  'For j = 0 To 15
  '  For k = 0 To 15
  '    objPALTImage.SetPixel j, k, 16 * j + k
  '  Next
  'Next
  'objPALTImage.ExportToBMP pstrOutputFolder & pstrFileName & " - Decoded\PALT.bmp", objPALT


  Dim objImageToExport
  For index = 1 To intNumberOfItem1Entries - 1    ' The first entry is not compressed
    Set objImageToExport = arrUnCompressedImages(index)
    objImageToExport.ExportToBMP pstrOutputFolder & pstrFileName & " - Decoded\PRS3Item" & index & ".bmp", objPALT
  Next

  objDataFile.Close
  objDumpFile.Close
End Sub

Sub DecodePRS3(parrCompressedBytes, parrUnCompressedBytes, pobjDumpFile)
  Dim j, k
  Dim intCompressedPosition, intUnCompressedPosition, intControlByte, intControlBit
  Dim intByte1, intByte2, intNumberOfPixels, intRelativeOffset
  intCompressedPosition = 0
  intUnCompressedPosition = 0

  If (parrCompressedBytes(0) <> Asc("P")) Or _
     (parrCompressedBytes(1) <> Asc("R")) Or _
     (parrCompressedBytes(2) <> Asc("S")) Or _
     (parrCompressedBytes(3) <> Asc("3")) Or _
     (parrCompressedBytes(4) <> 0) Or _
     (parrCompressedBytes(5) <> 0) Or _
     (parrCompressedBytes(6) <> 0) Or _
     (parrCompressedBytes(7) <> 1) Then
     MsgBox "Not a PRS3 item !"
  End If

  Dim intCompressedDataSize, intUncompressedDataSize
  intUncompressedDataSize = (parrCompressedBytes(8) * 256 + parrCompressedBytes(9)) * 65536 + (parrCompressedBytes(10) * 256 + parrCompressedBytes(11))
  intCompressedDataSize = (parrCompressedBytes(12) * 256 + parrCompressedBytes(13)) * 65536 + (parrCompressedBytes(14) * 256 + parrCompressedBytes(15))

  ReDim parrUnCompressedBytes(intUncompressedDataSize - 1)

  pobjDumpFile.WriteLine "[DecodePRS3] Uncompressed data size: " & intUncompressedDataSize & vbCrLf & _
                         "[DecodePRS3] Compressed data size: " & intCompressedDataSize

  intCompressedPosition = 16  ' First byte of compressed data
  Dim intLineNumber
  intLineNumber = 1
  While intUnCompressedPosition < intUncompressedDataSize
    intControlByte = parrCompressedBytes(intCompressedPosition)

'    pobjDumpFile.WriteLine intLineNumber & vbTab & intUnCompressedPosition & vbTab & Pad(Hex(intControlByte), 2, "0")
    intLineNumber = intLineNumber + 1

    intCompressedPosition = intCompressedPosition + 1
    For j = 0 To 7
      intControlBit = (intControlByte \ 2^j) And &H01
'      pobjDumpFile.Write intLineNumber & vbTab & intUnCompressedPosition & vbTab & intControlBit & vbTab

      If intUnCompressedPosition < intUncompressedDataSize Then
        If intControlBit = 1 Then
          parrUnCompressedBytes(intUnCompressedPosition) = parrCompressedBytes(intCompressedPosition)

'          pobjDumpFile.WriteLine Pad(Hex(parrUnCompressedBytes(intUnCompressedPosition)), 2, "0")
          intLineNumber = intLineNumber + 1

          intCompressedPosition = intCompressedPosition + 1
          intUnCompressedPosition = intUnCompressedPosition + 1
        Else
          intByte1 = parrCompressedBytes(intCompressedPosition)
          intByte2 = parrCompressedBytes(intCompressedPosition + 1)

'          pobjDumpFile.Write Pad(Hex(intByte1), 2, "0") & vbTab & Pad(Hex(intByte2), 2, "0")

          intRelativeOffset = ((intByte2 \ 16) And &H0F) * 256 + intByte1
          If intRelativeOffset >= 4060 Then ' &HFDC
            ' This represents a negative offset
            intRelativeOffset = intRelativeOffset - 4096
          End If
          intRelativeOffset = intRelativeOffset + 18
          
          While intUnCompressedPosition - intRelativeOffset > 4095
            intRelativeOffset = intRelativeOffset + 4096
          Wend

          intNumberOfPixels = (intByte2 And &H0F) + 3

          intLineNumber = intLineNumber + 1

          intCompressedPosition = intCompressedPosition + 2
          For k = 1 To intNumberOfPixels
            If ((intRelativeOffset + k - 1) < 0) Then
              parrUnCompressedBytes(intUnCompressedPosition) = 0
            Else
              parrUnCompressedBytes(intUnCompressedPosition) = parrUnCompressedBytes(intRelativeOffset + k - 1)
            End If
            intUnCompressedPosition = intUnCompressedPosition + 1
          Next
        End If
      End If
    Next
  Wend
  pobjDumpFile.Write "[DecodePRS3] Padding bytes: "
  
  If intCompressedDataSize + 16 <= UBound(parrCompressedBytes) Then
    For k = intCompressedDataSize + 16 To UBound(parrCompressedBytes)
      pobjDumpFile.Write Pad(Hex(parrCompressedBytes(k)), 2, "0")
    Next
  Else
    pobjDumpFile.Write "None"
  End If
  pobjDumpFile.WriteLine

  If intUnCompressedPosition <> intUncompressedDataSize Then
    pobjDumpFile.WriteLine  "intUnCompressedPosition : " & intUnCompressedPosition & vbCrLf & _
           "intUncompressedDataSize : " & intUncompressedDataSize
  End If
End Sub

Sub DecodeSTABGBIN(pstrFolder, pstrFileName, pstrOutputFolder)
	Set objDataFile = objFileSystemObject.OpenTextFile(pstrFolder & "\" & pstrFileName, ForReading, False)

	If Not objFileSystemObject.FolderExists(pstrOutputFolder & pstrFileName & " - Decoded") Then
		objFileSystemObject.CreateFolder(pstrOutputFolder & pstrFileName & " - Decoded")
	End If

	Set objDumpFile = objFileSystemObject.OpenTextFile(pstrOutputFolder & pstrFileName & " - Decoded\zzzz Dump.txt", ForWriting, True)

  Dim BlockID, FileSize, OffsetPart1, SizePart1, OffsetPart2, SizePart2, OffsetPart3, SizePart3

  BlockID = objDataFile.Read(4)
  FileSize = ReadDWordOfData
  OffsetPart1 = ReadDWordOfData ' Part 1 is a tilemap (1 word per tile)
  SizePart1 = ReadDWordOfData
  OffsetPart2 = ReadDWordOfData ' Part 2 is a color palette 256 colors, 1 word per color, 5 bits per component RGB + bit 15 ignored
  SizePart2 = ReadDWordOfData
  OffsetPart3 = ReadDWordOfData ' Part 3 is a tileset (8x8 pixels tiles, 1 byte per pixel which is the index in the 256 colors palette)
  SizePart3 = ReadDWordOfData

	objDumpFile.WriteLine "BlockID: " & BlockID & vbCrLf & _
                        "FileSize: " & FileSize & vbCrLf & _
                        "OffsetPart1: " & OffsetPart1 & vbCrLf & _
                        "SizePart1: " & SizePart1 & vbCrLf & _
                        "OffsetPart2: " & OffsetPart2 & vbCrLf & _
                        "SizePart2: " & SizePart2 & vbCrLf & _
                        "OffsetPart3: " & OffsetPart3 & vbCrLf & _
                        "SizePart3: " & SizePart3 & vbCrLf

  Dim Part1(), Part3(), TilemapSizes(), TilemapOffsets()

  Dim tmp
  tmp = -1

  index = 0
  While tmp <> 0
    tmp = ReadDWordOfData
    If tmp <> 0 Then
      ReDim Preserve TilemapOffsets(index)
      TilemapOffsets(index) = tmp
      objDumpFile.WriteLine "Tilemap Offset #" & index & ": " & TilemapOffsets(index)
    End If
    index = index + 1
  Wend

  ReDim TilemapSizes(UBound(TilemapOffsets))

  For index = 0 To UBound(TilemapOffsets)
    If index < UBound(TilemapOffsets) Then
      TilemapSizes(index) = TilemapOffsets(index + 1) - TilemapOffsets(index)
    Else
      TilemapSizes(index) = SizePart1 - TilemapOffsets(index)
    End If
    objDumpFile.WriteLine "Tilemap size #" & index & " : " & TilemapSizes(index)
  Next

  ReDim Part1((SizePart1 - 9 - 4 * UBound(TilemapOffsets)) / 2)
  ReDim Part3((SizePart3 * 2) - 1)

'  objDumpFile.WriteLine "Part1"
  For index = 0 To (SizePart1 - 9 - 4 * UBound(TilemapOffsets)) / 2
    Part1(index) = ReadWordOfData
    'objDumpFile.WriteLine Part1(index) & vbTab
  Next

  Dim objOutputPalette
  Set objOutputPalette = LoadSaturnPalette(objDataFile, 256, LITTLE_ENDIAN)

  Dim intX, intY, Tileset(790) '791 tiles of 8x8 pixels = 64 bytes
  For j = 0 To UBound(Tileset)
    Set Tileset(j) = New Image
    Tileset(j).SetProperties 8, 8, 8
    For intY = 0 To 7
      For intX = 0 To 7
        Tileset(j).SetPixel intX, intY, ReadByteOfData
      Next
    Next
  Next

  Dim intTilemapWidth, intTilemapHeight, objOutputImage, intTileIndex, blnHorizontalFlip, blnVerticalFlip
  For index = 0 To UBound(TilemapSizes)
    intTilemapWidth = Part1((TilemapOffsets(index) - 48) / 2)
    intTilemapHeight = Part1(((TilemapOffsets(index) - 48) / 2) + 1)
    objDumpFile.WriteLine "Tilemap dimensions #" & index & ": " & intTilemapWidth & "x" & intTilemapHeight
    Set objOutputImage = New Image
    objOutputImage.SetProperties intTilemapWidth * 8, intTilemapHeight * 8, 8
    For j = 0 To intTilemapWidth - 1
      For k = 0 To intTilemapHeight - 1
        intTileIndex = (Part1(((TilemapOffsets(index) - 48) / 2) + 2 + intTilemapWidth * k + j) \ 2) And &H07FF
        blnHorizontalFlip = (Part1(((TilemapOffsets(index) - 48) / 2) + 2 + intTilemapWidth * k + j) \ 2^14) And &H0001
        blnVerticalFlip = 0   ' No tiles have a 'vertical flip bit' set, so I don't know which bit is used for vertical flip.
        objDumpFile.WriteLine intTileIndex & vbTab & blnHorizontalFlip & vbtab & blnVerticalFlip
        objOutputImage.PutImage j * 8, k * 8, Tileset(intTileIndex), blnHorizontalFlip, blnVerticalFlip
      Next
    Next
    objOutputImage.ExportToBMP pstrOutputFolder & pstrFileName & " - Decoded\Item " & index & ".bmp", objOutputPalette
  Next

	objDataFile.Close
	objDumpFile.Close
End Sub

Sub DecodeNBG3BIN(pstrFolder, pstrFileName, pstrOutputFolder)
	Set objDataFile = objFileSystemObject.OpenTextFile(pstrFolder & "\" & pstrFileName, ForReading, False)

	If Not objFileSystemObject.FolderExists(pstrOutputFolder & pstrFileName & " - Decoded") Then
		objFileSystemObject.CreateFolder(pstrOutputFolder & pstrFileName & " - Decoded")
	End If

  Dim objOutputPalette, objOutputImage
  Set objOutputPalette = New Palette
  objOutputPalette.SetProperties 16, 5
  ' These colors are the ones defines in the palette in FONT256.S2D
  objOutputPalette.SetColor 0, 0, 0, 0, 0
  objOutputPalette.SetColor 3, 30, 31, 31, 0
  objOutputPalette.SetColor 6, 0, 1, 31, 0
  
  Set objOutputImage = New Image
  objOutputImage.SetProperties 8, 224 * 8, 4
  
  Dim index, j, k, tmp
  For index = 0 To 223
    For j = 0 To 7
      For k = 0 To 3
        tmp = ReadByteOfData
        objOutputImage.SetPixel 2 * k, 8 * index + j, (tmp \ 16) And &H0F
        objOutputImage.SetPixel 2 * k + 1, 8 * index + j, tmp And &H0F
      Next
    Next
  Next
  objOutputImage.ExportToBMP pstrOutputFolder & pstrFileName & " - Decoded\" & pstrFileName & ".bmp", objOutputPalette
End Sub

Sub DecodeITEMIBS(pstrFolder, pstrFileName, pstrOutputFolder)
	Set objDataFile = objFileSystemObject.OpenTextFile(pstrFolder & "\" & pstrFileName, ForReading, False)

	If Not objFileSystemObject.FolderExists(pstrOutputFolder & pstrFileName & " - Decoded") Then
		objFileSystemObject.CreateFolder(pstrOutputFolder & pstrFileName & " - Decoded")
	End If

	Set objDumpFile = objFileSystemObject.OpenTextFile(pstrOutputFolder & pstrFileName & " - Decoded\zzzz Dump.txt", ForWriting, True)

  objDataFile.Read(2048)

  Dim arrItemDeclaration(242, 30)
  Dim strReport
  For index = 0 To 242
    strReport = ""
    For j = 0 To 19
      arrItemDeclaration(index, j) = ReadByteOfData  ' Read as raw bytes, but may be words or other structure
    Next
    For j = 20 To 28
      arrItemDeclaration(index, j) = ReadWordOfData  ' These are words for sure
    Next
    For j = 29 To 30
      arrItemDeclaration(index, j) = ReadByteOfData  ' Read as raw bytes, but may be words or other structure
    Next
  Next
  objDataFile.Read(520) ' padding

  Dim ItemPalettes(7), OutputData, tmp, tmp2
  For index = 0 To 7
    Set ItemPalettes(index) = LoadSaturnPalette(objDataFile, 16, BIG_ENDIAN)
  Next

  objDumpFile.WriteLine "Associations palette / item image index"
  Dim objItemPaletteAssociations, arrItemPalette(255, 1)
  Set objItemPaletteAssociations = CreateObject("Scripting.Dictionary")
  For index = 0 To 255
    arrItemPalette(index, 0) = ReadByteOfData
    arrItemPalette(index, 1) = ReadByteOfData
    If arrItemPalette(index, 0) <> 255 Then
      objItemPaletteAssociations.Add arrItemPalette(index, 1), arrItemPalette(index, 0)
    End If
    objDumpFile.WriteLine arrItemPalette(index, 0) & vbTab & arrItemPalette(index, 1)
  Next

  objDumpFile.WriteLine "Item declarations"
  objDumpFile.WriteLine "Index" & vbTab & _
                        "Category" & vbTab & _
                        "Carry locations" & vbTab & _
                        "Byte3" & vbTab & _
                        "Byte4" & vbTab & _
                        "Byte5" & vbTab & _
                        "Byte6" & vbTab & _
                        "Byte7" & vbTab & _
                        "Weight" & vbTab & _
                        "Byte9" & vbTab & _
                        "Byte10" & vbTab & _
                        "Byte11" & vbTab & _
                        "Byte12" & vbTab & _
                        "Byte13" & vbTab & _
                        "Byte14" & vbTab & _
                        "Byte15" & vbTab & _
                        "Action 1 ID" & vbTab & _
                        "Action 2 ID" & vbTab & _
                        "Action 3 ID" & vbTab & _
                        "Byte19" & vbTab & _
                        "Image index for item in inventory" & vbTab & _
                        "Image index for item on floor" & vbTab & _
                        "String index for item name" & vbTab & _
                        "String index for item description" & vbTab & _
                        "String index for item action 1" & vbTab & _
                        "String index for item action 2" & vbTab & _
                        "String index for item action 3" & vbTab & _
                        "Always0" & vbTab & _
                        "Attribute" & vbTab & _
                        "Byte38" & vbTab & _
                        "Byte39"
  Dim strCategoryName, intValue1, intValue2
  For index = 0 To 242
    strReport = ""
    strReport = strReport & arrItemDeclaration(index, 0) & vbTab

    Select Case arrItemDeclaration(index, 1)
      Case 0
        strCategoryName = "0 Weapon"
      Case 1
        strCategoryName = "1 Clothe"
      Case 2
        strCategoryName = "2 Food"
      Case 3
        strCategoryName = "3 Potions"
      Case 4
        strCategoryName = "4 Scrolls"
      Case 7
        strCategoryName = "7 Misc"
    End Select
    strReport = strReport & strCategoryName & vbTab

    For j = 2 To 7
      strReport = strReport & arrItemDeclaration(index, j) & vbTab
    Next

    strReport = strReport & arrItemDeclaration(index, 8) / 10 & vbTab

    For j = 9 To 19
      strReport = strReport & arrItemDeclaration(index, j) & vbTab
    Next

    If arrItemDeclaration(index, 20) <> 65535 Then
      strReport = strReport & "Image" & Pad(arrItemPalette(arrItemDeclaration(index, 20), 1), 3, "0")  & ".bmp" & vbTab
    Else
      strReport = strReport & "-" & vbTab
    End If

    If arrItemDeclaration(index, 21) <> 65535 Then
      strReport = strReport & "Image" & Pad(arrItemDeclaration(index, 21), 3, "0")  & ".bmp" & vbTab
    Else
      strReport = strReport & "-" & vbTab
    End If

    For j = 22 To 27
      strReport = strReport & arrItemDeclaration(index, j) & vbTab
    Next

    Select Case arrItemDeclaration(index, 1)
      Case 0 ' Weapon
        intValue1 = (arrItemDeclaration(index, 28) \ 16) And &H0F
        intValue2 = arrItemDeclaration(index, 28) And &H0F
        strReport = strReport & "Weapon: " & intValue1 & " / " & intValue2 & vbTab
      Case 1 ' Clothe
        strReport = strReport & "Clothe: " & arrItemDeclaration(index, 28) & vbTab
      Case 2 ' Food
        strReport = strReport & "Food value: " & arrItemDeclaration(index, 28) & vbTab
      Case 3, 4, 7 ' Potions, Scrolls, Misc
        strReport = strReport & "-" & vbTab
    End Select

    For j = 29 To 30
      strReport = strReport & arrItemDeclaration(index, j) & vbTab
    Next

    objDumpFile.WriteLine strReport
  Next

  Dim objItemImage
  Set objItemImage = New Image
  objItemImage.SetProperties 16, 16, 4
  For index = 0 To 222
    For j = 0 To 15
      For k = 0 To 7
        tmp = ReadByteOfData
        objItemImage.SetPixel 2 * k, j, (tmp \ 16) And &H0F
        objItemImage.SetPixel 2 * k + 1, j, tmp And &H0F
      Next
    Next
    
    objItemImage.ExportToBMP pstrOutputFolder & pstrFileName & " - Decoded\Image" & Pad(index, 3, "0") & ".bmp", ItemPalettes(objItemPaletteAssociations(index))
  Next
  objDataFile.Read(1408) ' padding

  Dim ItemOnFloorImages(110, 7)
  Dim Palettes
  Set Palettes = CreateObject("Scripting.Dictionary")
  objDumpFile.WriteLine "Item on floor image definitions"
  For index = 0 To 109
    strReport = ""
    For j = 0 To 5
      ItemOnFloorImages(index, j) = ReadWordOfData
      strReport = strReport & ItemOnFloorImages(index, j) & vbTab
    Next
    For j = 6 To 7
      ItemOnFloorImages(index, j) = ReadDWordOfData
      strReport = strReport & ItemOnFloorImages(index, j) & vbTab
    Next
    If ItemOnFloorImages(index, 7) <> 0 Then
      Palettes.Add ItemOnFloorImages(index, 2), ItemOnFloorImages(index, 7)
    End If
    objDumpFile.WriteLine strReport
  Next
  objDumpFile.WriteLine "Number of color palettes for item on floor images: " & Palettes.Count
  Dim ItemOnFloorImagesRawData(51615)
  For index = 0 To 51615
    ItemOnFloorImagesRawData(index) = ReadByteOfData
  Next

  Dim PaletteOffset, objItemOnFloorImage, objItemOnFloorPalette
  Set objItemOnFloorPalette = New Palette
  objItemOnFloorPalette.SetProperties 16, 5
  Set objItemOnFloorImage = New Image

  For index = 0 To 108   ' Entry 109 in table is not an image
'    strPalette = ""
    For j = 0 To 15
      PaletteOffset = Palettes(ItemOnFloorImages(index, 2))
      tmp = 256 * ItemOnFloorImagesRawData(PaletteOffset - 2200 + 2 * j) + ItemOnFloorImagesRawData(PaletteOffset - 2200 + 2 * j + 1)
      objItemOnFloorPalette.SetColor j, (tmp And &H001F), ((tmp \ 32) And &H001F), ((tmp \ 1024) And &H001F), 0
    Next

    objItemOnFloorImage.SetProperties ItemOnFloorImages(index, 3), ItemOnFloorImages(index, 4), 4

    For j = 0 To ItemOnFloorImages(index, 4) - 1
      For k = 0 To (ItemOnFloorImages(index, 3) / 2) - 1
        tmp = ItemOnFloorImagesRawData(ItemOnFloorImages(index, 6) - 2200 + ((j * (ItemOnFloorImages(index, 3) / 2)) + k))
        objItemOnFloorImage.SetPixel 2 * k, j, (tmp \ 16) And &H0F
        objItemOnFloorImage.SetPixel 2 * k + 1, j, tmp And &H0F
      Next
    Next
    objItemOnFloorImage.ExportToBMP pstrOutputFolder & pstrFileName & " - Decoded\Image" & Pad(index + 223, 3, "0") & ".bmp", objItemOnFloorPalette
  Next

  objDataFile.Read(1480) ' padding

  
  Set fItem = objFileSystemObject.OpenTextFile(pstrOutputFolder & pstrFileName & " - Decoded\LastSection.bin", ForWriting, True)
  fItem.Write objDataFile.Read(632) ' Last section
  fItem.Close

	objDataFile.Close
	objDumpFile.Close
End Sub

Sub DecodeFONT256S2D(pstrFolder, pstrFileName, pstrOutputFolder)
	Set objDataFile = objFileSystemObject.OpenTextFile(pstrFolder & "\" & pstrFileName, ForReading, False)

	If Not objFileSystemObject.FolderExists(pstrOutputFolder & pstrFileName & " - Decoded") Then
		objFileSystemObject.CreateFolder(pstrOutputFolder & pstrFileName & " - Decoded")
	End If

	Set objDumpFile = objFileSystemObject.OpenTextFile(pstrOutputFolder & pstrFileName & " - Decoded\zzzz Dump.txt", ForWriting, True)

  objDumpFile.WriteLine "File Signature: " & objDataFile.Read(16)

  Dim Header(59)
  For index = 0 To 59
    Header(index) = ReadDWordOfData
  Next

  objDumpFile.WriteLine "Map data offset: " & Header(0)
  objDumpFile.WriteLine "Map data size: " & Header(1)
  objDumpFile.WriteLine "Page data (tilemap) offset: " & Header(4)
  objDumpFile.WriteLine "Page data (tilemap) size: " & Header(5)
  objDumpFile.WriteLine "Character Generator data (tileset) offset: " & Header(8)
  objDumpFile.WriteLine "Character Generator data (tileset) size: " & Header(9)
  objDumpFile.WriteLine "Palette data offset: " & Header(12)
  objDumpFile.WriteLine "Palette data size: " & Header(13)
  objDumpFile.WriteLine "Attribute data offset: " & Header(16)
  objDumpFile.WriteLine "Attribute data size: " & Header(17)

  objDumpFile.WriteLine "Map data: "
  objDumpFile.WriteLine vbTab & "Horizontal page number (page size): " & ReadWordOfData
  objDumpFile.WriteLine vbTab & "Vertical page number (page size): " & ReadWordOfData
  objDataFile.Read(12) ' Padding with FFh bytes
  objDumpFile.WriteLine vbTab & "Page number: " & ReadWordOfData
  objDataFile.Read(14) ' Padding with FFh bytes
  objDumpFile.WriteLine "Page data: "

  Dim intCharacterControlData
  intCharacterControlData = ReadDWordOfData
  objDumpFile.WriteLine vbTab & "Character control data: " & intCharacterControlData
  If (intCharacterControlData And &H00010000) = 0 Then
    objDumpFile.WriteLine vbTab & vbTab & "Character size: 1x1 cell"
  Else
    objDumpFile.WriteLine vbTab & vbTab & "Character size: 2x2 cell"
  End If
  
  If (intCharacterControlData And &H00700000) = 0 Then
    objDumpFile.WriteLine vbTab & vbTab & "Number of character colors: 16 colors"
  End If
  If (intCharacterControlData And &H00700000) = &H00100000 Then
    objDumpFile.WriteLine vbTab & vbTab & "Number of character colors: 256 colors"
  End If

  Dim intPatternNameAuxiliaryData
  intPatternNameAuxiliaryData = ReadWordOfData
  objDumpFile.WriteLine vbTab & "Pattern name auxiliary data: " & intPatternNameAuxiliaryData
  If (intPatternNameAuxiliaryData And &H8000) = 0 Then
    objDumpFile.WriteLine vbTab & vbTab & "Pattern name data size: 1 word"
  Else
    objDumpFile.WriteLine vbTab & vbTab & "Pattern name data size: 2 word"
  End If
  If (intPatternNameAuxiliaryData And &H4000) = 0 Then
    objDumpFile.WriteLine vbTab & vbTab & "Character No. auxiliary mode: 10 bits"
  Else
    objDumpFile.WriteLine vbTab & vbTab & "Character No. auxiliary mode: 12 bits"
  End If

  objDataFile.Read(10) ' Padding with FFh bytes
  
  objDumpFile.WriteLine "Tilemap"
  Dim Tilemap(4095)
  For index = 0 To 4095
    Tilemap(index) = ReadWordOfData
    objDumpFile.WriteLine Tilemap(index)
  Next

  objDataFile.Read(16) ' Prefix of Character Generator data is 16 FFh bytes

  Dim CharacterGeneratorData(241), intX, intY
  For index = 0 To UBound(CharacterGeneratorData)
    Set CharacterGeneratorData(index) = New Image
    CharacterGeneratorData(index).SetProperties 8, 8, 8
    For intY = 0 To 7
      For intX = 0 To 7
        CharacterGeneratorData(index).SetPixel intX, intY, ReadByteOfData
      Next
    Next
  Next

  Dim objImage
  Set objImage = New Image
  objImage.SetProperties 8, 242 * 8, 8

  objDumpFile.WriteLine "Palette Number: " & ReadWordOfData
  objDumpFile.WriteLine "Palette size? (number of colors): " & ReadWordOfData
  objDataFile.Read(12) ' Padding of FFh bytes

  Dim objPalette
  Set objPalette = LoadSaturnPalette(objDataFile, 256, BIG_ENDIAN)

  objDataFile.Read(2 * 242) ' 1 word of attributes for each tile

  Dim objCharImage
  For index = 0 To 241
    Set objCharImage = CharacterGeneratorData(index)
    objImage.PutImage 0, index * 8, objCharImage, False, False
    objCharImage.ExportToBMP pstrOutputFolder & pstrFileName & " - Decoded\FONT256S2D-" & Pad(index, 3, "0") & ".bmp", objPalette
  Next
  objImage.ExportToBMP pstrOutputFolder & pstrFileName & " - Decoded\FONT256.S2D.bmp", objPalette
  
  objDataFile.Close
  objDumpFile.Close
End Sub

Function Pad(pstrString, pintDesiredLength, pstrPaddingCharacter)
  If Len(pstrString) < pintDesiredLength Then
    Pad = String(pintDesiredLength - Len(pstrString), pstrPaddingCharacter) & pstrString
  Else
    Pad = pstrString
  End If
End Function

Function ReadByteOfData
  ReadByteOfData = Asc(objDataFile.Read(1))
End Function

Function ReadWordOfData
	If Endian = BIG_ENDIAN Then
		ReadWordOfData = Asc(objDataFile.Read(1)) * 256 + Asc(objDataFile.Read(1))
	Else
		ReadWordOfData = Asc(objDataFile.Read(1)) + 256 * Asc(objDataFile.Read(1))
	End If
End Function

Function ReadDWordOfData
	If Endian = BIG_ENDIAN Then
		ReadDWordOfData = (Asc(objDataFile.Read(1)) * 256 + Asc(objDataFile.Read(1))) * 65536 + Asc(objDataFile.Read(1)) * 256 + Asc(objDataFile.Read(1))
	Else
		ReadDWordOfData = Asc(objDataFile.Read(1)) + 256 * Asc(objDataFile.Read(1)) + 65536 * (Asc(objDataFile.Read(1)) + 256 * Asc(objDataFile.Read(1)))
	End If
End Function

Function IntToString(Value)
	Dim Part1, Part2, Part3, Part4
	Part1 = (Value And &h000000FF) Mod 256
	Part2 = ((Value And &h0000FF00) \ 256) Mod 256
	Part3 = ((Value And &h00FF0000) \ 65536) Mod 256
	Part4 = ((Value And &hFF000000) \ 16777216) Mod 256
	IntToString = Chr(Part1) & Chr(Part2) & Chr(Part3) & Chr(Part4)
End Function

Function IntToBin(pintInteger, pintNumberofBits)
  Dim intInteger, intTempValue, i
  intInteger = pintInteger
'    Do
  For i = 0 To pintNumberofBits - 1
    'Use the Mod operator to get the current binary digit from the Integer number
    intTempValue = intInteger Mod 2
    IntToBin = CStr(intTempValue) + IntToBin
    'Divide the current number by 2 and get the integer result
    intInteger = intInteger \ 2
  Next
'    Loop Until IntNum = 0
End Function

Function LoadSaturnPalette(pobjFile, pintNumberOfColors, pintEndian)
  Set LoadSaturnPalette = New Palette
  LoadSaturnPalette.SetProperties pintNumberOfColors, 5
  
  Dim index, intColor
  For index = 0 To pintNumberOfColors - 1
    If pintEndian = BIG_ENDIAN Then
      intColor = Asc(pobjFile.Read(1)) * 256 + Asc(pobjFile.Read(1))
    Else
      intColor = Asc(pobjFile.Read(1)) + Asc(pobjFile.Read(1)) * 256
    End If
    LoadSaturnPalette.SetColor index, _
                               (intColor       ) And &H001F, _
                               (intColor \   32) And &H001F, _
                               (intColor \ 1024) And &H001F, _
                               0
  Next
End Function

Class Palette
  Private intNumberOfColors
  Private intBitsPerComponent
  Private arrData()

  Private Sub Class_Initialize()
    intNumberOfColors = 0
    intBitsPerComponent = 0
  End Sub

  Public Function SetProperties(pintNumberOfColors, pintBitsPerComponent)
    intNumberOfColors = pintNumberOfColors
    intBitsPerComponent = pintBitsPerComponent
    
    ReDim arrData(pintNumberOfColors - 1, 3)

    Randomize 314159265
    Dim intIndex
    For intIndex = 0 To pintNumberOfColors - 1
      Int(Rnd * (2^pintBitsPerComponent))

      arrData(intIndex, 0) = Int(Rnd * (2^pintBitsPerComponent))
      arrData(intIndex, 1) = Int(Rnd * (2^pintBitsPerComponent))
      arrData(intIndex, 2) = Int(Rnd * (2^pintBitsPerComponent))
      arrData(intIndex, 3) = 0
    Next
  End Function

  Public Function SetColor(pintColorIndex, pintRed, pintGreen, pintBlue, pintAlpha)
    If (pintColorIndex >= 0) And (pintColorIndex < intNumberOfColors) Then
      arrData(pintColorIndex, 0) = pintRed
      arrData(pintColorIndex, 1) = pintGreen
      arrData(pintColorIndex, 2) = pintBlue
      arrData(pintColorIndex, 3) = pintAlpha
    End If
  End Function

  Public Property Get NumberOfColors
    NumberOfColors = intNumberOfColors
  End Property

  Public Property Get MaximumComponentValue
    MaximumComponentValue = intBitsPerComponent
  End Property

  Public Function GetBMPData
    Dim intIndex
    For intIndex = 0 To intNumberOfColors - 1
      GetBMPData = GetBMPData & Chr(arrData(intIndex, 2) * 255 \ (2^intBitsPerComponent - 1)) & _
                                Chr(arrData(intIndex, 1) * 255 \ (2^intBitsPerComponent - 1)) & _
                                Chr(arrData(intIndex, 0) * 255 \ (2^intBitsPerComponent - 1)) & _
                                Chr(arrData(intIndex, 3))
    Next
  End Function 
End Class

Class Image
  Private intWidth
  Private intHeight
  Private intBitDepth
  Private arrData()

  Private Sub Class_Initialize()
    intWidth = 0
    intHeight = 0
    intBitDepth = 0
  End Sub

  Public Function SetProperties(pintWidth, pintHeight, pintBitDepth)
    SetProperties = False
    If (pintWidth > 0) And _
       (pintHeight > 0) And _
       ((pintBitDepth = 4) Or (pintBitDepth = 8) Or (pintBitDepth = 24)) Then
      intWidth = pintWidth
      intHeight = pintHeight
      intBitDepth = pintBitDepth
      ReDim arrData(pintWidth * pintHeight - 1)
      Dim i
      For i = 0 To UBound(arrData)
        arrData(i) = 0
      Next
      SetProperties = True
    End If
  End Function

  Public Property Get Width
    Width = intWidth
  End Property

  Public Property Get Height
    Height = intHeight
  End Property

  Public Property Get BitDepth
    BitDepth = intBitDepth
  End Property

  Public Function SetPixel(pintX, pintY, pintValue)
    SetPixel = False
    If (pintX >= 0) And _
       (pintX <= intWidth - 1) And _
       (pintY >= 0) And _
       (pintY <= intHeight - 1) And _
       (pintValue <= 2^intBitDepth - 1) Then
      arrData(pintY * intWidth + pintX) = pintValue
      SetPixel = True
    End If
  End Function

  Public Function GetPixel(pintX, pintY)
    GetPixel = 0
    If (pintX >= 0) And _
       (pintX <= intWidth - 1) And _
       (pintY >= 0) And _
       (pintY <= intHeight - 1) Then
      GetPixel = arrData(pintY * intWidth + pintX)
    End If
  End Function

  Public Function PutImage(pintX, pintY, pImage, pblnHorizontalFlip, pblnVerticalFlip)
    PutImage = False
    If (pintX >= 0) And _
       (pintX + pImage.Width <= intWidth) And _
       (pintY >= 0) And _
       (pintY + pImage.Height <= intHeight) Then
      Dim x, y, tmpVal
      For y = 0 To pImage.Height - 1
        tmpVal = (pintY + y) * intWidth + pintX
        For x = 0 To pImage.Width - 1
          If pblnHorizontalFlip Then
            If pblnVerticalFlip Then
              arrData(tmpVal + x) = pImage.GetPixel(pImage.Width - 1 - x, pImage.Height - 1 - y)
            Else
              arrData(tmpVal + x) = pImage.GetPixel(pImage.Width - 1 - x, y)
            End If
          Else
            If pblnVerticalFlip Then
              arrData(tmpVal + x) = pImage.GetPixel(x, pImage.Height - 1 - y)
            Else
              arrData(tmpVal + x) = pImage.GetPixel(x, y)
            End If
          End If
        Next
      Next
      PutImage = True
    End If
  End Function
  
  Public Function ExportToBMP(pstrFileName, pobjPalette)
    Dim intLinePadding, intImageOffset, intBitmapSize, strBMPData, intNumberOfColors
    intLinePadding = (intWidth * intBitDepth)
    If intLinePadding >= 32 Then
      intLinePadding = intLinePadding Mod 32
      If intLinePadding <> 0 Then
        intLinePadding = 32 - intLinePadding
      End If
    Else
      intLinePadding = 32 - intLinePadding
    End If
    If intBitDepth <> 24 Then
      intNumberOfColors = pobjPalette.NumberOfColors
    Else
      intNumberOfColors = 0
    End If
    intImageOffset = 54 + 4 * intNumberOfColors
    intBitmapSize = ((intWidth * intBitDepth) + intLinePadding) * intHeight / 8

    ' BMP file header
    strBMPData = "BM"                                                     ' File ID                WORD   Always "BM"
    strBMPData = strBMPData & IntToString(intImageOffset + intBitmapSize) ' File Size              DWORD
    strBMPData = strBMPData & Chr(0) & Chr(0)                             ' Reserved               WORD   Always 0
    strBMPData = strBMPData & Chr(0) & Chr(0)                             ' Reserved               WORD   Always 0
    strBMPData = strBMPData & IntToString(intImageOffset)                 ' Image Offset           DWORD
    strBMPData = strBMPData & Chr(40) & Chr(0) & Chr(0) & Chr(0)          ' Header Size            DWORD  Always 40 bytes
    strBMPData = strBMPData & IntToString(intWidth)                       ' Image Width            DWORD
    strBMPData = strBMPData & IntToString(intHeight)                      ' Image Height           DWORD
    strBMPData = strBMPData & Chr(1) & Chr(0)                             ' Number of planes       WORD   Always 1
    strBMPData = strBMPData & Chr(intBitDepth) & Chr(0)                   ' Pixel Bit Depth        WORD
    strBMPData = strBMPData & Chr(0) & Chr(0) & Chr(0) & Chr(0)           ' Compression            DWORD  0 (no compression)
    strBMPData = strBMPData & IntToString(intBitmapSize)                  ' Bitmap Size            DWORD
    strBMPData = strBMPData & Chr(&h13) & Chr(&h0B) & Chr(0) & Chr(0)     ' Horizontal resolution  DWORD  2835 pixels/m = 72 pixels/inch
    strBMPData = strBMPData & Chr(&h13) & Chr(&h0B) & Chr(0) & Chr(0)     ' Vertical resolution    DWORD  2835 pixels/m = 72 pixels/inch
    strBMPData = strBMPData & IntToString(intNumberOfColors)              ' Used Colors            DWORD
    strBMPData = strBMPData & IntToString(intNumberOfColors)              ' Significant Colors     DWORD

    ' BMP color palette
    If intBitDepth <> 24 Then
      strBMPData = strBMPData & pobjPalette.GetBMPData
    End If

    ' BMP image data
    Dim intX, intY, intIndex, objStringBuilder
    Set objStringBuilder = New StringBuilder
    objStringBuilder.Append strBMPData

    Select Case intBitDepth
      Case 4
        Dim intByte, intNumberOfNibbles
        intLinePadding = intLinePadding \ 4    ' Number of padding nibbles
        intNumberOfNibbles = 0
        intByte = 0
        For intY = intHeight - 1 To 0 Step -1
          For intX = 0 To intWidth - 1
            intByte = intByte * 16 + arrData(intY * intWidth + intX)
            intNumberOfNibbles = intNumberOfNibbles + 1
            If intNumberOfNibbles = 2 Then
              objStringBuilder.Append Chr(intByte)
              intByte = 0
              intNumberOfNibbles = 0
            End If
          Next
          If intLinePadding <> 0 Then
            For intIndex = 0 To intLinePadding - 1
              intByte = intByte * 16 + 0
              intNumberOfNibbles = intNumberOfNibbles + 1
              If intNumberOfNibbles = 2 Then
                objStringBuilder.Append Chr(intByte)
                intNumberOfNibbles = 0
              End If
            Next
            If intNumberOfNibbles = 1 Then
              objStringBuilder.Append Chr(intByte * 16)
              intNumberOfNibbles = 0
            End If
          End If
        Next

      Case 8
        intLinePadding = intLinePadding \ 8    ' Number of padding bytes
        For intY = intHeight - 1 To 0 Step -1
          For intX = 0 To intWidth - 1
            objStringBuilder.Append Chr(arrData(intY * intWidth + intX))
          Next
          If intLinePadding <> 0 Then
            For intIndex = 0 To intLinePadding - 1
              objStringBuilder.Append Chr(0)
            Next
          End If
        Next

      Case 24
        intLinePadding = intLinePadding \ 8    ' Number of padding bytes
        Dim intPixel
        For intY = intHeight - 1 To 0 Step -1
          For intX = 0 To intWidth - 1
            intPixel = arrData(intY * intWidth + intX)
            objStringBuilder.Append Chr((intPixel \ 65536) And &HFF)
            objStringBuilder.Append Chr((intPixel \   256) And &HFF)
            objStringBuilder.Append Chr((intPixel        ) And &HFF)
          Next
          If intLinePadding <> 0 Then
            For intIndex = 0 To intLinePadding - 1
              objStringBuilder.Append Chr(0)
            Next
          End If
        Next

    End Select

    ' Write BMP file
    Dim objFileSystemObject
    Set objFileSystemObject = CreateObject("Scripting.FileSystemObject")
    Dim objBMPFile
    Set objBMPFile = objFileSystemObject.OpenTextFile(pstrFileName, ForWriting, True)
    objBMPFile.Write objStringBuilder.ToString
    objBMPFile.Close
  End Function

  Private Function IntToString(pintValue)
    Dim intPart1, intPart2, intPart3, intPart4
    intPart1 = (pintValue And &h000000FF)
    intPart2 = (pintValue \ 256) And &h000000FF
    intPart3 = (pintValue \ 65536) And &h000000FF
    intPart4 = (pintValue \ 16777216) And &h000000FF
    IntToString = Chr(intPart1) & Chr(intPart2) & Chr(intPart3) & Chr(intPart4)
  End Function

  Public Function TextDump
    Dim x, y
    TextDump = ""
    For y = 0 To Height - 1
      For x = 0 To Width - 1
        TextDump = TextDump & arrData(y * intWidth + x)
        If x <> Width - 1 Then
          TextDump = TextDump & vbTab
        End If
      Next
      TextDump = TextDump & vbCrLf
    Next
  End Function
End Class

' Use this class to concatenate strings in a much more
' efficient manner than simply concatenating a string
' (strVariable = strVariable & "your new string")
Class StringBuilder
  Dim arr         'the array of strings to concatenate
  Dim growthRate  'the rate at which the array grows
  Dim itemCount   'the number of items in the array

  Private Sub Class_Initialize()
    growthRate = 50
    itemCount = 0
    ReDim arr(growthRate)
  End Sub

  'Append a new string to the end of the array. If the
  'number of items in the array is larger than the
  'actual capacity of the array, then "grow" the array
  'by ReDimming it.
  Public Sub Append(ByVal strValue)
    If itemCount > UBound(arr) Then
      ReDim Preserve arr(UBound(arr) + growthRate)
    End If
    arr(itemCount) = strValue
    itemCount = itemCount + 1
  End Sub

  'Concatenate the strings by simply joining your array
  'of strings and adding no separator between elements.
  Public Function ToString() 
    ToString = Join(arr, "")
  End Function
End Class

Sub BuildCharactersDictionary
  Dim objDicoFile, intLine, arrLine
  Set objDicoFile = objFileSystemObject.OpenTextFile(strScriptPath & "\RLOWFIX.BIN-Fonts-UTF8.txt", ForReading, True)
  objDicoFile.ReadLine  ' Line with column names
  While Not objDicoFile.AtEndOfStream
    arrLine = Split(objDicoFile.ReadLine, vbTab)
    ' If there is a code associated to the character
    If arrLine(2) <> "" Then
      objCharactersDictionary.Add arrLine(2), arrLine(3)
      objCharactersDictionaryHTML.Add arrLine(2), "<img src=""FONT" & arrLine(0) & "-" & Pad(arrLine(1), 3, "0") & ".bmp"" />"
    End If
  Wend

  objCharactersDictionaryHTML.Add "E034", "{Half width alignment}" & vbCrLf
  objCharactersDictionary.Add "E034", "{Half width alignment}" & vbCrLf

  objCharactersDictionaryHTML.Add "E0FE", "{Void}" & vbCrLf
  objCharactersDictionary.Add "E0FE", "{Void}" & vbCrLf

  objCharactersDictionaryHTML.Add "00", "{End}" & vbCrLf
  objCharactersDictionary.Add "00", "{End}" & vbCrLf

  objCharactersDictionaryHTML.Add "0303", "<br>" & vbCrLf
  objCharactersDictionary.Add "0303", "<br>" & vbCrLf

  objCharactersDictionaryHTML.Add "030000", "{Set color White}" & vbCrLf
  objCharactersDictionary.Add "030000", "{Set color White}" & vbCrLf
  objCharactersDictionaryHTML.Add "030001", "{Set color Green}" & vbCrLf
  objCharactersDictionary.Add "030001", "{Set color Green}" & vbCrLf
  objCharactersDictionaryHTML.Add "030002", "{Set color Yellow}" & vbCrLf
  objCharactersDictionary.Add "030002", "{Set color Yellow}" & vbCrLf
  objCharactersDictionaryHTML.Add "030003", "{Set color Red}" & vbCrLf
  objCharactersDictionary.Add "030003", "{Set color Red}" & vbCrLf

  Set objDicoFile = objFileSystemObject.OpenTextFile(strScriptPath & "\FONT256.S2D-Font-UTF8.txt", ForReading, True)
  For intLine = 0 To 241
    arrFont256S2DUTF8Chars(intLine) = objDicoFile.ReadLine
  Next
  objDicoFile.Close
End Sub
