admin/P2EP_Toolkit
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

scripts & contacts export support

Browse Source
This commit is contained in:
sShemet
2025-12-29 19:03:54 +05:00
parent 3475406781
commit cbad01271c
43 changed files with 102510 additions and 1534 deletions
Download Patch File Download Diff File Expand all files Collapse all files

268
p2isPSX_CDToolkit/Form1.vb
View File

@@ -1,4 +1,5 @@
Imports System
Imports System.Linq
Imports System.ComponentModel
Imports System.IO
Imports System.Net.Mime.MediaTypeNames
@@ -541,7 +542,7 @@ Public Class Form1
filename = ExportBinPath.Text & Strings.Left(FilnamLabel.Text, 4) & "_" & SelBinFiles.SelectedIndex.ToString("D2") & "_" & r.SectorID & "_" & r.ID
filename = ExportBinPath.Text & Strings.Left(FilnamLabel.Text, 4) & "_" & SelBinFiles.SelectedIndex.ToString("D3") & "_" & r.SectorID & "_" & r.ID
If japRadio.Checked Then filename &= "_J"
If EngRadio.Checked Or KudosBtn.Checked Then filename &= "_E"
@@ -593,10 +594,11 @@ Public Class Form1
Next
Dim ls As fileInfo = GetLastSector()
Dim sectorSize = If(ls.FileID < 866, 2048, 2336)
Dim freespace = FileLen(filnam) - (ls.Sector * &H930 + ls.Sizw)
LastSectorLbl.Text = "Last Sector: " & ls.Sector + ls.Sizw / 2048
LastSectorLbl.Text = "Last Sector: " & ls.Sector + ls.Sizw / sectorSize
CDFreeSpaceLabel.Text = Math.Round(freespace / 1024) & " Kbytes / " & Math.Round(freespace / &H930) & " sectors"
@@ -947,54 +949,78 @@ newtest:
End Sub
Private Function ByteSearch(ByVal searchIn As Byte(), ByVal searchBytes As Byte()) As Integer
Dim f As Integer
For i As Integer = 0 To searchIn.Length - searchBytes.Length
If Not searchIn(i) = searchBytes(0) Then Continue For
f = searchBytes.Length - 1
While f >= 1 AndAlso searchIn(i + f) = searchBytes(f)
f -= 1
End While
If f = 0 Then Return i
Private Function ByteSearchAll(ByVal searchIn As Byte(), ByVal searchBytes As Byte()) As Integer()
Dim results As New List(Of Integer)()
Dim searchLength = searchBytes.Length
For i As Integer = 0 To searchIn.Length - searchLength
Dim match As Boolean = True
For j As Integer = 0 To searchLength - 1
If searchIn(i + j) <> searchBytes(j) Then
match = False
Exit For
End If
Next
If match Then
results.Add(i)
i += searchLength - 1
End If
Next
Return -1
Return results.ToArray()
End Function
Private Sub SearchHexPattern_Click(sender As Object, e As EventArgs) Handles SearchHexPattern.Click
If HexPatternBox.Text.Length Mod 2 > 0 Then Exit Sub
HexPatternBox.Text = Replace(HexPatternBox.Text, " ", "")
Dim searchBytes = SoapHexBinary.Parse(HexPatternBox.Text).Value
If HexPatternBox.Text.Length Mod 2 > 0 Then Exit Sub
Dim searchBytes() As Byte
Try
searchBytes = SoapHexBinary.Parse(HexPatternBox.Text).Value
Catch ex As Exception
MsgBox("Error Parsing HEX string!", MsgBoxStyle.Critical)
Exit Sub
End Try
Dim Str = String.Join(",", searchBytes)
Debug.WriteLine($"Searching bytes {Str} ....")
Dim cd = New ISOTools
Dim exeFile = cd.getCDfile(getFilnam, 27, 1812408)
'search in exe
Dim res = ByteSearch(exeFile.ToArray, searchBytes)
If res > -1 Then MsgBox("FOUND! IN SLPS!" & vbCrLf & "Offset: " & res) : Exit Sub
'Dim found = ByteSearch(fil, searchBytes)
'If found > -1 Then MsgBox("FOUND! " & vbCrLf & "OFFSET = " & found)
Dim searchRes = New List(Of String)
Dim jsonRes = New List(Of String)
'all files to video
For a = 0 To CDFileList.Items.Count - 1
Dim curFile = cd.getCDfile(getFilnam, files1(a).Sector, files1(a).Sizw)
'If curFile(0) = 1 Or curFile(0) = 2 Then Continue For 'IF ARCHIVE
'If curFile(1) = 1 Or curFile(1) = 2 Then Continue For
Debug.WriteLine("Searching... " & a)
res = ByteSearch(curFile.ToArray, searchBytes)
If res > -1 Then searchRes.Add("#" & a & " Offset: " & res)
'search in exe
Dim exeResults = ByteSearchAll(exeFile.ToArray, searchBytes)
For Each res In exeResults
searchRes.Add("#0000 Offset: " & res)
jsonRes.Add("{""id"":0000,""offset"":" & res & "}")
Next
'search in files
For a = 0 To CDFileList.Items.Count - 1
Dim curFile = cd.getCDfile(getFilnam, files1(a).Sector, files1(a).Sizw)
Dim fileResults = ByteSearchAll(curFile.ToArray, searchBytes)
For Each res In fileResults
searchRes.Add("#" & a & " Offset: " & res)
jsonRes.Add("{""id"":" & a & ",""offset"":" & res & "}")
Next
Next
Debug.WriteLine($"Found {searchRes.Count} times")
If searchRes.Count Then
MsgBox("FOUND: " & vbCrLf & (Join(searchRes.ToArray, vbCrLf)))
If MsgBox("FOUND: " & vbCrLf & Join(searchRes.ToArray, vbCrLf) & vbCrLf & vbCrLf & "Wanna save JSON?", MsgBoxStyle.YesNo) = MsgBoxResult.Yes Then
SaveFileDialog1.FileName = "searchResult.json"
If SaveFileDialog1.ShowDialog <> DialogResult.OK Then Exit Sub
Dim fileText = "[" & Join(jsonRes.ToArray, ",") & "]"
My.Computer.FileSystem.WriteAllText(SaveFileDialog1.FileName, fileText, False)
End If
Else
MsgBox("NOT FOUND")
MsgBox("Not found")
End If
'5374617475733A2048756D616E
End Sub
Private Sub SaveShadowDisc_Click(sender As Object, e As EventArgs) Handles SaveShadowDisc.Click
@@ -1037,10 +1063,11 @@ newtest:
Dim curFileIndexInPack As Integer = fileInfo(1)
Dim curFileSector As Integer = fileInfo(2)
Dim curFileRleID As Integer = fileInfo(3)
Debug.WriteLine("Importing... " & Path.GetFileNameWithoutExtension(filee))
Debug.WriteLine("Importing... " & Path.GetFileName(filee) & " | InPackIndex=" & curFileIndexInPack)
If curFilePack <> CDFileList.SelectedIndex Then MsgBox("Select File From CD and Proper file to import! IDs not equal!" & vbCrLf & filee, MsgBoxStyle.Critical) : Exit Sub
Dim fil = My.Computer.FileSystem.ReadAllBytes(filee)
Dim r = New rleTools
Dim curfile As rleFile = binFile(curFileIndexInPack)
'Need To RLE?
@@ -1049,23 +1076,15 @@ newtest:
If curfile.Compr = 0 Then
If ForceRle.Checked Then
If MsgBox("Warning! Source File Is not Compressed! Continue??", MsgBoxStyle.YesNo) <> MsgBoxResult.Yes Then Exit Sub
Dim r = New rleTools
endfil = r.decodeRLEnew(fil, curfile)
GoTo rleEnd
End If
'making fileHeaderForNonCompressed
endfil.Add(curfile.Type)
endfil.Add(0) 'No compression
endfil.Add(BitConverter.GetBytes(curfile.ID)(0)) 'Convert ID
endfil.Add(BitConverter.GetBytes(curfile.ID)(1))
endfil.Add(BitConverter.GetBytes(fil.Count + 8)(0)) 'FileSize
endfil.Add(BitConverter.GetBytes(fil.Count + 8)(1)) 'FileSize
endfil.Add(BitConverter.GetBytes(fil.Count + 8)(2)) 'FileSize
endfil.Add(BitConverter.GetBytes(fil.Count + 8)(3)) 'FileSize
endfil.AddRange(fil.ToList)
endfil = r.attachNoCompressionHeader(curfile, fil)
rleEnd:
'adding bytes to read MOD4
Dim addedBytes = endfil.Count Mod 4
If addedBytes > 0 Then addedBytes = 4 - addedBytes
@@ -1074,12 +1093,8 @@ rleEnd:
Next
Else
Dim r = New rleTools
endfil = r.decodeRLEnew(fil, curfile)
End If
@@ -1135,8 +1150,8 @@ rleEnd:
finalPack.Add(0)
Next
If CDFileList.SelectedIndex = 735 Or CDFileList.SelectedIndex = 90 Or CDFileList.SelectedIndex = 1075 Then
'dungeons & summon text & battle contacts
If CDFileList.SelectedIndex = 735 Or CDFileList.SelectedIndex = 35 Or CDFileList.SelectedIndex = 1075 Then
'checking crazy last 20 bytes on sector for file IN SUUMON AND DUNGEON TEXTS
Dim ffff = 2048 - (finalPack.Count Mod 2048)
If ffff <= 20 And ffff > 0 Then
@@ -1174,8 +1189,21 @@ rleEnd:
'Updating fileTable in externalCode for DUNGEON DIALOGS in 0736
MakePointersTable(addresses, files1(736).Sector, files1(736).Sizw, 110548)
'city import
Case 713
MakePointersTable(addresses, 200 + 27, 4096, &H300) '200 sector of main exe + exe start sector + 0x300 bytes offset
Case 714
MakePointersTable(addresses, 200 + 27, 4096, &H300 + 152)
Case 715
MakePointersTable(addresses, 200 + 27, 4096, &H300 + 320)
Case 716
MakePointersTable(addresses, 200 + 27, 4096, &H300 + 488)
Case 717
MakePointersTable(addresses, 200 + 27, 4096, &H300 + 696)
Case 718
MakePointersTable(addresses, 200 + 27, 4096, &H300 + 856)
Case 719
MakePointersTable(addresses, 200 + 27, 4096, &H300 + 1000)
'IS old pointers
'Case 4
' 'Updating fileTable in BattleCode for DIALOGS in 0004
@@ -1187,20 +1215,6 @@ rleEnd:
' Update0073SummonScriptTable(addresses) 'summon scripts table in 0073
' 'city import
'Case 1112
' 'Updating fileTable in mainEXE for DIALOGS in 1112
' MakePointersTable(addresses, 225, 4096, 1148) 'if 1112
'Case 1113
' MakePointersTable(addresses, 225, 4096, 1148 + 136) 'if 1113
'Case 1114
' MakePointersTable(addresses, 225, 4096, 1148 + 352)
'Case 1115
' MakePointersTable(addresses, 225, 4096, 1148 + 544)
'Case 1116
' MakePointersTable(addresses, 225, 4096, 1148 + 720)
'Case 1117
' MakePointersTable(addresses, 225, 4096, 1148 + 888)
'Case 1075
' UpdateBattleContactFileTable(addresses) 'Updating BattleContacts
End Select
@@ -1501,8 +1515,9 @@ rleEnd:
Private Sub getFreeSector_Click(sender As Object, e As EventArgs) Handles getFreeSector.Click
Dim a As fileInfo = GetLastSector()
Dim sectorSize = If(a.FileID > 865, 2336, 2048) 'Video or not
importSector.Text = a.Sector + a.Sizw \ 2048 + 10
importSector.Text = a.Sector + a.Sizw \ sectorSize + 10
End Sub
@@ -1714,7 +1729,7 @@ rleEnd:
Dim curFileIndexInPack As Integer = fileInfo(1)
Dim curFileSector As Integer = fileInfo(2)
Dim curFileRleID As Integer = fileInfo(3)
Debug.WriteLine("Importing... " & Path.GetFileNameWithoutExtension(filee))
Debug.WriteLine("Importing... " & Path.GetFileName(filee))
If curFilePack <> CDFileList.SelectedIndex Then MsgBox("Select File From CD and Proper file to import! IDs not equal!" & vbCrLf & filee, MsgBoxStyle.Critical) : Exit Sub
@@ -1805,9 +1820,9 @@ rleEnd:
'UPDATING FILES TABLES
Select Case CDFileList.SelectedIndex
Case 682
'TITLE SCREENS IMPORT
MakePointersTable(addresses, files1(681).Sector, files1(681).Sizw, 50392)
'Case 682
' 'TITLE SCREENS IMPORT
' MakePointersTable(addresses, files1(681).Sector, files1(681).Sizw, 50392)
@@ -1832,51 +1847,81 @@ rleEnd:
MsgBox(String.Format("Imported {0} images in {1} - {2} bytes", UBound(OpenFileDialog1.FileNames) + 1, CDFileList.SelectedIndex, finalPack.Count), MsgBoxStyle.Exclamation)
End Sub
Private Sub BackgroundWorker1_ProgressChanged(sender As Object, e As ProgressChangedEventArgs) Handles BackgroundWorker1.ProgressChanged
End Sub
Private Sub TitlesLoad_Click(sender As Object, e As EventArgs) Handles TitlesLoad.Click
Dim iso = New ISOTools
Dim fil = iso.getCDfile(UserPath.Text, files1(1126).Sector, files1(1126).Sizw)
Dim reader As Integer = 13804
Dim lastByte = 16253
Dim fil = iso.getCDfile(UserPath.Text, files1(728).Sector, files1(728).Sizw).ToArray
Dim dataStart = 11188
Dim lastByte = 15708
TGrid.Rows.Clear()
Dim accum = ""
Do
Select Case fil(reader)
Case 128
TGrid.Rows.Add(accum)
accum = ""
GoTo Endd
Case 129
accum &= " "
GoTo Endd
Case > 127
accum &= "[C=" & fil(reader) - 128 & "]"
GoTo Endd
Case <= 26
accum &= Chr(fil(reader) + 64)
GoTo Endd
Case <= 52
accum &= Chr(fil(reader) + 70)
Case 59
TGrid.Rows.Add("------")
Case Else
accum &= "[B=" & fil(reader) & "]"
End Select
Endd:
reader += 1
Loop While TGrid.Rows.Count < 172
'TGrid.Rows.Add(accum)
Dim offsetTable = New List(Of Integer)
For a = 1 To BitConverter.ToInt32(fil, dataStart)
offsetTable.Add(BitConverter.ToInt32(fil, dataStart + a * 4) - 8)
Next
For Each offset In offsetTable
Dim reader = offset + dataStart
Dim accum = ""
Do
Dim b = fil(reader)
Select Case b
Case 128
Exit Do
Case 129
accum &= " "
Case > 127
accum &= "[C=" & fil(reader) - 128 & "]"
Case <= 26
accum &= Chr(fil(reader) + 64)
Case <= 52
accum &= Chr(fil(reader) + 70)
Case 59
TGrid.Rows.Add("------")
Case Else
accum &= "[B=" & fil(reader) & "]"
End Select
reader += 1
Loop While fil(reader) <> 128
TGrid.Rows.Add(accum)
Next
' Do
' Select Case fil(reader)
' Case 128
' TGrid.Rows.Add(accum)
' accum = ""
' GoTo Endd
' Case 129
' accum &= " "
' GoTo Endd
' Case > 127
' accum &= "[C=" & fil(reader) - 128 & "]"
' GoTo Endd
' Case <= 26
' accum &= Chr(fil(reader) + 64)
' GoTo Endd
' Case <= 52
' accum &= Chr(fil(reader) + 70)
' Case 59
' TGrid.Rows.Add("------")
' Case Else
' accum &= "[B=" & fil(reader) & "]"
' End Select
'Endd:
' reader += 1
' Loop While TGrid.Rows.Count < 172
' 'TGrid.Rows.Add(accum)
End Sub
@@ -1977,7 +2022,7 @@ Endd:
For Each f In filesSorted
If f.FileID >= 865 And f.FileID <= 879 Then SectorType = 2352 Else SectorType = 2048
If f.FileID >= 865 And f.FileID <= 880 Then SectorType = 2336 Else SectorType = 2048
Dim sectSize As Integer = f.Sizw \ SectorType
Dim sizeadd = ""
@@ -2095,6 +2140,7 @@ Endd:
s.ParseScript(OpenFileDialog1.FileName)
End Sub
End Class