demon contacts import

SUPA PUPA DUPA COPYPASTE FILES IMPORT SYSTEM
This commit is contained in:
sShemet
2026-03-19 17:43:18 +05:00
parent 48ca6f2d85
commit 2e01e57e70
7 changed files with 105 additions and 39 deletions

View File

@@ -1,6 +1,7 @@
Imports System.IO
Imports System.Text
Imports System.IO.Compression
Imports System.Text
Imports Newtonsoft.Json
Partial Class Form1
@@ -635,6 +636,63 @@ Partial Class Form1
End Using
End Function
Public Function GetRelatedContacts(filePath As String) As List(Of Integer)
Dim directory As String = Path.GetDirectoryName(filePath)
Dim contactsFilePath As String = Path.Combine(directory, "contacts_copy.json")
If Not File.Exists(contactsFilePath) Then
Throw New FileNotFoundException($"contacts_copy.json not found in {directory}")
End If
Dim jsonContent As String = File.ReadAllText(contactsFilePath)
Dim contactsData As List(Of List(Of String)) = JsonConvert.DeserializeObject(Of List(Of List(Of String)))(jsonContent)
Dim fileName As String = Path.GetFileName(filePath)
' First 8 letters (0864_034)
Dim filePrefix As String = ""
If fileName.Length >= 8 Then
filePrefix = fileName.Substring(0, 8)
Else
Throw New ArgumentException($"Filename {fileName} too short")
End If
Dim targetGroup As List(Of String) = Nothing
For Each group As List(Of String) In contactsData
For Each contactFile As String In group
If contactFile.StartsWith(filePrefix) Then
targetGroup = group
Exit For
End If
Next
If targetGroup IsNot Nothing Then Exit For
Next
If targetGroup Is Nothing Then
Return New List(Of Integer)() ' Возвращаем пустой список
End If
Dim result As New List(Of Integer)
For Each contactFile As String In targetGroup
If contactFile.StartsWith(filePrefix) Then
Continue For
End If
Dim parts As String() = contactFile.Split("_"c)
If parts.Length >= 2 Then
Dim number As Integer
If Integer.TryParse(parts(1), number) Then
result.Add(number)
End If
End If
Next
Return result
End Function
End Class

View File

@@ -22,8 +22,8 @@ Partial Class Form1
'Не изменяйте ее в редакторе исходного кода.
<System.Diagnostics.DebuggerStepThrough()>
Private Sub InitializeComponent()
Dim DataGridViewCellStyle1 As System.Windows.Forms.DataGridViewCellStyle = New System.Windows.Forms.DataGridViewCellStyle()
Dim resources As System.ComponentModel.ComponentResourceManager = New System.ComponentModel.ComponentResourceManager(GetType(Form1))
Dim DataGridViewCellStyle1 As System.Windows.Forms.DataGridViewCellStyle = New System.Windows.Forms.DataGridViewCellStyle()
Me.JapISOPath = New System.Windows.Forms.TextBox()
Me.EngISOPath = New System.Windows.Forms.TextBox()
Me.Label1 = New System.Windows.Forms.Label()
@@ -149,6 +149,7 @@ Partial Class Form1
Me.Convert_Summon = New System.Windows.Forms.Button()
Me.Summon_Export = New System.Windows.Forms.Button()
Me.GroupBox8 = New System.Windows.Forms.GroupBox()
Me.CharContact = New System.Windows.Forms.CheckBox()
Me.ConvertContactScript = New System.Windows.Forms.Button()
Me.ExportContact = New System.Windows.Forms.Button()
Me.ExportDUNGScripts = New System.Windows.Forms.Button()
@@ -201,7 +202,6 @@ Partial Class Form1
Me.Label25 = New System.Windows.Forms.Label()
Me.CDEXTRApath = New System.Windows.Forms.TextBox()
Me.SavePaths = New System.Windows.Forms.Button()
Me.CharContact = New System.Windows.Forms.CheckBox()
Me.TabControl1.SuspendLayout()
Me.ReplaceTextExecutes.SuspendLayout()
Me.GroupBox11.SuspendLayout()
@@ -1597,8 +1597,7 @@ Partial Class Form1
Me.Label20.Name = "Label20"
Me.Label20.Size = New System.Drawing.Size(289, 309)
Me.Label20.TabIndex = 18
Me.Label20.Text = "" & Global.Microsoft.VisualBasic.ChrW(13) & Global.Microsoft.VisualBasic.ChrW(10) & " Text Reimport Memo:" & Global.Microsoft.VisualBasic.ChrW(13) & Global.Microsoft.VisualBasic.ChrW(10) & Global.Microsoft.VisualBasic.ChrW(13) & Global.Microsoft.VisualBasic.ChrW(10) & "0035 - Summons" & Global.Microsoft.VisualBasic.ChrW(13) & Global.Microsoft.VisualBasic.ChrW(10) & "0057-0397 - SCENARIO" & Global.Microsoft.VisualBasic.ChrW(13) & Global.Microsoft.VisualBasic.ChrW(10) & "0735 - Dungeon T" &
"alks" & Global.Microsoft.VisualBasic.ChrW(13) & Global.Microsoft.VisualBasic.ChrW(10) & "0713-0719 - City" & Global.Microsoft.VisualBasic.ChrW(13) & Global.Microsoft.VisualBasic.ChrW(10) & "0793 - Boss Battle Talk" & Global.Microsoft.VisualBasic.ChrW(13) & Global.Microsoft.VisualBasic.ChrW(10) & "0864 - Battle Contacts" & Global.Microsoft.VisualBasic.ChrW(13) & Global.Microsoft.VisualBasic.ChrW(10) & Global.Microsoft.VisualBasic.ChrW(13) & Global.Microsoft.VisualBasic.ChrW(10)
Me.Label20.Text = resources.GetString("Label20.Text")
'
'GroupBox9
'
@@ -1647,6 +1646,19 @@ Partial Class Form1
Me.GroupBox8.TabStop = False
Me.GroupBox8.Text = "Contact Scripts"
'
'CharContact
'
Me.CharContact.AutoSize = True
Me.CharContact.Checked = True
Me.CharContact.CheckState = System.Windows.Forms.CheckState.Checked
Me.CharContact.Location = New System.Drawing.Point(18, 22)
Me.CharContact.Margin = New System.Windows.Forms.Padding(4, 3, 4, 3)
Me.CharContact.Name = "CharContact"
Me.CharContact.Size = New System.Drawing.Size(145, 20)
Me.CharContact.TabIndex = 5
Me.CharContact.Text = "Character Contact"
Me.CharContact.UseVisualStyleBackColor = True
'
'ConvertContactScript
'
Me.ConvertContactScript.Location = New System.Drawing.Point(7, 129)
@@ -2193,19 +2205,6 @@ Partial Class Form1
Me.SavePaths.Text = "Save Path Settings"
Me.SavePaths.UseVisualStyleBackColor = True
'
'CharContact
'
Me.CharContact.AutoSize = True
Me.CharContact.Checked = True
Me.CharContact.CheckState = System.Windows.Forms.CheckState.Checked
Me.CharContact.Location = New System.Drawing.Point(18, 22)
Me.CharContact.Margin = New System.Windows.Forms.Padding(4, 3, 4, 3)
Me.CharContact.Name = "CharContact"
Me.CharContact.Size = New System.Drawing.Size(145, 20)
Me.CharContact.TabIndex = 5
Me.CharContact.Text = "Character Contact"
Me.CharContact.UseVisualStyleBackColor = True
'
'Form1
'
Me.AutoScaleDimensions = New System.Drawing.SizeF(7.0!, 16.0!)

View File

@@ -117,6 +117,22 @@
<resheader name="writer">
<value>System.Resources.ResXResourceWriter, System.Windows.Forms, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value>
</resheader>
<data name="Label20.Text" xml:space="preserve">
<value>
Text Reimport Memo:
0035 - Summons
0057-0397 - SCENARIO
0735 - Dungeon Talks
0713-0719 - City
0793 - Boss Battle Talk
0862 - Persona Contacts
0863 - Char Contacts
0864 - Demons Contacts
</value>
</data>
<metadata name="ID.UserAddedColumn" type="System.Boolean, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089">
<value>True</value>
</metadata>

View File

@@ -1073,7 +1073,6 @@ newtest:
Dim curfile As rleFile = binFile(curFileIndexInPack)
'Need To RLE?
If encodeTOrle.Checked Then
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
@@ -1105,21 +1104,25 @@ rleEnd:
If endfil.Count = 0 Then MsgBox("Import Error in file #" & curFileIndexInPack) : Exit Sub
'/Dim lastfileSectors As Integer = binFile(curFileIndexInPack).Bytes.Count Mod 2048
'Insert to selected File Array (Calc With BytesAfter)
binFile(curFileIndexInPack).Bytes = endfil.ToArray
Dim filebytes = endfil.ToArray
binFile(curFileIndexInPack).Bytes = filebytes
binFile(curFileIndexInPack).BytesAfter = 0
'Demon conversations copy-paste files system
If curFilePack = 864 Then
Dim related = GetRelatedContacts(filee)
For Each by In related
binFile(by).Bytes = filebytes
binFile(by).BytesAfter = 0
Next
End If
Next
'///////////////////MULTIFILES LOOP END
'АРХИВИРУЕМ МАССИВ ФАЙЛОВ ДЛЯ ЗАПИСИ В ОДИН ФАЙЛ
Dim lastSectorID As Integer = 0
Dim finalPack = New List(Of Byte)
@@ -2144,7 +2147,6 @@ rleEnd:
s.ParseScript(OpenFileDialog1.FileName)
End Sub
End Class

View File

@@ -104,7 +104,7 @@ Public Class ScriptTools
ScriptCodes.Add(New CodeObject With {.code = &H1E, .value = "AvtrLoad", .descr = "AvatarID"})
ScriptCodes.Add(New CodeObject With {.code = &H1F, .value = "AvtEmSet", .descr = "TEST IT!"})
ScriptCodes.Add(New CodeObject With {.code = &H20, .value = "AvUnload", .descr = "or wait"})
ScriptCodes.Add(New CodeObject With {.code = &H22, .value = "_AvaFade", .descr = "opacity, speed?"})
'ScriptCodes.Add(New CodeObject With {.code = &H22, .value = "_AvaFade", .descr = "opacity, speed?"})
ScriptCodes.Add(New CodeObject With {.code = &H23, .value = "AvaFWait"})
ScriptCodes.Add(New CodeObject With {.code = &H22, .value = "AvaSetXY"})
'ScriptCodes.Add(New CodeObject With {.code = &H23, .value = "AvaLdWit"})
@@ -134,7 +134,7 @@ Public Class ScriptTools
ScriptCodes.Add(New CodeObject With {.code = &H45, .value = "CtrlLock"})
ScriptCodes.Add(New CodeObject With {.code = &H46, .value = "CtrUnlck"})
ScriptCodes.Add(New CodeObject With {.code = &H48, .value = "ChSubSet", .descr = "ID, SubroutineID, ?, ?"})
ScriptCodes.Add(New CodeObject With {.code = &H48, .value = "ChSubSet", .descr = "ID, SubroutineID, Heigth, CollType"})
ScriptCodes.Add(New CodeObject With {.code = &H4A, .value = "CRotaDef"})
@@ -178,7 +178,7 @@ Public Class ScriptTools
ScriptCodes.Add(New CodeObject With {.code = &HD4, .value = "meshMove"})
ScriptCodes.Add(New CodeObject With {.code = &HD5, .value = "meshTurn"})
ScriptCodes.Add(New CodeObject With {.code = &HD6, .value = "meshWait"})
'ScriptCodes.Add(New CodeObject With {.code = &HD6, .value = "meshWait"})
ScriptCodes.Add(New CodeObject With {.code = &HD6, .value = "meshHide", .descr = "objID"})
@@ -1167,7 +1167,7 @@ endlineTest:
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})
TempLinesAccum.AddRange({&H2E, &H12, ind, 0})
End Select
'x += 2

View File

@@ -1,11 +1,7 @@
Public Class rleTools
'This is implementation from ASM of ORIGINAL ATLUS GAME UNRLE PROCEDURE
'NEED TO FIX LAST BYTES!!! Fixed!
Public Function Unrle(ByRef readFile As Byte())
Dim newF As List(Of Byte)
@@ -18,8 +14,6 @@
If readFile(0) = 2 Then readAddr = 16 'if picture
If readFile(0) = 3 Then readAddr = 20 'if bgm
Dim mode As Byte
Dim curByte As Byte
Dim params1readCounter As Byte
@@ -28,7 +22,6 @@
Dim params2 As Integer
Dim params18 As Integer
Do
If mode = 0 Then
@@ -117,8 +110,6 @@ LAB_80026700:
Dim params1readRepeatCounter As Byte 'params[1] 80080dc8 - Bytecounter to read
Dim params2
Do
If mode = 0 Then