'---------------------------------------------------------------'
' DM, CSB & DM2 Animations Decoder.vbs                          '
' Version 1.1 - May 8, 2020                                     '
' Written by Christophe Fontanel                                '
'                                                               '
' Please visit The Dungeon Master & Chaos Strikes Back          '
' Encyclopaedia at http://dmweb.free.fr/ for more information   '
'                                                               '
' Here is information about the BMP file format:                '
' http://www.bbits.hpg.ig.com.br/tutorials/graphics/bmp/bmp.txt '
'---------------------------------------------------------------'

Option Explicit

' Derived from the RSA Data Security, Inc. MD5 Message-Digest Algorithm,
' as set out in the memo RFC1321.
'
' See the VB6 project that accompanies this sample for full code comments on how
' it works.
'
' ASP VBScript code for generating an MD5 'digest' or 'signature' of a string. The
' MD5 algorithm is one of the industry standard methods for generating digital
' signatures. It is generically known as a digest, digital signature, one-way
' encryption, hash or checksum algorithm. A common use for MD5 is for password
' encryption as it is one-way in nature, that does not mean that your passwords
' are not free from a dictionary attack.
'
' This is 'free' software with the following restrictions:
'
' You may not redistribute this code as a 'sample' or 'demo'. However, you are free
' to use the source code in your own code, but you may not claim that you created
' the sample code. It is expressly forbidden to sell or profit from this source code
' other than by the knowledge gained or the enhanced value added by your own code.
'
' Use of this software is also done so at your own risk. The code is supplied as
' is without warranty or guarantee of any kind.
'
' Should you wish to commission some derivative work based on this code provided
' here, or any consultancy work, please do not hesitate to contact us.
'
' Web Site:  http://www.frez.co.uk
' E-mail:    sales@frez.co.uk

Private Const BITS_TO_A_BYTE = 8
Private Const BYTES_TO_A_WORD = 4
Private Const BITS_TO_A_WORD = 32

Private m_lOnBits(30)
Private m_l2Power(30)

    m_lOnBits(0) = CLng(1)
    m_lOnBits(1) = CLng(3)
    m_lOnBits(2) = CLng(7)
    m_lOnBits(3) = CLng(15)
    m_lOnBits(4) = CLng(31)
    m_lOnBits(5) = CLng(63)
    m_lOnBits(6) = CLng(127)
    m_lOnBits(7) = CLng(255)
    m_lOnBits(8) = CLng(511)
    m_lOnBits(9) = CLng(1023)
    m_lOnBits(10) = CLng(2047)
    m_lOnBits(11) = CLng(4095)
    m_lOnBits(12) = CLng(8191)
    m_lOnBits(13) = CLng(16383)
    m_lOnBits(14) = CLng(32767)
    m_lOnBits(15) = CLng(65535)
    m_lOnBits(16) = CLng(131071)
    m_lOnBits(17) = CLng(262143)
    m_lOnBits(18) = CLng(524287)
    m_lOnBits(19) = CLng(1048575)
    m_lOnBits(20) = CLng(2097151)
    m_lOnBits(21) = CLng(4194303)
    m_lOnBits(22) = CLng(8388607)
    m_lOnBits(23) = CLng(16777215)
    m_lOnBits(24) = CLng(33554431)
    m_lOnBits(25) = CLng(67108863)
    m_lOnBits(26) = CLng(134217727)
    m_lOnBits(27) = CLng(268435455)
    m_lOnBits(28) = CLng(536870911)
    m_lOnBits(29) = CLng(1073741823)
    m_lOnBits(30) = CLng(2147483647)

    m_l2Power(0) = CLng(1)
    m_l2Power(1) = CLng(2)
    m_l2Power(2) = CLng(4)
    m_l2Power(3) = CLng(8)
    m_l2Power(4) = CLng(16)
    m_l2Power(5) = CLng(32)
    m_l2Power(6) = CLng(64)
    m_l2Power(7) = CLng(128)
    m_l2Power(8) = CLng(256)
    m_l2Power(9) = CLng(512)
    m_l2Power(10) = CLng(1024)
    m_l2Power(11) = CLng(2048)
    m_l2Power(12) = CLng(4096)
    m_l2Power(13) = CLng(8192)
    m_l2Power(14) = CLng(16384)
    m_l2Power(15) = CLng(32768)
    m_l2Power(16) = CLng(65536)
    m_l2Power(17) = CLng(131072)
    m_l2Power(18) = CLng(262144)
    m_l2Power(19) = CLng(524288)
    m_l2Power(20) = CLng(1048576)
    m_l2Power(21) = CLng(2097152)
    m_l2Power(22) = CLng(4194304)
    m_l2Power(23) = CLng(8388608)
    m_l2Power(24) = CLng(16777216)
    m_l2Power(25) = CLng(33554432)
    m_l2Power(26) = CLng(67108864)
    m_l2Power(27) = CLng(134217728)
    m_l2Power(28) = CLng(268435456)
    m_l2Power(29) = CLng(536870912)
    m_l2Power(30) = CLng(1073741824)

Private Function LShift(lValue, iShiftBits)
    If iShiftBits = 0 Then
        LShift = lValue
        Exit Function
    ElseIf iShiftBits = 31 Then
        If lValue And 1 Then
            LShift = &H80000000
        Else
            LShift = 0
        End If
        Exit Function
    ElseIf iShiftBits < 0 Or iShiftBits > 31 Then
        Err.Raise 6
    End If

    If (lValue And m_l2Power(31 - iShiftBits)) Then
        LShift = ((lValue And m_lOnBits(31 - (iShiftBits + 1))) * m_l2Power(iShiftBits)) Or &H80000000
    Else
        LShift = ((lValue And m_lOnBits(31 - iShiftBits)) * m_l2Power(iShiftBits))
    End If
End Function

Private Function RShift(lValue, iShiftBits)
    If iShiftBits = 0 Then
        RShift = lValue
        Exit Function
    ElseIf iShiftBits = 31 Then
        If lValue And &H80000000 Then
            RShift = 1
        Else
            RShift = 0
        End If
        Exit Function
    ElseIf iShiftBits < 0 Or iShiftBits > 31 Then
        Err.Raise 6
    End If

    RShift = (lValue And &H7FFFFFFE) \ m_l2Power(iShiftBits)

    If (lValue And &H80000000) Then
        RShift = (RShift Or (&H40000000 \ m_l2Power(iShiftBits - 1)))
    End If
End Function

Private Function RotateLeft(lValue, iShiftBits)
    RotateLeft = LShift(lValue, iShiftBits) Or RShift(lValue, (32 - iShiftBits))
End Function

Private Function AddUnsigned(lX, lY)
    Dim lX4
    Dim lY4
    Dim lX8
    Dim lY8
    Dim lResult

    lX8 = lX And &H80000000
    lY8 = lY And &H80000000
    lX4 = lX And &H40000000
    lY4 = lY And &H40000000

    lResult = (lX And &H3FFFFFFF) + (lY And &H3FFFFFFF)

    If lX4 And lY4 Then
        lResult = lResult Xor &H80000000 Xor lX8 Xor lY8
    ElseIf lX4 Or lY4 Then
        If lResult And &H40000000 Then
            lResult = lResult Xor &HC0000000 Xor lX8 Xor lY8
        Else
            lResult = lResult Xor &H40000000 Xor lX8 Xor lY8
        End If
    Else
        lResult = lResult Xor lX8 Xor lY8
    End If

    AddUnsigned = lResult
End Function

Private Function F(x, y, z)
    F = (x And y) Or ((Not x) And z)
End Function

Private Function G(x, y, z)
    G = (x And z) Or (y And (Not z))
End Function

Private Function H(x, y, z)
    H = (x Xor y Xor z)
End Function

Private Function I(x, y, z)
    I = (y Xor (x Or (Not z)))
End Function

Private Sub FF(a, b, c, d, x, s, ac)
    a = AddUnsigned(a, AddUnsigned(AddUnsigned(F(b, c, d), x), ac))
    a = RotateLeft(a, s)
    a = AddUnsigned(a, b)
End Sub

Private Sub GG(a, b, c, d, x, s, ac)
    a = AddUnsigned(a, AddUnsigned(AddUnsigned(G(b, c, d), x), ac))
    a = RotateLeft(a, s)
    a = AddUnsigned(a, b)
End Sub

Private Sub HH(a, b, c, d, x, s, ac)
    a = AddUnsigned(a, AddUnsigned(AddUnsigned(H(b, c, d), x), ac))
    a = RotateLeft(a, s)
    a = AddUnsigned(a, b)
End Sub

Private Sub II(a, b, c, d, x, s, ac)
    a = AddUnsigned(a, AddUnsigned(AddUnsigned(I(b, c, d), x), ac))
    a = RotateLeft(a, s)
    a = AddUnsigned(a, b)
End Sub

Private Function ConvertToWordArray(sMessage)
    Dim lMessageLength
    Dim lNumberOfWords
    Dim lWordArray()
    Dim lBytePosition
    Dim lByteCount
    Dim lWordCount

    Const MODULUS_BITS = 512
    Const CONGRUENT_BITS = 448

    lMessageLength = Len(sMessage)

    lNumberOfWords = (((lMessageLength + ((MODULUS_BITS - CONGRUENT_BITS) \ BITS_TO_A_BYTE)) \ (MODULUS_BITS \ BITS_TO_A_BYTE)) + 1) * (MODULUS_BITS \ BITS_TO_A_WORD)
    ReDim lWordArray(lNumberOfWords - 1)

    lBytePosition = 0
    lByteCount = 0
    Do Until lByteCount >= lMessageLength
        lWordCount = lByteCount \ BYTES_TO_A_WORD
        lBytePosition = (lByteCount Mod BYTES_TO_A_WORD) * BITS_TO_A_BYTE
        lWordArray(lWordCount) = lWordArray(lWordCount) Or LShift(Asc(Mid(sMessage, lByteCount + 1, 1)), lBytePosition)
        lByteCount = lByteCount + 1
    Loop

    lWordCount = lByteCount \ BYTES_TO_A_WORD
    lBytePosition = (lByteCount Mod BYTES_TO_A_WORD) * BITS_TO_A_BYTE

    lWordArray(lWordCount) = lWordArray(lWordCount) Or LShift(&H80, lBytePosition)

    lWordArray(lNumberOfWords - 2) = LShift(lMessageLength, 3)
    lWordArray(lNumberOfWords - 1) = RShift(lMessageLength, 29)

    ConvertToWordArray = lWordArray
End Function

Private Function WordToHex(lValue)
    Dim lByte
    Dim lCount

    For lCount = 0 To 3
        lByte = RShift(lValue, lCount * BITS_TO_A_BYTE) And m_lOnBits(BITS_TO_A_BYTE - 1)
        WordToHex = WordToHex & Right("0" & Hex(lByte), 2)
    Next
End Function

Public Function MD5(sMessage)
    Dim x
    Dim k
    Dim AA
    Dim BB
    Dim CC
    Dim DD
    Dim a
    Dim b
    Dim c
    Dim d

    Const S11 = 7
    Const S12 = 12
    Const S13 = 17
    Const S14 = 22
    Const S21 = 5
    Const S22 = 9
    Const S23 = 14
    Const S24 = 20
    Const S31 = 4
    Const S32 = 11
    Const S33 = 16
    Const S34 = 23
    Const S41 = 6
    Const S42 = 10
    Const S43 = 15
    Const S44 = 21

    x = ConvertToWordArray(sMessage)

    a = &H67452301
    b = &HEFCDAB89
    c = &H98BADCFE
    d = &H10325476

    For k = 0 To UBound(x) Step 16
        AA = a
        BB = b
        CC = c
        DD = d

        FF a, b, c, d, x(k + 0), S11, &HD76AA478
        FF d, a, b, c, x(k + 1), S12, &HE8C7B756
        FF c, d, a, b, x(k + 2), S13, &H242070DB
        FF b, c, d, a, x(k + 3), S14, &HC1BDCEEE
        FF a, b, c, d, x(k + 4), S11, &HF57C0FAF
        FF d, a, b, c, x(k + 5), S12, &H4787C62A
        FF c, d, a, b, x(k + 6), S13, &HA8304613
        FF b, c, d, a, x(k + 7), S14, &HFD469501
        FF a, b, c, d, x(k + 8), S11, &H698098D8
        FF d, a, b, c, x(k + 9), S12, &H8B44F7AF
        FF c, d, a, b, x(k + 10), S13, &HFFFF5BB1
        FF b, c, d, a, x(k + 11), S14, &H895CD7BE
        FF a, b, c, d, x(k + 12), S11, &H6B901122
        FF d, a, b, c, x(k + 13), S12, &HFD987193
        FF c, d, a, b, x(k + 14), S13, &HA679438E
        FF b, c, d, a, x(k + 15), S14, &H49B40821

        GG a, b, c, d, x(k + 1), S21, &HF61E2562
        GG d, a, b, c, x(k + 6), S22, &HC040B340
        GG c, d, a, b, x(k + 11), S23, &H265E5A51
        GG b, c, d, a, x(k + 0), S24, &HE9B6C7AA
        GG a, b, c, d, x(k + 5), S21, &HD62F105D
        GG d, a, b, c, x(k + 10), S22, &H2441453
        GG c, d, a, b, x(k + 15), S23, &HD8A1E681
        GG b, c, d, a, x(k + 4), S24, &HE7D3FBC8
        GG a, b, c, d, x(k + 9), S21, &H21E1CDE6
        GG d, a, b, c, x(k + 14), S22, &HC33707D6
        GG c, d, a, b, x(k + 3), S23, &HF4D50D87
        GG b, c, d, a, x(k + 8), S24, &H455A14ED
        GG a, b, c, d, x(k + 13), S21, &HA9E3E905
        GG d, a, b, c, x(k + 2), S22, &HFCEFA3F8
        GG c, d, a, b, x(k + 7), S23, &H676F02D9
        GG b, c, d, a, x(k + 12), S24, &H8D2A4C8A

        HH a, b, c, d, x(k + 5), S31, &HFFFA3942
        HH d, a, b, c, x(k + 8), S32, &H8771F681
        HH c, d, a, b, x(k + 11), S33, &H6D9D6122
        HH b, c, d, a, x(k + 14), S34, &HFDE5380C
        HH a, b, c, d, x(k + 1), S31, &HA4BEEA44
        HH d, a, b, c, x(k + 4), S32, &H4BDECFA9
        HH c, d, a, b, x(k + 7), S33, &HF6BB4B60
        HH b, c, d, a, x(k + 10), S34, &HBEBFBC70
        HH a, b, c, d, x(k + 13), S31, &H289B7EC6
        HH d, a, b, c, x(k + 0), S32, &HEAA127FA
        HH c, d, a, b, x(k + 3), S33, &HD4EF3085
        HH b, c, d, a, x(k + 6), S34, &H4881D05
        HH a, b, c, d, x(k + 9), S31, &HD9D4D039
        HH d, a, b, c, x(k + 12), S32, &HE6DB99E5
        HH c, d, a, b, x(k + 15), S33, &H1FA27CF8
        HH b, c, d, a, x(k + 2), S34, &HC4AC5665

        II a, b, c, d, x(k + 0), S41, &HF4292244
        II d, a, b, c, x(k + 7), S42, &H432AFF97
        II c, d, a, b, x(k + 14), S43, &HAB9423A7
        II b, c, d, a, x(k + 5), S44, &HFC93A039
        II a, b, c, d, x(k + 12), S41, &H655B59C3
        II d, a, b, c, x(k + 3), S42, &H8F0CCC92
        II c, d, a, b, x(k + 10), S43, &HFFEFF47D
        II b, c, d, a, x(k + 1), S44, &H85845DD1
        II a, b, c, d, x(k + 8), S41, &H6FA87E4F
        II d, a, b, c, x(k + 15), S42, &HFE2CE6E0
        II c, d, a, b, x(k + 6), S43, &HA3014314
        II b, c, d, a, x(k + 13), S44, &H4E0811A1
        II a, b, c, d, x(k + 4), S41, &HF7537E82
        II d, a, b, c, x(k + 11), S42, &HBD3AF235
        II c, d, a, b, x(k + 2), S43, &H2AD7D2BB
        II b, c, d, a, x(k + 9), S44, &HEB86D391

        a = AddUnsigned(a, AA)
        b = AddUnsigned(b, BB)
        c = AddUnsigned(c, CC)
        d = AddUnsigned(d, DD)
    Next

    MD5 = LCase(WordToHex(a) & WordToHex(b) & WordToHex(c) & WordToHex(d))
End Function




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

Dim fso, fDat, fItem, fDump, ScriptArguments, DataFile
Dim Endian, Offset, BlockOffset, FileName, DataFileName, BitBuffer, BitsInBuffer, ByteValue
Dim index, j, k, BlockType, BlockSize, BlockAttributes, BlockData, CharIndex, n, Nibbles, CurrentPalettePL, EGAPalette, PC98Palette8, CurrentPaletteP8, DecodedBlockPL, DecodedBlockP8, iString
Dim PreviousBlockType, PreviousDecodedData, PreviousFileName
Dim BlockDataDump, DetailedDump
Dim PixelCount, PixelBuffer()
ReDim PixelBuffer(64000)
Dim PC98ColorMap(15, 3)


Dim ArrayBlockData(), ImageData(199, 159), nx, ny
For ny = 0 To 199
        For nx = 0 To 159
                ImageData(ny, nx) = 0
        Next
Next

Dim SDFull
SDFull = ""

Dim AnimationFiles  ' Special attributes for animations containing sound data or P8 color palettes
Set AnimationFiles = CreateObject("Scripting.Dictionary")
AnimationFiles.Add "C6DF13A7D542A809B10AA8F620145525", ",,PC"           ' DM END (PC 3.4 EN, PC 3.4 EN FR GE)
AnimationFiles.Add "05C2AB94CE4DFFE51B63985F7B0D1822", ",,PC"           ' DM TITL.DAT (Amiga 3.6 EN FR GE), TITLE (PC 3.4 EN, PC 3.4 EN FR GE)
AnimationFiles.Add "C2A6E36E842FF15C07FCDD076542B7B1", ",,"             ' CSB ANIM.DAT (Amiga 3.3 EN FR DE, Amiga FR Utility Disk)
AnimationFiles.Add "524D099FD80D266E3FE222AFA5267583", ",,"             ' CSB ANIM.DAT (Amiga EN Utility Disk)
AnimationFiles.Add "4A47040D6009C399E1C18A9DE7347615", ",,"             ' CSB ANIM.DAT (Amiga GE Utility Disk)
AnimationFiles.Add "6178F91435A9317FD3AF5868017F95AD", "SND4,7812,"     ' CSB ANIM.DAT (X68000 3.1 JP)
AnimationFiles.Add "926D7839BE04F3C9836A1ED477767A78", "SND3,6000,"     ' CSB STORY.ANM (FM-Towns 3.1 EN JP)
AnimationFiles.Add "E5CABB3B7DE71A914742E917435C0E0D", "SND3,6000,PC98" ' CSB STORY.ANM (PC-98 3.1 JP)
AnimationFiles.Add "9F2B73FF73AD0032810D79021C900CA9", "SND2,5000,"     ' CSB ENDA.DAT (Amiga 3.1 & 3.3 EN FR GE Game Disk, Amiga 3.1 EN Game Disk)
AnimationFiles.Add "2D8194CA2CE25DECCE6A756674C3CAD7", "SND4,7812,"     ' CSB ENDA.DAT (X68000 3.1 JP)
AnimationFiles.Add "EF65AC2A8DD7554E8B4974D3845C8545", "SND3,6000,"     ' CSB ENDING.ANM (FM-Towns 3.1 EN JP)
AnimationFiles.Add "33D9E3A84247E428E1989448D5DC66D6", "SND3,6000,PC98" ' CSB ENDING.ANM (PC-98 3.1 JP)
AnimationFiles.Add "2A6654FD2FDE8AEE980A7A8C0F067A7B", ",,PC98"         ' CSB TITL.ANM (PC-98 3.1 JP)
AnimationFiles.Add "5B590EA3A6F5EED513B5678B01468EE4", ",,"             ' CSB TITL.DAT (Amiga 3.1 & 3.3 EN FR GE Game Disk, Amiga EN & FR & GE Utility Disk), TITLE.ANM (FM-Towns 3.1 EN JP)
AnimationFiles.Add "F4DA1B2C69A38325F036E8EBEE5699D6", ",,"             ' CSB TITL.DAT (X68000 3.1 JP)
AnimationFiles.Add "B4A6A38657AC3C1857872952A25964D4", ",,"             ' DMII END (FM-Towns 1.0 JP, IBM PSV 1.0 JP, PC-9821 1.0 JP)
AnimationFiles.Add "898ACF479051965341B9E6104452D249", "SND2,5000,"     ' DMII END (PC-9801 1.0 JP)
AnimationFiles.Add "7F7FC31C4A1F41B8B2AFA81953823FF1", "SND2,5500,"     ' DMII ENDA.DAT (Amiga 1.0 EN)
AnimationFiles.Add "7D716E35415E74CF69ACDC8EAC2196ED", "SNDS,22050,"    ' DMII ENDA.DAT (Sega CD 1.0 EN)
AnimationFiles.Add "25F44A7FE29FFE271F2D937D6BB15211", "SNDS,22050,"    ' DMII ENDA.DAT (Sega CD 1.0 JP)
AnimationFiles.Add "B1708891AB8C841B8046688E3F5C189F", ",,"             ' DMII IPLY.DAT (Amiga 1.0 EN)
AnimationFiles.Add "6098038C7681C08E88DAFA244AD50493", "SNDS,22050,"    ' DMII STRY.DAT (Sega CD 1.0 EN)
AnimationFiles.Add "ECEC4D7AC081B099056531043191B55A", ",,"             ' DMII SWOOSH (FM-Towns 1.0 JP, IBM PSV 1.0 JP, PC-9801 1.0 JP, PC-9821 1.0 JP)
AnimationFiles.Add "ABCA5430912A5C2D3D35DD8142740C72", "SND2,5500,"     ' DMII SWSH.DAT (Amiga 1.0 EN)
AnimationFiles.Add "544DA39473CDBA6F97C4714F3F617FD2", "SNDS,22050,"    ' DMII SWSH.DAT (Sega CD 1.0 EN)
AnimationFiles.Add "CFF85B539BFE4BEB589E75B9BDC02959", "SNDS,22050,"    ' DMII SWSH.DAT (Sega CD 1.0 JP)
AnimationFiles.Add "F023FD370AB1594EECA5B139A244B063", "SND2,5500,"     ' DMII TITL.DAT (Amiga 1.0 EN)
AnimationFiles.Add "C1E80401C83100319C142CF11ED44630", "SNDS,22050,"    ' DMII TITL.DAT (Sega CD 1.0 EN & JP)
AnimationFiles.Add "D795BAB0B392B61534F64163FBBEDC38", "SND2,5000,"     ' DMII TITLE (FM-Towns 1.0 JP, PC-9821 1.0 JP)
AnimationFiles.Add "1780CA2972DF5FEBA5E232B11B79B0E5", ",,"             ' DMII TITLE (IBM PSV 1.0 JP, PC-9801 1.0 JP)

CurrentPalettePL = ""
CurrentPalettePL = CurrentPalettePL & Chr(&h00) & Chr(&h00) & Chr(&h00) & Chr(&h00)
CurrentPalettePL = CurrentPalettePL & Chr(&h6D) & Chr(&h6D) & Chr(&h6D) & Chr(&h00)
CurrentPalettePL = CurrentPalettePL & Chr(&h91) & Chr(&h91) & Chr(&h91) & Chr(&h00)
CurrentPalettePL = CurrentPalettePL & Chr(&h00) & Chr(&h24) & Chr(&h6D) & Chr(&h00)
CurrentPalettePL = CurrentPalettePL & Chr(&hDA) & Chr(&hDA) & Chr(&h00) & Chr(&h00)
CurrentPalettePL = CurrentPalettePL & Chr(&h00) & Chr(&h48) & Chr(&h91) & Chr(&h00)
CurrentPalettePL = CurrentPalettePL & Chr(&h00) & Chr(&h91) & Chr(&h00) & Chr(&h00)
CurrentPalettePL = CurrentPalettePL & Chr(&h00) & Chr(&hDA) & Chr(&h00) & Chr(&h00)
CurrentPalettePL = CurrentPalettePL & Chr(&h00) & Chr(&h00) & Chr(&hFF) & Chr(&h00)
CurrentPalettePL = CurrentPalettePL & Chr(&h00) & Chr(&hB6) & Chr(&hFF) & Chr(&h00)
CurrentPalettePL = CurrentPalettePL & Chr(&h6D) & Chr(&h91) & Chr(&hDA) & Chr(&h00)
CurrentPalettePL = CurrentPalettePL & Chr(&h00) & Chr(&hFF) & Chr(&hFF) & Chr(&h00)
CurrentPalettePL = CurrentPalettePL & Chr(&h48) & Chr(&h48) & Chr(&h48) & Chr(&h00)
CurrentPalettePL = CurrentPalettePL & Chr(&hB6) & Chr(&hB6) & Chr(&hB6) & Chr(&h00)
CurrentPalettePL = CurrentPalettePL & Chr(&hFF) & Chr(&h00) & Chr(&h00) & Chr(&h00)
CurrentPalettePL = CurrentPalettePL & Chr(&hFF) & Chr(&hFF) & Chr(&hFF) & Chr(&h00)

EGAPalette = ""
EGAPalette = EGAPalette & Chr(&h00) & Chr(&h00) & Chr(&h00) & Chr(&h00)
EGAPalette = EGAPalette & Chr(&hAA) & Chr(&h00) & Chr(&h00) & Chr(&h00)
EGAPalette = EGAPalette & Chr(&h00) & Chr(&hAA) & Chr(&h00) & Chr(&h00)
EGAPalette = EGAPalette & Chr(&hAA) & Chr(&hAA) & Chr(&h00) & Chr(&h00)
EGAPalette = EGAPalette & Chr(&h00) & Chr(&h00) & Chr(&hAA) & Chr(&h00)
EGAPalette = EGAPalette & Chr(&hAA) & Chr(&h00) & Chr(&hAA) & Chr(&h00)
EGAPalette = EGAPalette & Chr(&h00) & Chr(&h55) & Chr(&hAA) & Chr(&h00)
EGAPalette = EGAPalette & Chr(&hAA) & Chr(&hAA) & Chr(&hAA) & Chr(&h00)
EGAPalette = EGAPalette & Chr(&h55) & Chr(&h55) & Chr(&h55) & Chr(&h00)
EGAPalette = EGAPalette & Chr(&hFF) & Chr(&h55) & Chr(&h55) & Chr(&h00)
EGAPalette = EGAPalette & Chr(&h55) & Chr(&hFF) & Chr(&h55) & Chr(&h00)
EGAPalette = EGAPalette & Chr(&hFF) & Chr(&hFF) & Chr(&h55) & Chr(&h00)
EGAPalette = EGAPalette & Chr(&h55) & Chr(&h55) & Chr(&hFF) & Chr(&h00)
EGAPalette = EGAPalette & Chr(&hFF) & Chr(&h55) & Chr(&hFF) & Chr(&h00)
EGAPalette = EGAPalette & Chr(&h55) & Chr(&hFF) & Chr(&hFF) & Chr(&h00)
EGAPalette = EGAPalette & Chr(&hFF) & Chr(&hFF) & Chr(&hFF) & Chr(&h00)

PC98Palette8 = ""        ' Only 8 'real' colors
PC98Palette8 = PC98Palette8 & Chr(&h00) & Chr(&h00) & Chr(&h00) & Chr(&h00)
PC98Palette8 = PC98Palette8 & Chr(&hFF) & Chr(&h00) & Chr(&h00) & Chr(&h00)
PC98Palette8 = PC98Palette8 & Chr(&h00) & Chr(&hFF) & Chr(&h00) & Chr(&h00)
PC98Palette8 = PC98Palette8 & Chr(&hFF) & Chr(&hFF) & Chr(&h00) & Chr(&h00)
PC98Palette8 = PC98Palette8 & Chr(&h00) & Chr(&h00) & Chr(&hFF) & Chr(&h00)
PC98Palette8 = PC98Palette8 & Chr(&hFF) & Chr(&h00) & Chr(&hFF) & Chr(&h00)
PC98Palette8 = PC98Palette8 & Chr(&h00) & Chr(&hFF) & Chr(&hFF) & Chr(&h00)
PC98Palette8 = PC98Palette8 & Chr(&hFF) & Chr(&hFF) & Chr(&hFF) & Chr(&h00)
PC98Palette8 = PC98Palette8 & Chr(&h00) & Chr(&h00) & Chr(&h00) & Chr(&h00)
PC98Palette8 = PC98Palette8 & Chr(&h00) & Chr(&h00) & Chr(&h00) & Chr(&h00)
PC98Palette8 = PC98Palette8 & Chr(&h00) & Chr(&h00) & Chr(&h00) & Chr(&h00)
PC98Palette8 = PC98Palette8 & Chr(&h00) & Chr(&h00) & Chr(&h00) & Chr(&h00)
PC98Palette8 = PC98Palette8 & Chr(&h00) & Chr(&h00) & Chr(&h00) & Chr(&h00)
PC98Palette8 = PC98Palette8 & Chr(&h00) & Chr(&h00) & Chr(&h00) & Chr(&h00)
PC98Palette8 = PC98Palette8 & Chr(&h00) & Chr(&h00) & Chr(&h00) & Chr(&h00)
PC98Palette8 = PC98Palette8 & Chr(&h00) & Chr(&h00) & Chr(&h00) & Chr(&h00)

CurrentPaletteP8 = EGAPalette

Dim UsePaletteP8
UsePaletteP8 = False


Endian = BIG_ENDIAN

Set ScriptArguments = WScript.Arguments
If ScriptArguments.Count = 0 Then
        MsgBox     "Decodes Dungeon Master and Chaos Strikes Back animation files." & vbCrLf & vbCrLf & _
                   "  Drag and drop a file on this VBScript file to start decoding, and wait until the end (this is very slow).", vbOKOnly + vbInformation, "Help"
Else
        If ScriptArguments.Count <= 1 Then
                MsgBox "Please click OK and wait while the data file is decoded...", vbOKOnly + vbInformation, "Help"
        End If

        DataFileName = ScriptArguments(0)

        Set fso = CreateObject("Scripting.FileSystemObject")

        Set fDat = fso.GetFile(DataFileName)
        Dim DataFileSize
        DataFileSize = fDat.Size

        Set fDat = fso.OpenTextFile(DataFileName, ForReading, True)
        BlockData = fDat.Read(DataFileSize)
        fDat.Close
        Dim strMD5Value
        strMD5Value = UCase(MD5(BlockData))

        Dim strSoundFormat, intSampleRate, P8Type
        If AnimationFiles.Exists(strMD5Value) Then
                Dim tmpRec
                tmpRec = Split(AnimationFiles(strMD5Value), ",")
                strSoundFormat = tmpRec(0)
                intSampleRate = tmpRec(1)
                P8Type =  tmpRec(2)
        Else
                strSoundFormat = ""
                intSampleRate = ""
                P8Type = ""
        End If

        Set fDat = fso.OpenTextFile(DataFileName, ForReading, True)

        If Not fso.FolderExists(ScriptArguments(0) & " - Decoded") Then
                fso.CreateFolder(ScriptArguments(0) & " - Decoded")
        End If

        Offset = 0

        Set fDump = fso.OpenTextFile(ScriptArguments(0) & " - Decoded\zzzz Dump.txt", ForWriting, True)
        fDump.WriteLine "File name" & vbTab & "Block Number" & vbTab & "Offset" & vbTab & "Block Type" & vbTab & "Block Size" & vbTab & "Block Attributes" & vbTab & "Details1" & vbTab & "Details2" & vbTab & "Details3"

        index = 0
        BlockData = ""
        PreviousBlockType = ""
        PreviousDecodedData = ""
        PreviousFileName = ""
        iString = "0000"
        While Not fDat.AtEndOfStream
                BlockOffset = Offset
                BlockType = fDat.Read(2)    ' Always read block type as big endian
                Offset = Offset + 2
                BlockSize = ReadWordOfData
                BlockAttributes = ReadWordOfData
                BlockData = ""
                If BlockSize <> 0 And BlockType <> "DO" Then    ' <> "DO"  is required for animations from DMII Sega CD (in which specified size is 8, but no data is present)
                        If BlockType = "GD" Then
                                ReDim ArrayBlockData(BlockSize)
                                For k = 0 To BlockSize - 1
                                        ArrayBlockData(k) = Asc(fDat.Read(1))
                                Next
                        Else
                                BlockData = fDat.Read(BlockSize)
                        End If
                End If
                If BlockType <> "DO" Then   ' <> "DO"  is required for animations from DMII Sega CD (in which specified size is 8, but no data is present)
                        Offset = Offset + BlockSize
                End If

                FileName = ScriptArguments(0) & " - Decoded\***" & iString & " " & BlockType & " " & BlockAttributes

                DecodedBlockPL = ""
                DecodedBlockP8 = ""
                BlockDataDump = ""
                DetailedDump = ""

                Select Case BlockType
                        Case "AN", "SO"
                                If Len(BlockData) > 0 Then
                                        For j = 1 To Len(BlockData)
                                                BlockDataDump = BlockDataDump & Pad(Hex(Asc(Mid(BlockData, j, 1)))) & " "
                                        Next
                                End If

                        Case "P8"
                                UsePaletteP8 = True
                                FileName = FileName & ".bin"

                                For j = 1 To Len(BlockData)
                                        BlockDataDump = BlockDataDump & Pad(Hex(Asc(Mid(BlockData, j, 1)))) & " "
                                Next

                                DecodedBlockPL = BlockData

                                If P8Type = "PC" Then
                                    CurrentPaletteP8 = ""
                                    For j = 1 To 16
                                            CurrentPaletteP8 = CurrentPaletteP8 & Mid(EGAPalette, Asc(Mid(BlockData, j, 1)) * 4 + 1, 4)
                                    Next
                                End If

                                If P8Type = "PC98" Then
                                        CurrentPaletteP8 = PC98Palette8
                                        For j = 1 To 16
                                                ByteValue = Asc(Mid(BlockData, j, 1))
                                                PC98ColorMap(j - 1, 0) = ((ByteValue And &H02) * 2) + ((ByteValue And &H04) \ 2)  + ((ByteValue And &H08) \ 8)
                                                PC98ColorMap(j - 1, 1) = ((ByteValue And &H10) \ 4) + ((ByteValue And &H20) \ 16) + ((ByteValue And &H40) \ 64)
                                                PC98ColorMap(j - 1, 2) = PC98ColorMap(j - 1, 0)
                                                If (ByteValue And 1) = 0 Then
                                                        PC98ColorMap(j - 1, 3) = 0
                                                Else
                                                        PC98ColorMap(j - 1, 3) = PC98ColorMap(j - 1, 1)
                                                End If
                                        Next
                                End If

                        Case "PL"
                                FileName = FileName & ".bin"

                                For j = 1 To Len(BlockData)
                                        BlockDataDump = BlockDataDump & Pad(Hex(Asc(Mid(BlockData, j, 1)))) & " "
                                Next

                                DecodedBlockPL = BlockData

                                CurrentPalettePL = ""
                                For j = 0 To 15
                                        CurrentPalettePL = CurrentPalettePL & Chr((Asc(Mid(BlockData, j * 4 + 6, 1)) And &h0F) * 17) & Chr((Asc(Mid(BlockData, j * 4 + 5, 1)) And &h0F) * 17) & Chr((Asc(Mid(BlockData, j * 4 + 4, 1)) And &h0F) * 17) & Chr(&h00)
                                Next

                                ' Manage case where PL item is after an FS item by writing again the FS item
                                If PreviousBlockType = "FS" Then
                                        Set fItem = fso.OpenTextFile(PreviousFileName, ForWriting, True)
                                        fItem.Write BuildBMPHeader(320, 200, 4, False) & PreviousDecodedData
                                        fItem.Close
                                End If

                        Case "EN"
                                FileName = FileName & ".bmp"
                                CharIndex = 5
                                n = 0
                                DecodedBlockPL = DecodeIMG2(BlockData, BIG_ENDIAN, False, False)
                                If UsePaletteP8 Then
                                        CharIndex = 5
                                        n = 0
                                        DecodedBlockP8 = DecodeIMG2(BlockData, BIG_ENDIAN, False, True)
                                End If

                        Case "DL"
                                FileName = FileName & ".bmp"
                                CharIndex = 7
                                n = 0
                                DecodedBlockPL = DecodeIMG2(BlockData, BIG_ENDIAN, True, False)
                                If UsePaletteP8 Then
                                        CharIndex = 7
                                        n = 0
                                        DecodedBlockP8 = DecodeIMG2(BlockData, BIG_ENDIAN, True, True)
                                End If

                        Case "FS"
                                FileName = FileName & ".bmp"

                                For j = 1 To 4
                                        BlockDataDump = BlockDataDump & Pad(Hex(Asc(Mid(BlockData, j, 1)))) & " "
                                Next

                                For j = 199 To 0 Step -1
                                        For k = 0 To 159
                                                ImageData(j, k) = Asc(Mid(BlockData, j * 160 + 5 + k, 1))
                                                DecodedBlockPL = DecodedBlockPL & Chr(ImageData(j, k))
                                        Next
                                Next
                                PreviousDecodedData = DecodedBlockPL
                                DecodedBlockPL = BuildBMPHeader(320, 200, 4, False) & DecodedBlockPL

                        Case "MF", "SF"
                                FileName = FileName & ".txt"
                                BlockDataDump = Replace(BlockData, Chr(0), "<00>")
                                DecodedBlockPL = BlockDataDump

                        Case "SD"
                                Select Case strSoundFormat
                                        Case "SND2"
                                                FileName = FileName & ".wav"
                                                DecodedBlockPL = DecodeSND2(BlockData, intSampleRate)
                                        Case "SND3"
                                                FileName = FileName & ".wav"
                                                DecodedBlockPL = DecodeSND3(BlockData, intSampleRate)
                                        Case "SND4"
                                                FileName = FileName & ".wav"
                                                CharIndex = 3
                                                n = 0
                                                DecodedBlockPL = DecodeSND4(BlockData, intSampleRate, BIG_ENDIAN)
                                        Case "SNDS"
                                                FileName = FileName & ".bin"
                                                DecodedBlockPL = BlockData
                                                SDFull = SDFull & DecodeSNDS(BlockData, intSampleRate)
                                        Case Else
                                                FileName = FileName & ".bin"
                                                DecodedBlockPL = BlockData
                                End Select

                        Case "GD"
                                FileName = FileName & ".bmp"

                                For j = 0 To 3
                                        BlockDataDump = BlockDataDump & Pad(Hex(ArrayBlockData(j))) & " "
                                Next

                                Dim tmpDump
                                For j = 0 To BlockAttributes - 1
                                        tmpDump = ""
                                        For k = 0 To 1
                                                tmpDump = tmpDump & Pad(Hex(ArrayBlockData(4 + (34 * j) + k)))
                                        Next
                                        tmpDump = tmpDump & vbTab
                                        For k = 0 To 3
                                                If k = 2 Then
                                                        tmpDump = tmpDump & vbTab
                                                End If
                                                tmpDump = tmpDump & Pad(Hex(ArrayBlockData(4 + (34 * BlockAttributes) + (4 * j) + k)))
                                        Next
                                        DetailedDump = DetailedDump & DataFileName & vbTab & "iString-" & Right("000" & j, 4) & vbTab & "" & vbTab & BlockType & "-Tile" & vbTab & "" & vbTab & "" & vbTab & tmpDump & vbCrLf
                                Next
                                DecodedBlockPL = DecodeGD(ArrayBlockData, BlockAttributes)

                        Case "XA"
                                FileName = FileName & ".bin"
                                DecodedBlockPL = BlockData

                        Case Else
                                FileName = FileName & ".bin"
                                DecodedBlockPL = BlockData
                End Select

                index = index + 1
                iString = CStr(index)
                Select Case Len(iString)
                        Case 1
                                iString = "000" & iString
                        Case 2
                                iString = "00" & iString
                        Case 3
                                iString = "0" & iString
                End Select

                fDump.Write DataFileName & vbTab & iString & vbTab & BlockOffset & vbTab & BlockType & vbTab & BlockSize & vbTab & BlockAttributes & vbTab & BlockDataDump & vbCrLf
                fDump.Write Replace(DetailedDump, "iString", iString)

                If DecodedBlockP8 = "" Then
                        Set fItem = fso.OpenTextFile(Replace(FileName, "***", ""), ForWriting, True)
                        fItem.Write DecodedBlockPL
                        fItem.Close
                Else
                        Set fItem = fso.OpenTextFile(Replace(FileName, "***", "PL_"), ForWriting, True)
                        fItem.Write DecodedBlockPL
                        fItem.Close
                        Set fItem = fso.OpenTextFile(Replace(FileName, "***", "P8_"), ForWriting, True)
                        fItem.Write DecodedBlockP8
                        fItem.Close
                End If
                FileName = Replace(FileName, "***", "")
                
                If BlockType = "XA" Then
                        Dim objWshShell
                        Set objWshShell = CreateObject("WScript.Shell")
                        ' Run wscript and this very same script on the XA bin file produced to decode it in a subfolder
                        Dim strCmdLine
                        strCmdLine = """" & WScript.FullName & """ """ & WScript.ScriptFullName & """ """ & FileName & """ /quiet"
                        objWshShell.Run strCmdLine
                End If

                PreviousBlockType = BlockType
                PreviousFileName = FileName
        Wend

        If SDFull <> "" Then
                FileName = ScriptArguments(0) & " - Decoded\SDFull.wav"
                Set fItem = fso.OpenTextFile(FileName, ForWriting, True)
                fItem.Write BuildWAVHeader(Len(SDFull), intSampleRate, 8) & SDFull
                fItem.Close
        End If

        fDat.Close
        fDump.Close

        If ScriptArguments.Count <= 1 Then
                MsgBox "Data file decoding done.", vbOKOnly + vbInformation, "Help"
        End If
End If

Function ReadWordOfData
    If Endian = BIG_ENDIAN Then
        ReadWordOfData = Asc(fDat.Read(1)) * 256 + Asc(fDat.Read(1))
    Else
        ReadWordOfData = Asc(fDat.Read(1)) + 256 * Asc(fDat.Read(1))
    End If
    Offset = Offset + 2
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 BuildBMPHeader(BMPWidth, BMPHeight, BMPPixelDepth, pUsePaletteP8)
    Dim BMPPalette, BMPPaletteSize, BMPOffset, LinePadding, ImageOffset, BitmapSize, UsedColors, SignificantColors

    If BMPPixelDepth = 1 Then
        BMPPalette = BMPPalette & Chr(&h00) & Chr(&h00) & Chr(&h00) & Chr(&h00) ' Color #01: Blue:   0 Green:   0 Red:   0 Reserved: 0 (Black)
        BMPPalette = BMPPalette & Chr(&hFF) & Chr(&hFF) & Chr(&hFF) & Chr(&h00) ' Color #16: Blue: 255 Green: 255 Red: 255 Reserved: 0 (White)
        BMPPaletteSize = 8
    End If
    If BMPPixelDepth = 4 Then
        If pUsePaletteP8 Then
                BMPPalette = CurrentPaletteP8
        Else
                BMPPalette = CurrentPalettePL
        End If
        BMPPaletteSize = 64
    End If
    If BMPPixelDepth = 8 Then
        BMPPalette = ""
        BMPPaletteSize = 1024
    End If

    LinePadding = (BMPWidth * BMPPixelDepth) Mod 32
    If LinePadding <> 0 Then
        LinePadding = 32 - LinePadding
    End If
    ImageOffset = 54 + BMPPaletteSize
    BitmapSize = ((BMPWidth * BMPPixelDepth) + LinePadding) * BMPHeight / 8
    BMPOffset = ImageOffset + BitmapSize
    UsedColors = 2^BMPPixelDepth
    SignificantColors = UsedColors

    BuildBMPHeader = Chr(&h42) & Chr(&h4D)                                          ' File ID               WORD    Always "BM"
    BuildBMPHeader = BuildBMPHeader & IntToString(BMPOffset)                        ' File Size             DWORD
    BuildBMPHeader = BuildBMPHeader & Chr(&h00) & Chr(&h00)                         ' Reserved              WORD    Always 0
    BuildBMPHeader = BuildBMPHeader & Chr(&h00) & Chr(&h00)                         ' Reserved              WORD    Always 0
    BuildBMPHeader = BuildBMPHeader & IntToString(ImageOffset)                      ' Image Offset          DWORD
    BuildBMPHeader = BuildBMPHeader & Chr(&h28) & Chr(&h00) & Chr(&h00) & Chr(&h00) ' Header Size           DWORD   Always 40 bytes
    BuildBMPHeader = BuildBMPHeader & IntToString(BMPWidth)                         ' Image Width           DWORD
    BuildBMPHeader = BuildBMPHeader & IntToString(BMPHeight)                        ' Image Height          DWORD
    BuildBMPHeader = BuildBMPHeader & Chr(&h01) & Chr(&h00)                         ' Number of planes      WORD    Always 1
    BuildBMPHeader = BuildBMPHeader & Chr(BMPPixelDepth) & Chr(&h00)                ' Pixel Depth           WORD
    BuildBMPHeader = BuildBMPHeader & Chr(&h00) & Chr(&h00) & Chr(&h00) & Chr(&h00) ' Compression           DWORD   0 (no compression)
    BuildBMPHeader = BuildBMPHeader & IntToString(BitmapSize)                       ' Bitmap Size           DWORD
    BuildBMPHeader = BuildBMPHeader & Chr(&h13) & Chr(&h0B) & Chr(&h00) & Chr(&h00) ' Horizontal resolution DWORD   2835 pixels/m = 72 pixels/inch
    BuildBMPHeader = BuildBMPHeader & Chr(&h13) & Chr(&h0B) & Chr(&h00) & Chr(&h00) ' Vertical resolution   DWORD   2835 pixels/m = 72 pixels/inch
    BuildBMPHeader = BuildBMPHeader & IntToString(UsedColors)                       ' Used Colors           DWORD
    BuildBMPHeader = BuildBMPHeader & IntToString(SignificantColors)                ' Significant Colors    DWORD
    BuildBMPHeader = BuildBMPHeader & BMPPalette
End Function

Function DecodeIMG2(ItemData, SizeEndian, Signature, pUsePaletteP8)
    Dim ImageWidth, ImageHeight, i, j, ok, temp, LinePadding, BMPLine, BMPLine2
    Dim Nibble1, Nibble2, Mode, NumberOfPixels

    If Signature Then
        If Mid(ItemData, 1, 2) <> Chr(&hFF) & Chr(&h81) Then
            MsgBox "Invalid DL signature found.", vbOKOnly + vbExclamation, "Warning"
        End If
        If SizeEndian = BIG_ENDIAN Then
            ImageWidth = Asc(Mid(ItemData, 3, 1)) * 256 + Asc(Mid(ItemData, 4, 1))
            ImageHeight = Asc(Mid(ItemData, 5, 1)) * 256 + Asc(Mid(ItemData, 6, 1))
        Else
            ImageWidth = Asc(Mid(ItemData, 3, 1)) + 256 * Asc(Mid(ItemData, 4, 1))
            ImageHeight = Asc(Mid(ItemData, 5, 1)) + 256 * Asc(Mid(ItemData, 6, 1))
        End If
    Else
        If SizeEndian = BIG_ENDIAN Then
            ImageWidth = Asc(Mid(ItemData, 1, 1)) * 256 + Asc(Mid(ItemData, 2, 1))
            ImageHeight = Asc(Mid(ItemData, 3, 1)) * 256 + Asc(Mid(ItemData, 4, 1))
        Else
            ImageWidth = Asc(Mid(ItemData, 1, 1)) + 256 * Asc(Mid(ItemData, 2, 1))
            ImageHeight = Asc(Mid(ItemData, 3, 1)) + 256 * Asc(Mid(ItemData, 4, 1))
        End If
    End If

    PixelCount = 0

    While PixelCount < ImageWidth * ImageHeight - 1
        Nibble1 = GetNextNibble
        Nibble2 = GetNextNibble

        Select Case Nibble1
            Case &h00, &h01, &h02, &h03, &h04, &h05, &h06, &h07
                Mode = 0    ' Add pixels of the same color
                NumberOfPixels = Nibble1 + 1

            Case &h08
                Mode = 0    ' Add pixels of the same color
                NumberOfPixels = GetNextNibble * 2^4 + GetNextNibble + 1

            Case &h0C
                Mode = 0    ' Add pixels of the same color
                NumberOfPixels = GetNextNibble * 2^12 + GetNextNibble * 2^8 + GetNextNibble * 2^4 + GetNextNibble + 1

            Case &h0B
                Mode = 1    ' Copy pixels starting from previous line
                NumberOfPixels = GetNextNibble * 2^4 + GetNextNibble + 1

            Case &h0F
                Mode = 1    ' Copy pixels starting from previous line
                NumberOfPixels = GetNextNibble * 2^12 + GetNextNibble * 2^8 + GetNextNibble * 2^4 + GetNextNibble + 1

            Case &h09
                Mode = 2    ' Raw list of pixels
                NumberOfPixels = GetNextNibble * 2^4 + GetNextNibble + 1
                ' 9 & pixel1 if odd number of pixels
                ' 90 if even number of pixels
                ' followed by 1 byte for the number of following pixels (necessarily even)
                ' followed by (number of pixels / 2) bytes.

            Case &h0A
                Mode = 3    ' Transparent pixels (only used in animations in DL items)
                NumberOfPixels = Nibble2 + 1

            Case &h0E
                Mode = 3    ' Transparent pixels (only used in animations in DL items)
                Select Case Nibble2
                    Case &h00, &h01, &h02, &h03, &h03, &h04, &h05, &h06, &h07, &h08, &h09, &h0A, &h0B, &h0C
                        NumberOfPixels = Nibble2 + 17

                    Case &h0D
                        NumberOfPixels = GetNextNibble * 2^4 + GetNextNibble + 1

                    Case &h0E
                        NumberOfPixels = GetNextNibble * 2^4 + GetNextNibble + 257

                    Case &h0F
                        NumberOfPixels = GetNextNibble * 2^12 + GetNextNibble * 2^8 + GetNextNibble * 2^4 + GetNextNibble + 1
                End Select

            Case &h0D
                MsgBox "Unknown Nibble1 found: 0Dh", vbOKOnly + vbExclamation, "Warning"
        End Select

        Select Case Mode
            Case 0    ' Add pixels of the same color
                For i = 0 To NumberOfPixels - 1
                    PixelBuffer(PixelCount) = Nibble2
                    PixelCount = PixelCount + 1
                Next

            Case 1    ' Copy pixels starting from previous line
                For i = 0 To NumberOfPixels - 1
                    PixelBuffer(PixelCount) = PixelBuffer(PixelCount - ImageWidth)
                    PixelCount = PixelCount + 1
                Next
                PixelBuffer(PixelCount) = Nibble2
                PixelCount = PixelCount + 1

            Case 2    ' Raw list of pixels
                If (NumberOfPixels Mod 2 <> 0) Then
                    PixelBuffer(PixelCount) = Nibble2
                    PixelCount = PixelCount + 1
                    NumberOfPixels = NumberOfPixels - 1
                End If
                For i = 0 To NumberOfPixels - 1
                    PixelBuffer(PixelCount) = GetNextNibble
                    PixelCount = PixelCount + 1
                Next

            Case 3    ' Transparent pixels (only used in animations in DL items)
                PixelCount = PixelCount + NumberOfPixels
        End Select
    Wend

    If pUsePaletteP8 And P8Type = "PC98" Then
        LinePadding = (ImageWidth * 2) Mod 8
        If LinePadding <> 0 Then
            LinePadding = 8 - LinePadding
        End If
        ReDim BMPLine(ImageWidth * 2 + LinePadding)
        ReDim BMPLine2(ImageWidth * 2 + LinePadding)
        
        ok = 0
        For j = ImageHeight - 1 To 0 Step -1
            For i = 0 To ImageWidth - 1
                BMPLine(2 * i) = PC98ColorMap(PixelBuffer(j * ImageWidth + i), 0)
                BMPLine(2 * i + 1) = PC98ColorMap(PixelBuffer(j * ImageWidth + i), 1)
                BMPLine2(2 * i) = PC98ColorMap(PixelBuffer(j * ImageWidth + i), 2)
                BMPLine2(2 * i + 1) = PC98ColorMap(PixelBuffer(j * ImageWidth + i), 3)
            Next
            If LinePadding <> 0 Then
                For i = 0 To LinePadding - 1
                    BMPLine(ImageWidth * 2 + i) = 0
                    BMPLine2(ImageWidth * 2 + i) = 0
                Next
            End If

            For i = 0 To (ImageWidth * 2) + LinePadding - 1
                If ok = 1 Then
                    DecodeIMG2 = DecodeIMG2 & Chr(temp + BMPLine2(i))
                Else
                    temp = BMPLine2(i) * 16
                End If
                ok = 1 - ok
            Next
            For i = 0 To (ImageWidth * 2) + LinePadding - 1
                If ok = 1 Then
                    DecodeIMG2 = DecodeIMG2 & Chr(temp + BMPLine(i))
                Else
                    temp = BMPLine(i) * 16
                End If
                ok = 1 - ok
            Next
        Next
        DecodeIMG2 = BuildBMPHeader(ImageWidth * 2, ImageHeight * 2, 4, pUsePaletteP8) & DecodeIMG2
    Else
        LinePadding = ImageWidth Mod 8
        If LinePadding <> 0 Then
            LinePadding = 8 - LinePadding
        End If
        ReDim BMPLine(ImageWidth + LinePadding)
        
        ok = 0
        For j = ImageHeight - 1 To 0 Step -1
            For i = 0 To ImageWidth - 1
                BMPLine(i) = PixelBuffer(j * ImageWidth + i)
            Next
            If LinePadding <> 0 Then
                For i = 0 To LinePadding - 1
                    BMPLine(ImageWidth + i) = 0
                Next
            End If
        
            For i = 0 To ImageWidth + LinePadding - 1
                If ok = 1 Then
                    DecodeIMG2 = DecodeIMG2 & Chr(temp + BMPLine(i))
                Else
                    temp = BMPLine(i) * 16
                End If
                ok = 1 - ok
            Next
        Next
        DecodeIMG2 = BuildBMPHeader(ImageWidth, ImageHeight, 4, pUsePaletteP8) & DecodeIMG2
    End If
End Function

Function GetNextNibble
    If n = 0 Then
        Nibbles = Asc(Mid(BlockData, CharIndex, 1))
        CharIndex = CharIndex + 1
        GetNextNibble = (Nibbles And &hF0) \ 2^4
    Else
        GetNextNibble = Nibbles And &h0F
    End If
    n = 1 - n
End Function

Function DecodeGD(ArrayBlockData, NbTiles)
    Dim n, nTile, xTile, yTile, pTile, bTile, px, py, tmp, nibble, nx, ny, pixelX, pixelY

    For nTile = 0 To NbTiles - 1
        tmp = 4 + 34 * NbTiles + 4 * nTile
        tmp = ArrayBlockData(tmp) * 256 + ArrayBlockData(tmp + 1)
        xTile = (tmp And &h7E) \ 2
        yTile = ((tmp And &hF80) \ 128) - 2
        pTile = (tmp And &hF000) \ 4096
        bTile = (tmp And &h01)
        If bTile <> 0 Then MsgBox "bTile = " & bTile & " at tile " & nTile & " out of " & NbTiles
        If pTile <> 0 Then MsgBox "pTile = " & pTile & " at tile " & nTile & " out of " & NbTiles

        For py = 0 To 7
            For px = 0 To 3
                pixelX = xTile * 4 + px
                pixelY = yTile * 8 + py
                nibble = ArrayBlockData(6 + (34 * nTile) + 4 * py + px)
                ImageData(pixelY, pixelX) = nibble
            Next
        Next
    Next

    For ny = 199 To 0 Step -1
        For nx = 0 To 159
            DecodeGD = DecodeGD & Chr(ImageData(ny, nx))
        Next
    Next
    DecodeGD = BuildBMPHeader(320, 200, 4, False) & DecodeGD
End Function

Function Pad(x)
  If Len(x) = 1 Then
    Pad = "0" & x
  Else
    Pad = x
  End If
End Function

Function BuildWAVHeader(SoundDataSize, SampleRate, BitsPerSample)
    Select Case SampleRate
        Case "SPR1"
            SampleRate = 6000
        Case "SPR2"
            SampleRate = 10740
        Case "SPR3"
            SampleRate = 9740
        Case "SPR4"
            SampleRate = 7812
        Case "SPR5"
            SampleRate = 11025
    End Select
    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

Function DecodeSND2(SoundItem, SampleRate)
    Dim SoundDataSize, i

    SoundDataSize = Asc(Left(SoundItem, 1)) * 256 + Asc(Mid(SoundItem, 2, 1))
    DecodeSND2 = BuildWAVHeader(SoundDataSize, SampleRate, 8)
    For i = 0 To SoundDataSize - 1
        DecodeSND2 = DecodeSND2 & Chr((128 + Asc(Mid(SoundItem, 3 + i, 1))) Mod 256)
    Next
End Function

Function DecodeSND3(SoundItem, SampleRate)
    Dim SoundDataSize

    SoundDataSize = Asc(Left(SoundItem, 1)) * 256 + Asc(Mid(SoundItem, 2, 1))
    DecodeSND3 = BuildWAVHeader(SoundDataSize, SampleRate, 8) & Mid(SoundItem, 3, SoundDataSize)
End Function

Function DecodeSND4(SoundItem, SampleRate, SizeEndian)
    Dim SoundDataSize, i, x, Sample, Repeat, k, OutputSample
    Dim dltLTBL
    ReDim dltLTBL(49)
    dltLTBL = Array(16,17,19,21,23,25,28,31,34,37,41,45,50,55,60,66,73,80,88,97, _
                    107,118,130,143,157,173,190,209,230,253,279,307,337,371,408, _
                    449,494,544,598,658,724,796,876,963,1060,1166,1282,1411,1552)
    Dim DCT
    ReDim DCT(16)
    DCT = Array(-1,-1,-1,-1,2,4,6,8,-1,-1,-1,-1,2,4,6,8)

    Dim StepSize, diff, index
    index = 0
    Sample = 0

    If SizeEndian = BIG_ENDIAN Then
        SoundDataSize = Asc(Mid(SoundItem, 1, 1)) * 256 + Asc(Mid(SoundItem, 2, 1))
    Else
        SoundDataSize = Asc(Mid(SoundItem, 1, 1)) + 256 * Asc(Mid(SoundItem, 2, 1))
    End If

    DecodeSND4 = BuildWAVHeader(SoundDataSize * 2, SampleRate, 16)
    i = 0
    While i < SoundDataSize
        x = GetNextNibble2
        StepSize = dltLTBL(index)  ' Initial step size value will be 16 for index 0

        diff =        (StepSize      * ((x And &h4) \ 4)) _
                + ((StepSize \ 2) * ((x And &h2) \ 2)) _
                + ((StepSize \ 4) * ((x And &h1))) _
                +  (StepSize \ 8)

        If (((x And &h8) \ 8) = 1) Then diff = diff * -1

        Sample = Sample + diff
        If Sample > 2047 Then Sample = 2047
        If Sample < -2048 Then Sample = -2048

        OutputSample = Sample * 16
        If OutputSample < 0 Then OutputSample = OutputSample + 65536
        DecodeSND4 = DecodeSND4 & Chr(OutputSample Mod 256) & Chr(OutputSample \ 256)

        index = index + DCT(x)
        If index < 0 Then index = 0
        If index > 48 Then index = 48

        i = i + 1
    Wend
End Function

Function GetNextNibble2
    GetNextNibble2 = 0

    If CharIndex <= Len(BlockData) Then
        If n = 0 Then
            Nibbles = Asc(Mid(BlockData, CharIndex, 1))
            GetNextNibble2 = Nibbles And &h0F
        Else
            CharIndex = CharIndex + 1
            GetNextNibble2 = (Nibbles And &hF0) \ 2^4
        End If
        n = 1 - n
    End If
End Function

Function DecodeSNDS(SoundItem, SampleRate)
    Dim SoundDataSize, i

    SoundDataSize = Len(SoundItem)

    Dim Sample
    For i = 1 To SoundDataSize
    Sample = Asc(Mid(SoundItem, i, 1))
    If Sample > 127 Then
      DecodeSNDS = DecodeSNDS & Chr(Sample)
    Else
      DecodeSNDS = DecodeSNDS & Chr(128 - Sample)
    End If
    Next
End Function
