Option Explicit

'Bild als Ressource einbinden
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" _
(ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Declare Function GetTempFileName Lib "kernel32" Alias "GetTempFileNameA" _
(ByVal lpszPath As String, ByVal lpPrefixString As String, ByVal wUnique As Long, ByVal lpTempFileName As String) As Long

'Deklarationsbereich

Dim Counter
Dim TextCounter
Dim PointerCounter
Dim strInputFile
Dim strOutputFile

Dim intPointer As Integer
Dim intCounter As Integer

Dim bytInput As Byte
Dim bytInput2 As Byte
Dim strOutput As String

Dim arrTable(255) As String
Dim arrNames(14) As String

Dim lngPointerStart As Long
Dim lngTextStart As Long

Private Sub cmdDUMP_Click()

Counter = 0                                                                 'Variable "Counter" auf 0 setzen

lngPointerStart = txtPointerStart.Text                                      'Variable "lngPointerStart" auf Pointeroffset setzen
lngTextStart = txtTextStart.Text                                            'Variable "lngTextStart" auf Textoffset setzen
intCounter = txtTextLänge.Text

    Open strInputFile For Binary As #1                                      'Öffne Datei hinter Variable "strInputFile" binär und deklariere als #1
    strOutputFile = "DUMP.txt"                                              'Variable "strOutputFile" = "strInputFile" und _DUMP.txt
    Open strOutputFile For Output As #2                                     'Erzeuge Datei "strOutputFile" zwecks Speichern und deklariere als #2

    Do                                                                      'Beginn der Do-Schleife
        Get #1, lngPointerStart + 1 + Counter, intPointer                   'Nimm #1, gehe zu Pointeroffset +1 +Counterwert und speichere gelesenen Wert in "intPointer"
            Call Decompress_Text                                            'Rufe Prozedur "Decompress_Text" auf

        Counter = Counter + 2                                               'Erhöhe Counter um 2

    Loop Until Counter = intCounter                                         'Wiederhole Schleife bis Counter 1024 erreicht hat (512 mal)

    Close #1                                                                'Schließe #1
    Close #2                                                                'Schließe #2

    cmdDUMP.Caption = "RDY"                                                 'Button = RDY

End Sub

Private Sub Decompress_Text()                                                           'Neue Prozedur "Decompress_Text"

strOutput = ""                                                                          'strOutput zurücksetzen
TextCounter = 0                                                                         'TextCounter mit 0 initialisieren

    Do                                                                                  'Beginn der Do-Schleife
        Get #1, lngTextStart + intPointer + TextCounter + 1, bytInput

                Select Case (bytInput)

                Case 0 To 2, 66 To 117, 128 To 255:
                    strOutput = strOutput & arrTable(bytInput)

                Case 4:
                    Get #1, lngTextStart + intPointer + TextCounter + 2, bytInput2
                    strOutput = strOutput & arrNames(bytInput2)
                    TextCounter = TextCounter + 1

                Case 3, 5, 7 To 8:
                    strOutput = strOutput & "<$" & Format(bytInput, "000") & ">"
                    Get #1, lngTextStart + intPointer + TextCounter + 2, bytInput2
                    strOutput = strOutput & "<$" & Format(bytInput2, "000") & ">"
                    TextCounter = TextCounter + 1

                Case Else:
                    strOutput = strOutput & "<$" & Format(bytInput, "000") & ">"

                End Select

        TextCounter = TextCounter + 1

    Loop Until bytInput = 0

    PointerCounter = PointerCounter + 1

    Print #2, "[POINTER_#" & Format(Counter / 2, "0000") & "]"
    Print #2, strOutput
    Print #2, "/END"
    Print #2, ""

End Sub

Private Sub File1_Click()

strInputFile = File1.FileName

End Sub

Private Sub Form_Load()

picCover.Picture = LoadResImage(101, "JPG")

'Control
arrTable(0) = ""
arrTable(1) = "(nl)" & Chr(&HD) & Chr(&HA)
arrTable(2) = "(nb)" & Chr(&HD) & Chr(&HA)

'Alphabet
arrTable(66) = "A"
arrTable(67) = "B"
arrTable(68) = "C"
arrTable(69) = "D"
arrTable(70) = "E"
arrTable(71) = "F"
arrTable(72) = "G"
arrTable(73) = "H"
arrTable(74) = "I"
arrTable(75) = "J"
arrTable(76) = "K"
arrTable(77) = "L"
arrTable(78) = "M"
arrTable(79) = "N"
arrTable(80) = "O"
arrTable(81) = "P"
arrTable(82) = "Q"
arrTable(83) = "R"
arrTable(84) = "S"
arrTable(85) = "T"
arrTable(86) = "U"
arrTable(87) = "V"
arrTable(88) = "W"
arrTable(89) = "X"
arrTable(90) = "Y"
arrTable(91) = "Z"
arrTable(92) = "a"
arrTable(93) = "b"
arrTable(94) = "c"
arrTable(95) = "d"
arrTable(96) = "e"
arrTable(97) = "f"
arrTable(98) = "g"
arrTable(99) = "h"
arrTable(100) = "i"
arrTable(101) = "j"
arrTable(102) = "k"
arrTable(103) = "l"
arrTable(104) = "m"
arrTable(105) = "n"
arrTable(106) = "o"
arrTable(107) = "p"
arrTable(108) = "q"
arrTable(109) = "r"
arrTable(110) = "s"
arrTable(111) = "t"
arrTable(112) = "u"
arrTable(113) = "v"
arrTable(114) = "w"
arrTable(115) = "x"
arrTable(116) = "y"
arrTable(117) = "z"

'Numbers
arrTable(128) = "0"
arrTable(129) = "1"
arrTable(130) = "2"
arrTable(131) = "3"
arrTable(132) = "4"
arrTable(133) = "5"
arrTable(134) = "6"
arrTable(135) = "7"
arrTable(136) = "8"
arrTable(137) = "9"

'Symbols
arrTable(192) = "'"
arrTable(193) = "."
arrTable(194) = "-"
arrTable(195) = "..."
arrTable(196) = "!"
arrTable(197) = "?"
arrTable(198) = "%"
arrTable(199) = "/"
arrTable(200) = ": "
arrTable(201) = ","

'Compressed
arrTable(138) = "e "
arrTable(139) = " t"
arrTable(140) = "th"
arrTable(141) = "he"
arrTable(142) = "t "
arrTable(143) = "ou"
arrTable(144) = " a"
arrTable(145) = "s "
arrTable(146) = "er"
arrTable(147) = "in"
arrTable(148) = "re"
arrTable(149) = "d "
arrTable(150) = "an"
arrTable(151) = " o"
arrTable(152) = "on"
arrTable(153) = "st"
arrTable(154) = " w"
arrTable(155) = "o "
arrTable(156) = " m"
arrTable(157) = "ha"
arrTable(158) = "to"
arrTable(159) = "is"
arrTable(160) = "yo"
arrTable(161) = " y"
arrTable(162) = " i"
arrTable(163) = "al"
arrTable(164) = "ar"
arrTable(165) = " h"
arrTable(166) = "r "
arrTable(167) = " s"
arrTable(168) = "at"
arrTable(169) = "n "
arrTable(170) = " c"
arrTable(171) = "ng"
arrTable(172) = "ve"
arrTable(173) = "ll"
arrTable(174) = "y "
arrTable(175) = "nd"
arrTable(176) = "en"
arrTable(177) = "ed"
arrTable(178) = "hi"
arrTable(179) = "or"
arrTable(180) = ", "
arrTable(181) = "I "
arrTable(182) = "u "
arrTable(183) = "me"
arrTable(184) = "ta"
arrTable(185) = " b"
arrTable(186) = " I"
arrTable(187) = "te"
arrTable(188) = "of"
arrTable(189) = "ea"
arrTable(190) = "ur"
arrTable(191) = "l "
arrTable(202) = " f"
arrTable(203) = " d"
arrTable(204) = "ow"
arrTable(205) = "se"
arrTable(206) = "  "
arrTable(207) = "it"
arrTable(208) = "et"
arrTable(209) = "le"
arrTable(210) = "f "
arrTable(211) = " g"
arrTable(212) = "es"
arrTable(213) = "ro"
arrTable(214) = "ne"
arrTable(215) = "ry"
arrTable(216) = " l"
arrTable(217) = "us"
arrTable(218) = "no"
arrTable(219) = "ut"
arrTable(220) = "ca"
arrTable(221) = "as"
arrTable(222) = "Th"
arrTable(223) = "ai"
arrTable(224) = "ot"
arrTable(225) = "be"
arrTable(226) = "el"
arrTable(227) = "om"
arrTable(228) = "'s"
arrTable(229) = "il"
arrTable(230) = "de"
arrTable(231) = "gh"
arrTable(232) = "ay"
arrTable(233) = "nt"
arrTable(234) = "Wh"
arrTable(235) = "Yo"
arrTable(236) = "wa"
arrTable(237) = "oo"
arrTable(238) = "We"
arrTable(239) = "g "
arrTable(240) = "ge"
arrTable(241) = " n"
arrTable(242) = "ee"
arrTable(243) = "wi"
arrTable(244) = " M"
arrTable(245) = "ke"
arrTable(246) = "we"
arrTable(247) = " p"
arrTable(248) = "ig"
arrTable(249) = "ys"
arrTable(250) = " B"
arrTable(251) = "am"
arrTable(252) = "ld"
arrTable(253) = " W"
arrTable(254) = "la"
arrTable(255) = " "

'Names
arrNames(0) = "[Cecil]"
arrNames(1) = "[Kain]"
arrNames(2) = "[Rydia]"
arrNames(3) = "[Tellah]"
arrNames(4) = "[Edward]"
arrNames(5) = "[Rosa]"
arrNames(6) = "[Yang]"
arrNames(7) = "[Palom]"
arrNames(8) = "[Porom]"
arrNames(9) = "[Cid]"
arrNames(10) = "[Edge]"
arrNames(11) = "[FuSoYa]"
arrNames(12) = "[Golbez]"
arrNames(13) = "[Anna]"


End Sub

Function LoadResImage(ByVal ResID As Variant, ByVal ResTYPE As Variant) As IPictureDisp
   Dim Data() As Byte, tmpPath As String, New_tmpPath As String, Prefix As String
   Dim FileNum As Integer, Counter As Integer, Char As String

   tmpPath = Space(260)
   Prefix = "res"

   If GetTempPath(Len(tmpPath) - 1, tmpPath) <> 0 Then
      If GetTempFileName(tmpPath, Prefix, 0, tmpPath) <> 0 Then
         'Unnötige Nullzeichen entfernen
         For Counter = 1 To Len(tmpPath)
            Char = Mid(tmpPath, Counter, 1)
            If Char <> Chr(0) And Char <> Chr(32) Then New_tmpPath = New_tmpPath & Char
         Next Counter
         tmpPath = New_tmpPath

         'Daten aus Ressourcendatei laden
         Data = LoadResData(ResID, ResTYPE)

         'Daten in Datei schreiben
         On Error GoTo Cancel:
         Open tmpPath For Binary Access Write As #1
            On Error GoTo 0
            Put #1, , Data
         Close #1

         Set LoadResImage = LoadPicture(tmpPath) 'Datei zurückgeben
         Kill tmpPath 'Datei wieder löschen
      End If
   End If

Cancel:
   'Funktion beenden
End Function