Imports System.IO Imports System.Text Imports System.Runtime.Remoting.Metadata.W3cXsd2001 Public Class ScriptTools Public Eng As Boolean Public JapTextCounter As Integer Public ColorCodes As List(Of CodeObject) Public SpecialCodes As List(Of CodeObject) Public Names As List(Of NameElement) Public ScriptCodes As List(Of CodeObject) Public Sub New() 'Dim e = New Ionic.Zlib.DeflateStream(,) ColorCodes = New List(Of CodeObject) ColorCodes.Add(New CodeObject With {.code = 11, .value = "yellow"}) ColorCodes.Add(New CodeObject With {.code = 1, .value = "white"}) ColorCodes.Add(New CodeObject With {.code = 3, .value = "gray"}) ColorCodes.Add(New CodeObject With {.code = 5, .value = "pink"}) ColorCodes.Add(New CodeObject With {.code = 7, .value = "blue"}) ColorCodes.Add(New CodeObject With {.code = 9, .value = "green"}) ColorCodes.Add(New CodeObject With {.code = 13, .value = "orange"}) ColorCodes.Add(New CodeObject With {.code = 4, .value = "gray4"}) ColorCodes.Add(New CodeObject With {.code = 18, .value = "color18"}) SpecialCodes = New List(Of CodeObject) SpecialCodes.Add(New CodeObject With {.code = &H1C0, .value = "Jkrestik"}) 'SpecialCodes.Add(New CodeObject With {.code = &H2F8, .value = "Jkvadrat"}) SpecialCodes.Add(New CodeObject With {.code = &H343, .value = "Jcircle"}) SpecialCodes.Add(New CodeObject With {.code = &H642, .value = "Jtreug"}) SpecialCodes.Add(New CodeObject With {.code = &H66B, .value = "JskobkL"}) SpecialCodes.Add(New CodeObject With {.code = &H66C, .value = "JskobkR"}) SpecialCodes.Add(New CodeObject With {.code = &H67E, .value = "Jheart"}) SpecialCodes.Add(New CodeObject With {.code = &H6F4, .value = "Jdoublekrug"}) SpecialCodes.Add(New CodeObject With {.code = &H70F, .value = "Jmelody"}) SpecialCodes.Add(New CodeObject With {.code = &H716, .value = "Jfilledkrug"}) SpecialCodes.Add(New CodeObject With {.code = &H717, .value = "Jfilledtriag"}) SpecialCodes.Add(New CodeObject With {.code = &H7EA, .value = "Jstar"}) SpecialCodes.Add(New CodeObject With {.code = &H96E, .value = "Jmale"}) SpecialCodes.Add(New CodeObject With {.code = &H96F, .value = "Jfemale"}) SpecialCodes.Add(New CodeObject With {.code = &H999, .value = "Jcircle2"}) SpecialCodes.Add(New CodeObject With {.code = &H9AC, .value = "JrotateL"}) SpecialCodes.Add(New CodeObject With {.code = &H9AD, .value = "JrotateR"}) SpecialCodes.Add(New CodeObject With {.code = &H9C3, .value = "Jsquare2"}) Names = New List(Of NameElement) Names.Add(New NameElement With {.Codes = "2C012D01", .Dehash = "Майя"}) Names.Add(New NameElement With {.Codes = "ыь", .Dehash = "Эйкичи"}) Names.Add(New NameElement With {.Codes = "2ѓ>", .Dehash = "Гинко"}) Names.Add(New NameElement With {.Codes = "БУ", .Dehash = "Лиза"}) Names.Add(New NameElement With {.Codes = "2E01", .Dehash = "Дзюн"}) Names.Add(New NameElement With {.Codes = "87048705", .Dehash = "Фудзи"}) Names.Add(New NameElement With {.Codes = "4D021500C700", .Dehash = "Юкино"}) Names.Add(New NameElement With {.Codes = "1E07C201", .Dehash = "Кацуя"}) Names.Add(New NameElement With {.Codes = "1100A000A000", .Dehash = "Улала"}) Names.Add(New NameElement With {.Codes = "46081705F6048D004707", .Dehash = "Капитан Симадзу"}) Names.Add(New NameElement With {.Codes = "0604D601F902DB00", .Dehash = "Саеко"}) Names.Add(New NameElement With {.Codes = "83013501CA003602", .Dehash = "Баофу"}) Names.Add(New NameElement With {.Codes = "0604D601F902DB00", .Dehash = "Саеко"}) Names.Add(New NameElement With {.Codes = "0604D601F902DB00", .Dehash = "Саеко"}) Names.Add(New NameElement With {.Codes = "0604D601F902DB00", .Dehash = "Саеко"}) Names.Add(New NameElement With {.Codes = "0604D601F902DB00", .Dehash = "Саеко"}) 'Script codes ScriptCodes = New List(Of CodeObject) ScriptCodes.Add(New CodeObject With {.code = &H60, .value = "__GetVar"}) ScriptCodes.Add(New CodeObject With {.code = &H1, .value = "_if1Go>>"}) ScriptCodes.Add(New CodeObject With {.code = &H2, .value = "_if0Go>>"}) ScriptCodes.Add(New CodeObject With {.code = &H4, .value = "_if!=Go>"}) 'ScriptCodes.Add(New CodeObject With {.code = &H1, .value = "_DialEnd"}) ScriptCodes.Add(New CodeObject With {.code = &H6, .value = "if>!= "-----INIT SECTION" Then MsgBox("File not valid (no init section)") : Exit Sub If t(2) <> "-----CHARACTER DATA SECTION" Then MsgBox("File not valid (no chardata section)") : Exit Sub If t(4) <> "-----POINTERS DATA SECTION" Then MsgBox("File not valid (no pointers section)") : Exit Sub If t(6) <> "-----SCRIPT DATA SECTION" Then MsgBox("File not valid (no script section)") : Exit Sub If t(8) <> "-----TEXT SECTION" Then MsgBox("File not valid (no TEXT section)") : Exit Sub 'Recompiling scripts 'Init Dim t1 = Split(t(1), ",").ToList If t1.Count <> 6 Then MsgBox("Not valid init section!") : Exit Sub For Each ii In t1 If Not IsNumeric(ii) Then MsgBox("Not numeric in INIT sect") : Exit Sub f.AddRange(BitConverter.GetBytes(Convert.ToInt32(ii)).ToList) Next 'CharData Dim t3 = Split(t(3), ",").ToList If t3.Count <> BitConverter.ToInt32(f.ToArray, 8) * 72 / 4 Then MsgBox("Not valid CHAR section!") : Exit Sub For Each ii In t3 If Not IsNumeric(ii) Then MsgBox("Not numeric in CHAR sect") : Exit Sub f.AddRange(BitConverter.GetBytes(Convert.ToInt32(ii)).ToList) Next 'PointersData Dim t5 = Split(t(5), ",").ToList If t5.Count <> (BitConverter.ToInt32(f.ToArray, 16) - BitConverter.ToInt32(f.ToArray, 12)) / 4 Then MsgBox("Not valid REFS section!") : Exit Sub For ii = 0 To t5.Count - 1 If Not IsNumeric(t5(ii)) Then MsgBox("Not numeric in REFS sect") : Exit Sub If ii Mod 2 = 0 Then 'Если это параметр 13h (с чётным номером байта) - добавляем адрес в таблицу поинтеров текста Dim bts() = BitConverter.GetBytes(Convert.ToInt32(t5(ii))) If bts(0) = &H13 And bts(1) = 0 And bts(2) = 0 Then TextPointers.Add(t5(ii + 1)) End If If bts(0) = &HF And bts(1) = 1 And bts(2) = 0 Then TextInputComparePointers.Add(t5(ii + 1)) End If End If f.AddRange(BitConverter.GetBytes(Convert.ToInt32(t5(ii))).ToList) Next 'ScriptsData Dim t7 = Split(t(7), ",").ToList If t7.Count <> (BitConverter.ToInt32(f.ToArray, 20) - BitConverter.ToInt32(f.ToArray, 16)) / 4 Then MsgBox("Not valid SCRIPT section!") : Exit Sub For Each ii In t7 If Not IsNumeric(ii) Then MsgBox("Not numeric in SCRIPT sect") : Exit Sub f.AddRange(BitConverter.GetBytes(Convert.ToInt32(ii)).ToList) Next Dim idsection As Boolean = True 'Разбор текста и запихивание его в файл Dim tx = Split(txt, "-----TEXT SECTION" & vbCrLf)(1) Dim x = 0 Dim accum = New List(Of Byte) Dim currentDialog As Integer Dim currentInputCompare As Integer Do 'Comments to end of line! If tx(x) = "\" And tx(x + 1) = "\" Then getEndOfLine(tx, x) Continue Do End If If tx(x) = "[" Then Dim skRes = getFromSkobki(tx, x) If skRes = "input" Then 'Формирование данных для сравнения введённого текста. Нужно переписать поинтер последующего текста f(TextInputComparePointers(currentInputCompare)) = BitConverter.GetBytes(accum.Count)(0) f(TextInputComparePointers(currentInputCompare) + 1) = BitConverter.GetBytes(accum.Count)(1) 'Установка поинтера для сравнения введённого в игре текста f(TextInputComparePointers(currentInputCompare) + 2) = BitConverter.GetBytes(accum.Count)(2) currentInputCompare += 1 'Здесь заносим данные для сравнения посимвольно Do While tx(x) <> "[" If tx(x) & tx(x + 1) = vbCrLf Then accum.AddRange({&H1, &H11}) : LineCount += 1 : x += 2 : Continue Do accum.AddRange({Asc(tx(x)), 0}) 'simple char x += 1 Loop skRes = getFromSkobki(tx, x) If skRes = "EOD3" Then accum.AddRange({&H3, &H11}) f(TextPointers(currentDialog)) = BitConverter.GetBytes(accum.Count)(0) f(TextPointers(currentDialog) + 1) = BitConverter.GetBytes(accum.Count)(1) 'Обновляем последний поинтер на текст f(TextPointers(currentDialog) + 2) = BitConverter.GetBytes(accum.Count)(2) : x += 2 : idsection = True : Continue Do 'Полной конец всех строк для проверки + включаем секцию ID для проверки. Else MsgBox("Invalid exit from input test! " & inputJfile) : Exit Sub End If End If If IsNumeric(skRes) And idsection Then idsection = False If currentDialog <> skRes Then MsgBox("Error in IDs!" & vbCrLf & " id: " & currentDialog & vbCrLf & "SkRes: " & skRes & vbCrLf & "F: " & inputJfile, MsgBoxStyle.Critical) Exit Sub End If DialCount += 1 x = x + 2 Continue Do 'its simple ID End If If skRes = "EOD" Then accum.AddRange({&H6, &H11, &H2, &H11, &H3, &H11}) : currentDialog += 1 If currentDialog > TextPointers.Count - 1 Then Exit Do 'Last DIAL in file, but not EOF f(TextPointers(currentDialog)) = BitConverter.GetBytes(accum.Count)(0) f(TextPointers(currentDialog) + 1) = BitConverter.GetBytes(accum.Count)(1) 'Its NEW LINE f(TextPointers(currentDialog) + 2) = BitConverter.GetBytes(accum.Count)(2) If tx(x) & tx(x + 1) = vbCrLf Then x += 2 : idsection = True : Continue Do End If If skRes = "EOD723" Then accum.AddRange({&H7, &H11, &H2, &H11, &H3, &H11}) : currentDialog += 1 If currentDialog > TextPointers.Count - 1 Then Exit Do 'Last DIAL in file, but not EOF f(TextPointers(currentDialog)) = BitConverter.GetBytes(accum.Count)(0) f(TextPointers(currentDialog) + 1) = BitConverter.GetBytes(accum.Count)(1) 'Its NEW LINE f(TextPointers(currentDialog) + 2) = BitConverter.GetBytes(accum.Count)(2) : x += 2 : idsection = True : Continue Do End If If skRes = "EOD3" Then accum.AddRange({&H3, &H11}) : currentDialog += 1 f(TextPointers(currentDialog)) = BitConverter.GetBytes(accum.Count)(0) f(TextPointers(currentDialog) + 1) = BitConverter.GetBytes(accum.Count)(1) 'Its NEW LINE f(TextPointers(currentDialog) + 2) = BitConverter.GetBytes(accum.Count)(2) : x += 2 : idsection = True : Continue Do End If If skRes = "EOw" Then accum.AddRange({&H6, &H11, &H2, &H11}) 'Its END OF WINDOW Continue Do End If If skRes = "EndSelection" Then accum.AddRange({&H9, &H11, &H2, &H11, &H3, &H11}) : currentDialog += 1 If currentDialog > TextPointers.Count - 1 Then currentDialog -= 1 : Exit Do 'Last DIAL in file f(TextPointers(currentDialog)) = BitConverter.GetBytes(accum.Count)(0) f(TextPointers(currentDialog) + 1) = BitConverter.GetBytes(accum.Count)(1) 'Its NEW LINE f(TextPointers(currentDialog) + 2) = BitConverter.GetBytes(accum.Count)(2) If tx(x) & tx(x + 1) = vbCrLf Then x += 2 : idsection = True : Continue Do End If If skRes = "EOF" Then accum.AddRange({&H6, &H11, &H2, &H11, &H3, &H11}) : Exit Do 'END OF FILE! If skRes = "EOF3" Then accum.AddRange({&H3, &H11}) : Exit Do 'END OF FILE! If skRes = "EOF723" Then accum.AddRange({&H7, &H11, &H2, &H11, &H3, &H11}) : Exit Do 'END OF FILE! If skRes = "surname" Then accum.AddRange({&H20, &H11}) : Continue Do '2011 - surname!!! If skRes = "name" Then accum.AddRange({&H21, &H11}) : Continue Do '2211 - Nick If skRes = "pause" Then accum.AddRange({&H5, &H12}) If tx(x) <> vbCr And tx(x) <> "[" Then 'NEED TO CONVERT BACK! accum.AddRange({Math.Abs(Asc(tx(x)) - 32), 0}) : x += 1 : Continue Do 'Pause + 2 byte length (30 ~ 1 sec) Else If tx(x) = "[" Then accum.Add(getFromSkobki(tx, x)) accum.Add(0) : Continue Do Else accum.AddRange({15, 0}) : Continue Do End If End If Continue Do End If If skRes = "SelectionMenu" Then accum.AddRange({&H8, &H12}) : Continue Do If skRes = "EOw0000" Then accum.AddRange({0, 0}) : Continue Do If skRes.Length = 4 Then 'Try to parse other hex codes accum.AddRange(SoapHexBinary.Parse(skRes).Value.ToList) 'x += 2 Continue Do End If If IsNumeric(skRes) Then accum.AddRange(BitConverter.GetBytes(Convert.ToInt16(skRes)).ToList) Continue Do 'Simply Code Else If skRes.Length > 4 Then Dim d As String = skRes If d.Substring(0, 4) = "col=" Then Dim a As Byte = ColorCodes.Find(Function(q) q.value = d.Substring(4)).code 'color command accum.AddRange({&H2E, &H12}) accum.AddRange({a, &H0}) Continue Do End If Dim spec As CodeObject = SpecialCodes.Find(Function(q) q.value = skRes) 'Special code convert IF If Not IsNothing(spec) Then accum.AddRange(BitConverter.GetBytes(Convert.ToInt16(spec.code)).ToList) Continue Do End If End If End If End If If tx(x) = vbTab Then accum.AddRange({&H31, &H11}) : x += 1 : Continue Do 'Tab and enter If tx(x) & tx(x + 1) = vbCrLf Then accum.AddRange({&H1, &H11}) : LineCount += 1 : x += 2 : Continue Do If tx(x) = vbLf Then accum.AddRange({&H1, &H11}) : LineCount += 1 : x += 1 : Continue Do If Form1.NewTextMODE.Checked Then 'Новый режим вывода текста!!! Dim SimpleTextAccum = New List(Of Byte) Dim readCounter As Byte = 1 Do If Asc(tx(x)) < 32 Or Asc(tx(x)) = 91 Then x -= 1 : Exit Do SimpleTextAccum.Add(Asc(tx(x))) x += 1 Loop 'if 1 or 2 bytes If SimpleTextAccum.Count = 1 Then accum.AddRange({SimpleTextAccum(0), 0}) : GoTo Exitif If SimpleTextAccum.Count = 2 Then accum.AddRange({SimpleTextAccum(0), 0, SimpleTextAccum(1), 0}) : GoTo Exitif If SimpleTextAccum.Count = 0 Then GoTo Exitif accum.Add(SimpleTextAccum.Count) If SimpleTextAccum.Count > 47 Then Debug.WriteLine("W: text > 47(" & SimpleTextAccum.Count & ") Dial: " & currentDialog & " File: " & inputJfile & " ---" & String.Join("", SimpleTextAccum.ToArray)) accum.Add(&H20) 'command & length accum.AddRange(SimpleTextAccum) 'attach textline If SimpleTextAccum.Count And 1 Then accum.Add(0) ' if and 1 - add empty byte Else accum.AddRange({Asc(tx(x)), 0}) 'Finally - simple char End If Exitif: x += 1 Loop While x < tx.Length - 1 If currentDialog <> TextPointers.Count - 1 Then MsgBox("Pointers dont match text!" & vbCrLf & inputJfile & vbCrLf & "EODs: " & currentDialog + 1 & " <> pointers: " & TextPointers.Count) End If f.AddRange(accum) Dim fArr = f.ToArray 'Сохраняем выходной файл My.Computer.FileSystem.WriteAllBytes(inputJfile & ".TRNSL", f.ToArray, False) 'MsgBox("Imported. Saved to " & inputJfile & ".TRNSL") End Sub 'Scobki encoding Public Function getFromSkobki(ByRef tx As String, ByRef x As Integer) x = x + 1 Dim accum = "" Do While tx(x) <> "]" accum &= tx(x) x += 1 Loop x += 1 Return accum End Function Public Sub getEndOfLine(ByRef tx As String, ByRef x As Integer) Do x += 1 Loop While tx(x) <> vbCr And tx(x + 1) <> vbLf x += 2 End Sub Public Sub ExportTextFile(ByVal inputJfile As String, ByVal inputEfile As String) If Not File.Exists(inputJfile) Then MsgBox("Japanese resource file not found!!", MsgBoxStyle.Critical) : Exit Sub Dim JRes = New ScriptFile Dim ERes = New ScriptFile Dim JapBytes = My.Computer.FileSystem.ReadAllBytes(inputJfile) JRes.filename = Path.GetFileNameWithoutExtension(inputJfile) If File.Exists(inputEfile) Then Eng = True ERes.filename = Path.GetFileNameWithoutExtension(inputEfile) ParseResource(My.Computer.FileSystem.ReadAllBytes(inputEfile), ERes) ParseText(ERes, True) End If ParseResource(JapBytes, JRes) ParseText(JRes, False) Dim combText = CombineParsedText(ERes, JRes) If IsNothing(combText) Then Exit Sub Dim combResData = compileData(JRes) If JRes.Text.Count = 0 Then Exit Sub My.Computer.FileSystem.WriteAllText(inputJfile & ".txt", combResData & combText, False) End Sub Public Function ConvertPSPTextFile(ByVal JapBytes As Byte()) Dim JRes = New ScriptFile Dim ERes = New ScriptFile ParseResource(JapBytes, JRes) ParseText(JRes, False) Dim combText = CombineParsedText(ERes, JRes) If IsNothing(combText) Then Return "" Dim combResData = compileData(JRes) If JRes.Text.Count = 0 Then Return "" 'My.Computer.FileSystem.WriteAllText(inputJfile & ".txt", combResData & combText, False, Encoding.GetEncoding(1251)) Return combResData & combText End Function Public Function compileData(ByRef JRes As ScriptFile) Dim txt As String = "-----INIT SECTION" & vbCrLf txt &= $"{JRes.hz1},{JRes.hz2},{JRes.CharsCount},{JRes.RefsTablePointer},{JRes.ScriptTablePointer},{JRes.StartTextPointer}" & vbCrLf txt &= "-----CHARACTER DATA SECTION" & vbCrLf Dim cdata = JRes.CharsArr.ToArray For a = 0 To JRes.CharsCount * 72 - 1 Step 4 txt &= BitConverter.ToInt32(cdata, a) & "," Next txt = txt.Substring(0, txt.Length - 1) 'Отрезаем последнюю запятую txt &= vbCrLf & "-----POINTERS DATA SECTION" & vbCrLf For a = 0 To JRes.refstable.Count - 1 txt &= JRes.refstable(a) & "," Next txt = txt.Substring(0, txt.Length - 1) 'Отрезаем последнюю запятую txt &= vbCrLf & "-----SCRIPT DATA SECTION" & vbCrLf For a = 0 To JRes.ScriptsTable.Count - 1 txt &= JRes.ScriptsTable(a) & "," Next txt = txt.Substring(0, txt.Length - 1) 'Отрезаем последнюю запятую Return txt & vbCrLf End Function Public Function CombineParsedText(ByRef ERes As ScriptFile, ByRef JRes As ScriptFile) Dim txt As String = "-----TEXT SECTION" & vbCrLf If Not IsNothing(ERes.ParsedText) Then 'if englist is loaded If ERes.ParsedText.Count <> JRes.ParsedText.Count Then MsgBox(String.Format("Error parsing text! Eng and jap dialogs doesnt have same count!!! {0} vs {1}" & vbCrLf & "{2}", ERes.ParsedText.Count, JRes.ParsedText.Count, JRes.filename)) Return Nothing End If End If For p = 0 To JRes.ParsedText.Count - 1 If Not IsNothing(ERes.ParsedText) Then 'load english version in comment Dim etxt = Split(ERes.ParsedText(p), vbCrLf) txt &= "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\" & vbCrLf For Each t In etxt If Form1.UnKudosScript.Checked Then t = StringsOffsetEditorvb.Unkudos(t) txt &= "\\ " & t & vbCrLf Next End If txt &= "[" & p & "]" & vbCrLf txt &= JRes.ParsedText(p) & vbCrLf Next Return txt End Function 'specialCodesParse 'c001 f802 4303 4206 6b06 6c06 7e06 f406 0f07 1607 1707 ea07 6e09 6f09 9909 ac09 ad09 c309 Public Sub ParseText(ByRef Res As ScriptFile, ByVal isEnglish As Boolean) Res.ParsedText = New List(Of String) Dim a = 0 'counter Dim txt As String = "" If Res.Text.Count = 0 Then Exit Sub Dim m As List(Of Byte) = Res.Text If Not isEnglish Then GoTo isJapanese ' BitConverter.IsLittleEndian = False Do Dim c = get2(m, a) 'Dim c = Res.Text(a) If c = &H122E Then Dim c2 = get2(m, a + 2) : txt &= "[" & ColorCodes.Find(Function(q) q.code = c2).value & "]" : a += 4 : Continue Do ' код цвета If c = &H1101 Then txt &= vbCrLf a += 2 Continue Do ' Перенос строки End If If c = &H1208 Then txt &= "[Sel=" & get2(m, a + 2) & "]" : a += 4 : Continue Do If c = &H1121 Then txt &= "[name]" : a += 2 : Continue Do 'Имя игрока из IS If c = &H1120 Then txt &= "[surname]" : a += 2 : Continue Do 'Фамилия игрока из IS 'If c = &H1122 Then txt &= "[surname]" : a += 2 : Continue Do 'Фамилия игрока из IS 'If c = 5 Then ' If Res.Text(a + 1) = &H1E Then ' txt &= "[p]" : a += 2 : Continue Do 'Пауза ' End If 'End If 'ЧИТАЕМ ТЕКСТ If c = &H1136 Then a += 2 Dim curChr As Byte Do curChr = m(a) If curChr = 0 Then a += 1 : Exit Do txt &= Chr(curChr) a += 1 Loop If a And 1 Then a += 1 Continue Do End If 'SIMPLE CHAR WITHOUT COMMAND Dim aaa = SpecialCodes.Find(Function(q) q.code = c) If IsNothing(aaa) Then 'Dim curCode0 = BitConverter.GetBytes(c)(0) 'Обрабатываем первый байт иероглифа и заменяем печатным текстом 'If curCode0 < 32 Then curCode0 += 32 txt &= m(a).ToString("X2") & m(a + 1).ToString("X2") Else txt &= "[" & aaa.value & "]" 'Если есть специальный код End If a += 2 Dim PointIndex As Integer = Res.textPointers.FindIndex(Function(x) x = a) 'Если дошли до след строки в поинтерах или это байт вне файла, то добавляем последнюю строку и выходим If PointIndex > 0 Or a = Res.Text.Count Then Res.ParsedText.Add(txt) : txt = "" End If Loop While a < Res.Text.Count Exit Sub isJapanese: Do Dim c = get2(m, a) If c = &H122E Then 'Парсим код цвета текста txt &= "[col=" & ColorCodes.Find(Function(q) q.code = get2(m, a + 2)).value & "]" a += 4 GoTo endlineTest End If If c = &H1101 Then txt &= vbCrLf : a += 2 : GoTo endlineTest ' Перенос строки If c = &H1120 Then txt &= " " : a += 2 : GoTo endlineTest ' PSP Space!!! If c = &H1131 Then txt &= vbTab : a += 2 : GoTo endlineTest ' Табуляция (+12 пикс) If c = &H1205 Then txt &= "[pause][" & get2(m, a + 2) & "]" : a += 4 : GoTo endlineTest ' Пауза при воспроизведении диалога If c = &H1208 Then txt &= "[SelectionMenu][" & get2(m, a + 2) & "]" : a += 4 : GoTo endlineTest ' Пауза 1с при воспроизведении диалога If c = &H1121 Then txt &= "[name]" : a += 2 : GoTo endlineTest 'Имя игрока If c = &H1122 Then txt &= "[surname]" : a += 2 : GoTo endlineTest 'Фамилия игрока If c = &H1109 Then If get2(m, a + 2) = &H1102 Then If get2(m, a + 4) = &H1103 Then 'Выбор варианта ответа! txt &= "[EndSelection]" 'Res.ParsedText.Add(txt) : txt = "" a += 6 : GoTo endlineTest End If End If End If If c = &H1106 Then If get2(m, a + 2) = &H1102 Then If get2(m, a + 4) = &H1103 Then 'Закрыть окна диалога! If a + 6 > m.Count - 1 Then txt &= "[EOF]" Else txt &= "[EOD]" 'End of Dialog or End of File 'Res.ParsedText.Add(txt) : txt = "" a += 6 : GoTo endlineTest Else If a + 6 > m.Count - 1 Then txt &= "[EOF]" Else txt &= "[EOw]" 'End of WINDOW without close! 'Res.ParsedText.Add(txt) : txt = "" : a += 4 : GoTo endlineTest End If End If End If If c = &H1103 Then If a + 4 > m.Count - 1 Then txt &= "[EOF3]" Else txt &= "[EOD3]" 'End of Dialog or End of File a += 2 : GoTo endlineTest End If If c And &H1000 Then 'COMMAND PARSE Dim comLen = c >> 8 'command length check Dim comCode = c And &HFF Dim c1 = m(a) : Dim c2 = m(a + 1) Dim gg = c2 And 15 'Dim gg = comLen For byteskip = 1 To gg txt &= "[" & c1.ToString("X2") & c2.ToString("X2") & "]" a += 2 c1 = m(a) : c2 = m(a + 1) Next ElseIf c And &H2000 Then 'Если строка в моём однобайтном формате Dim charNum = c And &HFF a += 2 For x = 1 To charNum txt &= Chr(m(a)) a += 1 Next If charNum And 1 Then a += 1 'if AND1 - +1 GoTo endlineTest Else 'SIMPLE CHAR WITHOUT COMMAND Dim aaa = SpecialCodes.Find(Function(q) q.code = c) If IsNothing(aaa) Then 'Dim curCode0 = BitConverter.GetBytes(c)(0) 'Обрабатываем первый байт иероглифа и заменяем печатным текстом 'If curCode0 < 32 Then curCode0 += 32 'txt &= m(a).ToString("X2") & m(a + 1).ToString("X2") txt &= Form1.chars(m(a) + m(a + 1) * 256) 'txt &= Chr(m(a)) & Chr(m(a + 1)) Else txt &= "[" & aaa.value & "]" 'Если есть специальный код End If 'отправляем в файл a += 2 'Двигаем на 2 байта вперёд End If endlineTest: Dim PointIndex As Integer = Res.textPointers.FindIndex(Function(x) x = a) 'Если дошли до след строки в поинтерах или это байт вне файла, то добавляем последнюю строку и выходим If PointIndex > 0 Or a = Res.Text.Count Then Res.ParsedText.Add(txt) : txt = "" End If Loop While a < m.Count - 1 For l = 0 To Res.ParsedText.Count - 1 For Each nm In Names Res.ParsedText(l) = Res.ParsedText(l).Replace(nm.Codes, nm.Dehash) Next Next End Sub Public Sub ParseResource(ByRef bytes As Byte(), ByRef Res As ScriptFile) 'Making big script object from file JapTextCounter = 0 Res.hz1 = BitConverter.ToInt32(bytes, 0) : Res.hz2 = BitConverter.ToInt32(bytes, 4) 'If Res.hz1 <> Res.hz2 Then 'Fixing Japanese Battle Text Script, Adding Header Int32 ' Dim bL = New List(Of Byte) ' bL.AddRange(BitConverter.GetBytes(Res.hz1)) ' bL.AddRange(bytes) ' Res.hz2 = Res.hz1 ' bytes = bL.ToArray 'End If Res.CharsCount = BitConverter.ToInt32(bytes, 8) Res.RefsTablePointer = BitConverter.ToInt32(bytes, 12) Res.ScriptTablePointer = BitConverter.ToInt32(bytes, 16) Res.StartTextPointer = BitConverter.ToInt32(bytes, 20) Res.textPointers = New List(Of Integer) Res.CharsArr = New List(Of Byte) Res.refstable = New List(Of Int32) Res.ScriptsTable = New List(Of Int32) Res.Text = New List(Of Byte) Dim TextPointersToScript = New List(Of Integer) 'Copy chars data For x = Res.hz2 To Res.CharsCount * 72 + Res.hz2 - 1 'reading char data after header Res.CharsArr.Add(bytes(x)) Next Dim refstableIndexes = Res.ScriptTablePointer - Res.RefsTablePointer / 8 For x = Res.RefsTablePointer To Res.ScriptTablePointer - 1 Step 8 Dim yy As UInt32 = BitConverter.ToInt32(bytes, x) Dim zz As UInt32 = BitConverter.ToInt32(bytes, x + 4) If bytes(x) = &H13 And bytes(x + 1) = 0 And bytes(x + 2) = 0 Then TextPointersToScript.Add(zz) : JapTextCounter += 1 'Reading text commands from main offset table Res.refstable.Add(yy) ' Res.refstable.Add(zz) Next For Each x In TextPointersToScript Res.textPointers.Add(BitConverter.ToInt32(bytes, x)) 'Reading text offsets from scripts table Next For x = Res.ScriptTablePointer To Res.StartTextPointer - 1 Step 4 Dim yy As Int32 = BitConverter.ToInt32(bytes, x) 'Storing script Bytes Res.ScriptsTable.Add(yy) Next For x = Res.StartTextPointer To UBound(bytes) Res.Text.Add(bytes(x)) Next End Sub Public Function get2(ByRef f As List(Of Byte), ByVal Index As Integer) If IsNothing(f) Then Return 0 Return f(Index) + f(Index + 1) * 256 End Function Public Function Read32bitNum(ByRef f As Byte(), ByVal bytenum As Integer) Dim i As Long i = f(bytenum) + f(bytenum + 1) * 256 + f(bytenum + 2) * 65536 + f(bytenum + 3) * 16777216 'If f(bytenum + 3) = 255 And f(bytenum + 2) = 255 And f(bytenum + 1) = 255 And f(bytenum) = 255 Then Return -1 Return i End Function Public Function MakeExportFile(ByRef JFile As Byte(), ByRef EFile As Byte(), ByRef cnt As Integer) Dim retString = "" Dim japPointers = New List(Of Integer) Dim engPointers = New List(Of Integer) Dim JPointersPointer = BitConverter.ToUInt16(JFile, 4) Dim EPointersPointer = BitConverter.ToUInt16(EFile, 4) Dim JTextPointer = BitConverter.ToUInt16(JFile, 6) Dim ETextPointer = BitConverter.ToUInt16(EFile, 6) Dim fileHeader = New List(Of Byte) Dim engText = New List(Of String) Dim japText = New List(Of String) 'Dim StrCount = (JTextPointer - JPointersPointer) / 2 'reading pointers Dim pointersReader As Integer = JPointersPointer For a = JPointersPointer To JTextPointer - 1 Step 2 : japPointers.Add(BitConverter.ToUInt16(JFile, a)) : Next a For a = EPointersPointer To ETextPointer - 1 Step 2 : engPointers.Add(BitConverter.ToUInt16(EFile, a)) : Next a 'FormFileHeader For a = 0 To ETextPointer - 1 : fileHeader.Add(JFile(a)) : Next 'reading eng String For a = 0 To engPointers.Count - 1 Dim accum = "\\" 'Pointer2PointerReading System Dim reader As Integer = ETextPointer + engPointers(a) Do 'If reader >= lastbyte Then Exit Do Dim s = EFile(reader) 'If reader + 3 < EFile.Count - 1 Then 'If s = 6 And EFile(reader + 1) = 2 And EFile(reader + 2) = 3 Then Exit Do If s = 8 Then accum &= "[sel=" & EFile(reader + 1) & "]" : reader += 2 : Continue Do If s = 3 Then Exit Do 'End If If s = 29 Then accum &= "[c=" & EFile(reader + 1) & "]" : reader += 2 : Continue Do If s = 14 Then accum &= "[0e=" & EFile(reader + 1) & "]" : reader += 2 : Continue Do If s = 30 Then accum &= "[1e=" & EFile(reader + 1) & "]" : reader += 2 : Continue Do If s = 1 Then accum &= vbCrLf & "\\" : reader += 1 : Continue Do If s < 32 Then accum &= "[" & s & "]" Else accum &= Chr(s) End If reader += 1 Loop While reader < UBound(EFile) engText.Add(accum) Next 'reading jap String For a = 0 To japPointers.Count - 1 Dim accum = "" 'Pointer2PointerReading System Dim lastbyte As Integer = 0 'If a = japPointers.Count - 1 Then ' lastbyte = JFile.ToList.Count - 1 'Else ' lastbyte = japPointers(a + 1) + JTextPointer 'End If Dim reader As Integer = JTextPointer + japPointers(a) Do 'Dim s = JFile(reader) Dim chrr = BitConverter.ToUInt16(JFile, reader) 'Reading 2 Bytes! If chrr = &H96E Then accum &= "[man]" : reader += 2 : Continue Do If chrr = &H96F Then accum &= "[woman]" : reader += 2 : Continue Do If chrr And &H1000 Then 'If reader + 7 <= UBound(JFile) - 1 Then ' If chrr = &H1101 And BitConverter.ToUInt16(JFile, reader + 2) = &H1106 And ' BitConverter.ToUInt16(JFile, reader + 4) = &H1101 And ' BitConverter.ToUInt16(JFile, reader + 6) = &H1103 Then accum &= "[END]" : Exit Do 'End If 'If reader + 5 <= lastbyte Then ' If chrr = &H1106 And BitConverter.ToUInt16(JFile, reader + 2) = &H1102 And ' BitConverter.ToUInt16(JFile, reader + 4) = &H1103 Then accum &= "[END623]" : Exit Do 'End If If chrr = &H1103 Then accum &= "[0311]" : reader += 2 : Exit Do If chrr = &H1205 Then accum &= "[p=" & BitConverter.ToUInt16(JFile, reader + 2) & "]" : reader += 4 : Continue Do If chrr = &H120E Then accum &= "[0e=" & BitConverter.ToUInt16(JFile, reader + 2) & "]" : reader += 4 : Continue Do If chrr = &H121E Then accum &= "[1e=" & BitConverter.ToUInt16(JFile, reader + 2) & "]" : reader += 4 : Continue Do If chrr = &H121D Then accum &= "[c=" & BitConverter.ToUInt16(JFile, reader + 2) & "]" : reader += 4 : Continue Do If chrr = &H1101 Then accum &= vbCrLf : reader += 2 : Continue Do If chrr = &H1120 Then accum &= vbTab : reader += 2 : Continue Do If chrr = &H1121 Then accum &= vbTab : reader += 2 : Continue Do Dim c1 = JFile(reader) : Dim c2 = JFile(reader + 1) Dim gg = c2 And 15 For byteskip = 1 To gg accum &= "[" & c1.ToString("X2") & c2.ToString("X2") & "]" reader += 2 c1 = JFile(reader) : c2 = JFile(reader + 1) Next Continue Do End If Dim aaa = SpecialCodes.Find(Function(q) q.code = chrr) If IsNothing(aaa) Then chrr = chrr And 255 : If chrr < 32 Then chrr += 32 accum &= Chr(chrr) Else accum &= "[" & aaa.value & "]" 'Если есть специальный код End If reader += 2 Loop While reader < UBound(JFile) For Each nm In Names accum = accum.Replace(nm.Codes, nm.Dehash) Next japText.Add(accum) Next For Each b In fileHeader retString &= b & "," Next retString = retString.Substring(0, retString.Length - 1) & vbCrLf For a = 0 To japPointers.Count - 1 retString &= "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\" & vbCrLf retString &= engText(a) & vbCrLf retString &= "[" & a & "]" & vbCrLf retString &= japText(a) & vbCrLf cnt += 1 Next Return retString End Function Public Sub importContactFile(ByVal inputJfile As String, ByRef DialCount As Integer, ByRef LineCount As Integer) Dim f = New List(Of Byte) Dim TextPointers = New List(Of Integer) Dim RepeatPointers = New List(Of Integer) Dim txt = My.Computer.FileSystem.ReadAllText(inputJfile, Encoding.GetEncoding(1251)) Dim t As List(Of String) = Split(txt, vbCrLf).ToList 'Recompiling scripts 'Init Dim t1 = Split(t(0), ",").ToList For Each ii In t1 If Not IsNumeric(ii) Then MsgBox("Not numeric in INIT sect!!") : Exit Sub f.Add(Convert.ToByte(ii)) Next Dim JPointersPointer = f(4) + f(5) * 256 Dim JTextPointer = f(6) + f(7) * 256 Dim StrCount = (JTextPointer - JPointersPointer) / 2 Dim tx As String = txt.Replace(t(0) & vbCrLf, "") 'Replace first line Dim idsection As Boolean = True Dim x = 0 Dim accum = New List(Of Byte) Dim linesAccum = New List(Of String) Dim TempLinesAccum = New List(Of Byte) Dim currentDialog As Integer Do 'Comments to end of line! If tx(x) = "\" And tx(x + 1) = "\" Then getEndOfLine(tx, x) idsection = True Continue Do End If If tx(x) = "#" Then TextPointers.Add(accum.Count) : x += 3 : currentDialog += 1 : Continue Do 'SimpleClose 'SPEC_CODES If tx(x) = "[" Then Dim skRes = getFromSkobki(tx, x) If IsNumeric(skRes) And idsection Then If skRes <> TextPointers.Count Then MsgBox("Error in pointers! ID " & skRes) : Exit Sub idsection = False DialCount += 1 x = x + 2 Continue Do 'its simple ID End If If skRes = "END623" Or skRes = "END" Or skRes = "311" Then Dim curCount = accum.Count currentDialog += 1 x += 2 Select Case skRes Case "END623" TempLinesAccum.AddRange({&H6, &H11, &H2, &H11, &H3, &H11}) Case "END" TempLinesAccum.AddRange({&H6, &H11, &H3, &H11}) Case "311" TempLinesAccum.AddRange({&H3, &H11}) End Select 'if thislineis Exist or not Dim CRCstr = makeCRCString(TempLinesAccum) Dim srcLine = linesAccum.FindIndex(Function(yy) yy = CRCstr) If srcLine = -1 Then linesAccum.Add(CRCstr) : accum.AddRange(TempLinesAccum) : TempLinesAccum.Clear() : TextPointers.Add(curCount) : RepeatPointers.Add(curCount) : Continue Do Else TextPointers.Add(RepeatPointers(srcLine)) : TempLinesAccum.Clear() : Continue Do End If End If Dim spl = Split(skRes, "=") If UBound(spl) = 1 Then 'Code = parsing Select Case spl(0) Case "0e" TempLinesAccum.AddRange({&HE, &H12, spl(1), 0}) Case "1e" TempLinesAccum.AddRange({&H1E, &H12, spl(1), 0}) Case "p" TempLinesAccum.AddRange({&H5, &H12, spl(1), 0}) Case "c" TempLinesAccum.AddRange({&H1D, &H12, spl(1), 0}) Case "col" Dim ind = ColorCodes.Find(Function(q) q.value = spl(1)).code 'old style color TempLinesAccum.AddRange({&H1D, &H12, ind, 0}) End Select 'x += 2 Continue Do Else '2 hex codes parsing 'test specCodes Dim spec As CodeObject = SpecialCodes.Find(Function(q) q.value = skRes) 'Special code convert IF If Not IsNothing(spec) Then TempLinesAccum.AddRange(BitConverter.GetBytes(Convert.ToInt16(spec.code)).ToList) Continue Do End If If skRes.Length = 4 Then 'Try to parse other hex codes TempLinesAccum.AddRange(SoapHexBinary.Parse(skRes).Value.ToList) 'x += 2 Continue Do End If End If End If If tx(x) = vbTab Then TempLinesAccum.AddRange({&H1, &H11}) : x += 1 : Continue Do 'Tab and enter If tx(x) & tx(x + 1) = vbCrLf Then TempLinesAccum.AddRange({&H1, &H11}) : LineCount += 1 : x += 2 : Continue Do If tx(x) = vbLf Then TempLinesAccum.AddRange({&H1, &H11}) : LineCount += 1 : x += 1 : Continue Do Dim isSimple = False If tx(x) = "^" Then x += 1 : isSimple = True 'SimpleLine Check 'SIMPLE TEXT ADDING Dim SimpleTextAccum = New List(Of Byte) Dim readCounter As Byte = 1 Do If Asc(tx(x)) < 32 Or Asc(tx(x)) = 91 Then x -= 1 : Exit Do SimpleTextAccum.Add(Asc(tx(x))) x += 1 Loop 'if 1 or 2 bytes If SimpleTextAccum.Count = 1 Then TempLinesAccum.AddRange({SimpleTextAccum(0), 0}) : x += 1 : Continue Do TempLinesAccum.Add(SimpleTextAccum.Count) TempLinesAccum.Add(&H20) 'command & length TempLinesAccum.AddRange(SimpleTextAccum) 'attach textline If SimpleTextAccum.Count And 1 Then TempLinesAccum.Add(0) ' if and 1 - add empty byte If isSimple Then Dim CRCstr = makeCRCString(TempLinesAccum) linesAccum.Add(CRCstr) : TextPointers.Add(accum.Count) : accum.AddRange(TempLinesAccum) : TempLinesAccum.Clear() : RepeatPointers.Add(accum.Count) ' TextPointers.Add(accum.Count) x += 3 Continue Do 'This is Simple Line End If x += 1 Loop While x < tx.Length - 1 'TextPointers.RemoveAt(TextPointers.Count - 1) 'Remove Last Pointer 'updateing text pointers If TextPointers.Count <> StrCount Then MsgBox(inputJfile & vbCrLf & "Pointers dsn't Match :( " & vbCrLf & StrCount & " <> " & TextPointers.Count) End If For a = 0 To StrCount - 1 f(JPointersPointer + a * 2) = BitConverter.GetBytes(TextPointers(a))(0) f(JPointersPointer + a * 2 + 1) = BitConverter.GetBytes(TextPointers(a))(1) Next f.AddRange(accum) 'Сохраняем выходной файл My.Computer.FileSystem.WriteAllBytes(inputJfile & ".ContTRNSL", f.ToArray, False) End Sub Public Function MakeSummonExport(ByRef JFile As Byte(), ByRef EFile As Byte(), ByRef cnt As Integer) Dim retString = "" Dim engText = New List(Of String) Dim japText = New List(Of String) 'Dim StrCount = (JTextPointer - JPointersPointer) / 2 'reading pointers Dim accum = "\\" 'Pointer2PointerReading System Dim reader As Integer = 0 Do 'If reader >= lastbyte Then Exit Do Dim s = EFile(reader) 'If reader + 3 < EFile.Count - 1 Then 'If s = 6 And EFile(reader + 1) = 2 And EFile(reader + 2) = 3 Then Exit Do If s = 8 Then accum &= "[sel=" & EFile(reader + 1) & "]" : reader += 2 : Continue Do If s = 3 Then Exit Do 'End If If s = 29 Then accum &= "[c=" & EFile(reader + 1) & "]" : reader += 2 : Continue Do If s = 14 Then accum &= "[0e=" & EFile(reader + 1) & "]" : reader += 2 : Continue Do If s = 30 Then accum &= "[1e=" & EFile(reader + 1) & "]" : reader += 2 : Continue Do If s = 1 Then accum &= vbCrLf & "\\" : reader += 1 : Continue Do If s < 32 Then accum &= "[" & s & "]" Else accum &= Chr(s) End If reader += 1 Loop While reader < UBound(EFile) engText.Add(accum) 'reading jap String accum = "" 'Pointer2PointerReading System Dim lastbyte As Integer = 0 'If a = japPointers.Count - 1 Then ' lastbyte = JFile.ToList.Count - 1 'Else ' lastbyte = japPointers(a + 1) + JTextPointer 'End If reader = 0 Do 'Dim s = JFile(reader) Dim chrr = BitConverter.ToUInt16(JFile, reader) 'Reading 2 Bytes! If chrr = &H96E Then accum &= "[man]" : reader += 2 : Continue Do If chrr = &H96F Then accum &= "[woman]" : reader += 2 : Continue Do If chrr And &H1000 Then If chrr = &H1103 Then accum &= "[311]" : reader += 2 : Exit Do If chrr = &H1205 Then accum &= "[p=" & BitConverter.ToUInt16(JFile, reader + 2) & "]" : reader += 4 : Continue Do If chrr = &H120E Then accum &= "[0e=" & BitConverter.ToUInt16(JFile, reader + 2) & "]" : reader += 4 : Continue Do If chrr = &H121E Then accum &= "[1e=" & BitConverter.ToUInt16(JFile, reader + 2) & "]" : reader += 4 : Continue Do If chrr = &H121D Then accum &= "[c=" & BitConverter.ToUInt16(JFile, reader + 2) & "]" : reader += 4 : Continue Do If chrr = &H1101 Then accum &= vbCrLf : reader += 2 : Continue Do If chrr = &H1120 Then accum &= vbTab : reader += 2 : Continue Do If chrr = &H1121 Then accum &= vbTab : reader += 2 : Continue Do Dim c1 = JFile(reader) : Dim c2 = JFile(reader + 1) Dim gg = c2 And 15 For byteskip = 1 To gg accum &= "[" & c1.ToString("X2") & c2.ToString("X2") & "]" reader += 2 c1 = JFile(reader) : c2 = JFile(reader + 1) Next Continue Do End If Dim aaa = SpecialCodes.Find(Function(q) q.code = chrr) If IsNothing(aaa) Then chrr = chrr And 255 : If chrr < 32 Then chrr += 32 accum &= Chr(chrr) Else accum &= "[" & aaa.value & "]" 'Если есть специальный код End If reader += 2 Loop While reader < UBound(JFile) For Each nm In Names accum = accum.Replace(nm.Codes, nm.Dehash) Next japText.Add(accum) ' retString = retString.Substring(0, retString.Length - 1) & vbCrLf retString &= "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\" & vbCrLf retString &= engText(0) & vbCrLf retString &= "[0]" & vbCrLf retString &= japText(0) & vbCrLf cnt += 1 Replace(retString, "[0611][0211][311]", "[END623]") Return retString End Function Public Sub convertSummonScript(ByVal inputJfile As String, ByRef DialCount As Integer) Dim TextPointers = New List(Of Integer) Dim RepeatPointers = New List(Of Integer) Dim txt = My.Computer.FileSystem.ReadAllText(inputJfile, Encoding.GetEncoding(1251)) Dim t As List(Of String) = Split(txt, vbCrLf).ToList 'Recompiling scripts 'Init Dim tx As String = txt 'Replace first line Dim idsection As Boolean = True Dim x = 0 Dim accum = New List(Of Byte) Dim linesAccum = New List(Of String) Dim currentDialog As Integer Do 'Comments to end of line! If tx(x) = "\" And tx(x + 1) = "\" Then getEndOfLine(tx, x) idsection = True Continue Do End If If tx(x) = "#" Then TextPointers.Add(accum.Count) : x += 3 : currentDialog += 1 : Continue Do 'SimpleClose 'SPEC_CODES If tx(x) = "[" Then Dim skRes = getFromSkobki(tx, x) If IsNumeric(skRes) And idsection Then idsection = False DialCount += 1 x = x + 2 Continue Do 'its simple ID End If If skRes = "END623" Or skRes = "END" Or skRes = "311" Then Dim curCount = accum.Count currentDialog += 1 x += 2 Select Case skRes Case "END623" accum.AddRange({&H6, &H11, &H2, &H11, &H3, &H11}) Case "END" accum.AddRange({&H6, &H11, &H3, &H11}) Case "311" accum.AddRange({&H3, &H11}) End Select Exit Do End If Dim spl = Split(skRes, "=") If UBound(spl) = 1 Then 'Code = parsing Select Case spl(0) Case "0e" accum.AddRange({&HE, &H12, spl(1), 0}) Case "1e" accum.AddRange({&H1E, &H12, spl(1), 0}) Case "p" accum.AddRange({&H5, &H12, spl(1), 0}) Case "c" accum.AddRange({&H1D, &H12, spl(1), 0}) Case "col" Dim ind = ColorCodes.Find(Function(q) q.value = spl(1)).code 'old style color accum.AddRange({&H1D, &H12, ind, 0}) End Select Continue Do Else '2 hex codes parsing 'test specCodes Dim spec As CodeObject = SpecialCodes.Find(Function(q) q.value = skRes) 'Special code convert IF If Not IsNothing(spec) Then accum.AddRange(BitConverter.GetBytes(Convert.ToInt16(spec.code)).ToList) Continue Do End If If skRes.Length = 4 Then 'Try to parse other hex codes accum.AddRange(SoapHexBinary.Parse(skRes).Value.ToList) 'x += 2 Continue Do End If End If End If If tx(x) = vbTab Then accum.AddRange({&H20, &H11}) : x += 1 : Continue Do 'Tab and enter If tx(x) & tx(x + 1) = vbCrLf Then accum.AddRange({&H1, &H11}) : x += 2 : Continue Do If tx(x) = vbLf Then accum.AddRange({&H1, &H11}) : x += 1 : Continue Do 'SIMPLE TEXT ADDING Dim SimpleTextAccum = New List(Of Byte) Dim readCounter As Byte = 1 Do If Asc(tx(x)) < 32 Or Asc(tx(x)) = 91 Then x -= 1 : Exit Do SimpleTextAccum.Add(Asc(tx(x))) x += 1 Loop 'if 1 or 2 bytes If SimpleTextAccum.Count = 1 Then accum.AddRange({SimpleTextAccum(0), 0}) : x += 1 : Continue Do accum.Add(SimpleTextAccum.Count) accum.Add(&H20) 'command & length accum.AddRange(SimpleTextAccum) 'attach textline If SimpleTextAccum.Count And 1 Then accum.Add(0) ' if and 1 - add empty byte x += 1 Loop While x < tx.Length - 1 'TextPointers.RemoveAt(TextPointers.Count - 1) 'Remove Last Pointer 'updateing text pointers 'Сохраняем выходной файл My.Computer.FileSystem.WriteAllBytes(inputJfile & ".SummonTRNSL", accum.ToArray, False) End Sub Public Sub ConvertForEdit(srcFile As String, destFile As String) Dim txt = My.Computer.FileSystem.ReadAllText(srcFile, Encoding.GetEncoding(1251)) Dim destText = "" Dim accum = "" Dim x = 0 Dim t As List(Of String) = Split(Split(txt, "-----TEXT SECTION" & vbCrLf)(1), vbCrLf).ToList Dim idsection As Boolean = True For Each tx In t x = 0 If tx.Length < 2 Then Continue For If tx(x) = "\" And tx(x + 1) = "\" Then idsection = True Continue For End If Do If tx(x) = "[" Then Dim skRes = getFromSkobki(tx, x) If IsNumeric(skRes) And idsection Then idsection = False destText &= "[" & skRes & "]" & vbCrLf Continue For 'its simple ID End If If skRes = "END623" Or skRes = "END" Or skRes = "311" Or skRes = "EOF" Or skRes = "EOD3" Or skRes = "EndSelection" Then destText &= accum & vbCrLf accum = "" idsection = True Continue For End If If skRes = "EOw" Then accum &= vbCrLf If skRes = "SelectionMenu" Then accum &= " --[выбор]" & vbCrLf If skRes = "name" Then destText &= "Тацуя" If skRes = "surname" Then destText &= "Суоу" Continue Do End If If tx(x) = vbTab Then accum &= " " : x += 1 : Continue Do If tx(x) = "~" Then accum &= "..." : x += 1 : Continue Do accum &= tx(x) x = x + 1 Loop While x < tx.Length destText &= accum & vbCrLf accum = "" Next My.Computer.FileSystem.WriteAllText(destFile, destText, False) End Sub Public Function makeCRCString(ByRef bts As List(Of Byte)) Dim a = "" For Each b In bts a &= Chr(b) Next Return a End Function Public Sub ParseScript(ByVal inputJfile As String) If Mid(StrReverse(inputJfile), 1, 4) = "txt." Then MsgBox("ARE YOU AN IDIOT? ITS TXT!") : Exit Sub Dim bytes = My.Computer.FileSystem.ReadAllBytes(inputJfile) JapTextCounter = 0 Dim JapCompareCounter = 0 Dim res = New ScriptFile res.hz1 = BitConverter.ToInt32(bytes, 0) : res.hz2 = BitConverter.ToInt32(bytes, 4) res.CharsCount = BitConverter.ToInt32(bytes, 8) res.RefsTablePointer = BitConverter.ToInt32(bytes, 12) res.ScriptTablePointer = BitConverter.ToInt32(bytes, 16) res.StartTextPointer = BitConverter.ToInt32(bytes, 20) res.textPointers = New List(Of Integer) res.CharsArr = New List(Of Byte) res.refstable = New List(Of Int32) res.ScriptsTable = New List(Of Int32) res.Text = New List(Of Byte) res.Chars = New List(Of String) res.CharsCodes1 = New List(Of Integer) res.CharsCodes2 = New List(Of Integer) Dim TextPointersToScript = New List(Of Integer) Dim ComparePointersToScript = New List(Of Integer) Dim ScriptLength As Integer For a = 0 To res.CharsCount - 1 Dim readingByte = res.hz2 + a * 72 Dim curchar = "" For b = 0 To 68 If bytes(readingByte + b) < 32 Then res.Chars.Add(curchar) : curchar = "" : Exit For curchar &= Chr(bytes(readingByte + b)) Next res.CharsCodes1.Add(BitConverter.ToInt32(bytes, readingByte + 64)) res.CharsCodes2.Add(BitConverter.ToInt32(bytes, readingByte + 68)) Next Dim refstableIndexes = res.ScriptTablePointer - res.RefsTablePointer / 8 Dim scrprgline As Integer For x = res.RefsTablePointer To res.ScriptTablePointer - 1 Step 8 Dim isText = False Dim isCompareText = False Dim yy As UInt32 = BitConverter.ToInt16(bytes, x) Dim zz As UInt32 = BitConverter.ToInt32(bytes, x + 4) If bytes(x) = &H13 And bytes(x + 1) = 0 And bytes(x + 2) = 0 Then isText = True : TextPointersToScript.Add(zz) : JapTextCounter += 1 'Reading text commands from main offset table If bytes(x) = &HF And bytes(x + 1) = 1 Then isCompareText = True : ComparePointersToScript.Add(zz) : JapCompareCounter += 1 'Reading compare commands from main offset table res.refstable.Add(yy) ' res.refstable.Add(zz) 'Print BlockChar Subroutine Dim charIndex = res.CharsCodes1.FindIndex(Function(q) q = scrprgline) If charIndex > -1 Then res.ParsedScript &= res.Chars(charIndex) & ":" & vbCrLf 'Parsing script Command Dim parsedComm = ScriptCodes.Find(Function(w) w.code = yy) res.ParsedScript &= scrprgline.ToString("X4") & ": " Dim descr = "" If IsNothing(parsedComm) Then res.ParsedScript &= yy.ToString("X8") & " " Else res.ParsedScript &= parsedComm.value & " " If Not IsNothing(parsedComm.descr) Then descr = parsedComm.descr End If If x <> res.ScriptTablePointer - 1 Then ScriptLength = BitConverter.ToInt32(bytes, x + 12) - BitConverter.ToInt32(bytes, x + 4) Else ScriptLength = 4 End If 'ScriptLength = ScriptLength / 4 For scr = zz To zz + ScriptLength - 1 Step 4 res.ParsedScript &= " " & BitConverter.ToInt32(bytes, scr).ToString("X8") If yy = &HD Then res.ParsedScript &= " " & res.Chars(BitConverter.ToInt32(bytes, scr)) Next If descr <> "" Then res.ParsedScript &= " (" & descr & ")" If isText Then Dim curTextAddr = BitConverter.ToInt32(bytes, zz) + res.StartTextPointer Dim c = 0 Dim TextLine = readText(bytes, curTextAddr) res.ParsedScript &= " id:" & TextPointersToScript.Count - 1 & TextLine End If If isCompareText Then Dim curTextAddr = BitConverter.ToInt32(bytes, zz) + res.StartTextPointer Dim c = 0 Dim TextLine = readText(bytes, curTextAddr) res.ParsedScript &= " compareId:" & ComparePointersToScript.Count - 1 & " " & TextLine End If If yy = &HE Then res.ParsedScript &= vbCrLf If yy = &H12 Then res.ParsedScript &= vbCrLf If yy = &H7 Then res.ParsedScript &= vbCrLf If yy = &H4 Then res.ParsedScript &= vbCrLf If yy = &H2 Then res.ParsedScript &= vbCrLf If yy = &H1 Then res.ParsedScript &= vbCrLf res.ParsedScript &= vbCrLf scrprgline += 1 Next Dim ExportText = "" For ch = 0 To res.Chars.Count - 1 ExportText &= ch.ToString("X2") & " " & res.CharsCodes1(ch).ToString("X8") & " " & res.CharsCodes2(ch).ToString("X8") & " " & res.Chars(ch) & vbCrLf Next ExportText &= vbCrLf & vbCrLf & res.ParsedScript Dim d = New ScriptParserWin d.Text = Path.GetFileNameWithoutExtension(inputJfile) d.TextBox1.Text = ExportText d.ShowDialog() End Sub Public Function readText(ByRef bytes As Byte(), ByRef curTextAddr As Integer) Dim TextLine = " / " Dim c = 0 If curTextAddr >= bytes.Length Then Return " --- WRON POINTER!" Do c = BitConverter.ToInt16(bytes, curTextAddr) If c = &H1103 Then Exit Do If c = &H1136 Then 'ENGLISH TEXT curTextAddr += 2 Dim curCode = bytes(curTextAddr) Do If curCode > 31 Then TextLine &= Chr(curCode) curTextAddr += 1 curCode = bytes(curTextAddr) If curCode = 0 Then Exit Do Loop curTextAddr += 1 'jump 0 End If If curTextAddr And 1 Then curTextAddr += 1 'if AND1 - +1 If c And &H2000 Then 'Если строка в моём однобайтном формате Dim charNum = c And &HFF curTextAddr += 2 For q = 1 To charNum If curTextAddr >= bytes.Length Then Return " --- WRON TEXT!" TextLine &= Chr(bytes(curTextAddr)) curTextAddr += 1 Next If charNum And 1 Then curTextAddr += 1 'if AND1 - +1 Continue Do End If If c And &H1000 Then If c = &H1101 Then TextLine &= " / " curTextAddr += (c >> 8 And &HF) * 2 : Continue Do 'BitShift / And / Jump command length Else 'TextLine &= Chr(c And &HFF) End If curTextAddr += 2 Loop While c <> &H1103 Return TextLine End Function End Class Public Class ScriptFile Public hz1 As Integer Public hz2 As Integer Public CharsCount As Integer Public RefsTablePointer As Integer Public ScriptTablePointer As Integer Public ParsedScript As String Public StartTextPointer As Integer Public filename As String Public textPointers As List(Of Integer) Public CharsArr As List(Of Byte) Public Chars As List(Of String) Public CharsCodes1 As List(Of Integer) Public CharsCodes2 As List(Of Integer) Public refstable As List(Of Int32) Public ScriptsTable As List(Of Int32) Public Text As List(Of Byte) Public ParsedText As List(Of String) End Class Public Class CodeObject Public code As Integer Public value As String Public descr As String End Class Public Class TableElement Public Addr As Integer Public Code As Integer Public Value As Integer End Class Public Class NameElement Public Codes As String Public Dehash As String End Class