2124 lines
70 KiB
VB.net
2124 lines
70 KiB
VB.net
Imports System
|
||
Imports System.ComponentModel
|
||
Imports System.IO
|
||
Imports System.Net.Mime.MediaTypeNames
|
||
Imports System.Runtime.Remoting.Metadata.W3cXsd2001
|
||
Imports System.Text
|
||
Imports MadMilkman.Ini
|
||
|
||
Public Class Form1
|
||
|
||
Public readerror As Boolean
|
||
Public binFile As List(Of rleFile)
|
||
Public files1 As List(Of fileInfo)
|
||
Public files2 As List(Of fileInfo)
|
||
Public CurrentImgMode As Byte
|
||
Dim drawSurface As Bitmap
|
||
Public chars As List(Of Char)
|
||
Public iniFile = "..\..\..\settings.ini"
|
||
|
||
|
||
Public DialogCounter As Integer
|
||
|
||
|
||
'Private Sub PictureBox1_Paint(sender As Object, e As PaintEventArgs) Handles PictureBox1.Paint
|
||
' e.Graphics.InterpolationMode = Drawing2D.InterpolationMode.NearestNeighbor
|
||
' e.Graphics.ScaleTransform(2, 2)
|
||
' e.Graphics.DrawImage(drawSurface, 0, 0)
|
||
'End Sub
|
||
|
||
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
|
||
'WorkDir.Text &= "export\"
|
||
|
||
If Not System.IO.File.Exists(iniFile) Then
|
||
InitializateIni()
|
||
End If
|
||
|
||
LoadIni()
|
||
|
||
SaveFileDialog1.InitialDirectory = WorkDir.Text & "export\"
|
||
OpenFileDialog1.InitialDirectory = WorkDir.Text
|
||
|
||
ExportBinPath.Text = WorkDir.Text
|
||
LoadChars() 'Load Atlus font
|
||
|
||
drawSurface = New Bitmap(PictureBox1.ClientSize.Width, PictureBox1.ClientSize.Height)
|
||
PictureBox1.Image = drawSurface
|
||
|
||
ReadCDFileTable.PerformClick()
|
||
|
||
End Sub
|
||
|
||
Private Sub InitializateIni()
|
||
MsgBox(iniFile & " is not found! Please make and save your CD images paths!")
|
||
Dim file As New IniFile()
|
||
Dim s As IniSection = file.Sections.Add("Images Settings")
|
||
s.TrailingComment.Text = "CD Images Paths"
|
||
s.Keys.Add("USER_BIN", "")
|
||
s.Keys.Add("JAP_BIN", "")
|
||
s.Keys.Add("USA_BIN", "")
|
||
s.Keys.Add("KUDOS_BIN", "")
|
||
s.Keys.Add("EXTRA_CD_BIN", "")
|
||
s.Keys.Add("WORK_DIR", "")
|
||
file.Save(iniFile)
|
||
End Sub
|
||
|
||
Private Sub SavePaths_Click(sender As Object, e As EventArgs) Handles SavePaths.Click
|
||
Dim file As New IniFile()
|
||
Dim s As IniSection = file.Sections.Add("Images Settings")
|
||
s.TrailingComment.Text = "CD Images Paths"
|
||
s.Keys.Add("USER_BIN", UserPath.Text)
|
||
s.Keys.Add("JAP_BIN", JapISOPath.Text)
|
||
s.Keys.Add("USA_BIN", EngISOPath.Text)
|
||
s.Keys.Add("KUDOS_BIN", KUDOSpath.Text)
|
||
s.Keys.Add("EXTRA_CD_BIN", CDEXTRApath.Text)
|
||
s.Keys.Add("WORK_DIR", WorkDir.Text)
|
||
file.Save(iniFile)
|
||
MsgBox("Path settings saved!", vbInformation)
|
||
End Sub
|
||
|
||
Private Sub LoadIni()
|
||
Dim file As New IniFile()
|
||
file.Load(iniFile)
|
||
For Each Section In file.Sections
|
||
If Section.Name = "Images Settings" Then
|
||
For Each key In Section.Keys
|
||
Select Case key.Name
|
||
Case "USER_BIN"
|
||
UserPath.Text = key.Value
|
||
Case "JAP_BIN"
|
||
JapISOPath.Text = key.Value
|
||
Case "USA_BIN"
|
||
EngISOPath.Text = key.Value
|
||
Case "KUDOS_BIN"
|
||
KUDOSpath.Text = key.Value
|
||
Case "EXTRA_CD_BIN"
|
||
CDEXTRApath.Text = key.Value
|
||
Case "WORK_DIR"
|
||
WorkDir.Text = key.Value
|
||
End Select
|
||
Next
|
||
End If
|
||
Next
|
||
End Sub
|
||
|
||
Private Sub unRLEfileOpen_Click(sender As Object, e As EventArgs) Handles unRLEfileOpen.Click
|
||
|
||
If OpenFileDialog1.ShowDialog <> DialogResult.OK Then Exit Sub
|
||
|
||
unRLEfile.Text = OpenFileDialog1.FileName
|
||
|
||
|
||
End Sub
|
||
|
||
|
||
Private Sub Unrle_Btn_Click(sender As Object, e As EventArgs) Handles Unrle_Btn.Click
|
||
Dim r = New rleTools
|
||
Dim unrleFileData = My.Computer.FileSystem.ReadAllBytes(unRLEfile.Text)
|
||
Dim newFArray = r.Unrle(unrleFileData).ToArray
|
||
If SaveFileDialog1.ShowDialog <> DialogResult.OK Then Exit Sub
|
||
|
||
My.Computer.FileSystem.WriteAllBytes(SaveFileDialog1.FileName, newFArray, False)
|
||
|
||
End Sub
|
||
|
||
|
||
Private Sub RLEdecode_Click(sender As Object, e As EventArgs) Handles RLEdecode.Click
|
||
'Dim r = New rleTools()
|
||
|
||
'Dim DecodedFile = r.decodeRLE(My.Computer.FileSystem.ReadAllBytes(unRLEfile.Text), encodeID.Text).ToArray
|
||
|
||
'My.Computer.FileSystem.WriteAllBytes(unRLEfile.Text & "ENCODED", DecodedFile, False)
|
||
|
||
'MsgBox("ENCODED!", MsgBoxStyle.Exclamation)
|
||
|
||
|
||
End Sub
|
||
Public Function Read32bitNum(ByRef f As Byte(), ByVal bytenum As Integer)
|
||
If f(bytenum + 3) = 255 And f(bytenum + 2) = 255 And f(bytenum + 1) = 255 And f(bytenum) = 255 Then Return -1
|
||
Return f(bytenum) + f(bytenum + 1) * 256 + f(bytenum + 2) * 65536 + f(bytenum + 3) * 16777216
|
||
End Function
|
||
|
||
Public Function Read16bitNum(ByRef f As Byte(), ByVal bytenum As Integer)
|
||
Return f(bytenum) + f(bytenum + 1) * 256
|
||
End Function
|
||
Private Sub ModifyFont_Click(sender As Object, e As EventArgs) Handles ModifyFont.Click
|
||
Dim f = New FontTools
|
||
f.convertTo16()
|
||
End Sub
|
||
Private Sub ConvertTo12x12_Click(sender As Object, e As EventArgs) Handles ConvertTo12x12.Click
|
||
Dim f = New FontTools
|
||
f.ConvertTo12()
|
||
End Sub
|
||
'select bin file
|
||
Private Sub OPenBinBtn_Click(sender As Object, e As EventArgs) Handles OPenBinBtn.Click
|
||
|
||
If OpenFileDialog1.ShowDialog <> DialogResult.OK Then Exit Sub
|
||
|
||
FilnamLabel.Text = Path.GetFileNameWithoutExtension(OpenFileDialog1.FileName)
|
||
CDFileList.Items.Clear()
|
||
|
||
DeconstructFile(My.Computer.FileSystem.ReadAllBytes(OpenFileDialog1.FileName))
|
||
ShowFileSectors(binFile)
|
||
|
||
End Sub
|
||
|
||
'Deconstruct bin - can deconstruct inputted bin from CD
|
||
|
||
Public Sub DeconstructFile(ByRef Bytes() As Byte)
|
||
|
||
If NotDeconstr.Checked Then Exit Sub
|
||
SelBinFiles.Items.Clear()
|
||
binFile = New List(Of rleFile)
|
||
If UBound(Bytes) > -1 Then
|
||
|
||
If Bytes(0) > 3 Or Bytes(1) > 2 Then FilnamLabel.Text &= " NOT ARCHIVE!" : Exit Sub
|
||
|
||
End If
|
||
|
||
Dim cursector = 0
|
||
Dim curid = 0
|
||
Dim readByte = 0
|
||
|
||
'DEBUG
|
||
'My.Computer.FileSystem.WriteAllBytes(ExportBinPath.Text & "DEBUG", Bytes, False)
|
||
|
||
Do
|
||
Dim r = New rleFile With {.SectorID = cursector,
|
||
.Type = Bytes(readByte + 0),
|
||
.Compr = Bytes(readByte + 1),
|
||
.Size = BitConverter.ToInt32(Bytes, readByte + 4),
|
||
.UnpackSize = BitConverter.ToInt32(Bytes, readByte + 8),
|
||
.Mode = Bytes(readByte + 1),
|
||
.ID = BitConverter.ToInt16(Bytes, readByte + 2),
|
||
.BytesAfter = 0, .SectorGap = 0
|
||
}
|
||
|
||
|
||
Dim BA = r.Size Mod 4
|
||
If BA > 0 Then r.BytesAfter = 4 - BA
|
||
|
||
If r.Mode = 0 Then r.UnpackSize = r.Size 'wi
|
||
|
||
If r.Type = 2 Then
|
||
r.x = BitConverter.ToInt16(Bytes, readByte + 8)
|
||
r.y = BitConverter.ToInt16(Bytes, readByte + 10)
|
||
r.w = BitConverter.ToInt16(Bytes, readByte + 12)
|
||
r.h = BitConverter.ToInt16(Bytes, readByte + 14)
|
||
r.UnpackSize = 0 ' r.w * r.h 'А ГДЕ БИТНОСТЬ ИЗОБРАЖЕНИЯ-ТО, ПЛЯТЬ????
|
||
End If
|
||
|
||
|
||
Try
|
||
ReDim r.Bytes(r.Size - 1)
|
||
Array.Copy(Bytes, readByte, r.Bytes, 0, r.Size)
|
||
Catch ex As Exception
|
||
MsgBox("Exception! :" & ex.Message, MsgBoxStyle.Critical)
|
||
Exit Sub
|
||
End Try
|
||
|
||
|
||
binFile.Add(r)
|
||
|
||
readByte += r.Size + r.BytesAfter
|
||
|
||
|
||
If readByte > UBound(Bytes) Then Exit Do
|
||
|
||
If Bytes(readByte) = 0 Then
|
||
Do
|
||
binFile.Last.SectorGap += 1
|
||
If Bytes(readByte) > 0 Then Exit Do
|
||
readByte += 1
|
||
Loop While readByte <= UBound(Bytes)
|
||
cursector += 1
|
||
|
||
End If
|
||
|
||
Loop While (readByte <= UBound(Bytes))
|
||
|
||
|
||
End Sub
|
||
|
||
|
||
'NEED FOR FILE REPLACE
|
||
Public Sub ReconstructFile()
|
||
|
||
|
||
|
||
End Sub
|
||
|
||
'Show files in list
|
||
Public Sub ShowFileSectors(ByRef BinFile As List(Of rleFile))
|
||
SelBinFiles.Items.Clear()
|
||
Dim compr = New List(Of String)
|
||
compr.Add("None")
|
||
compr.Add("RLE2")
|
||
compr.Add("RLE")
|
||
|
||
Dim type = New List(Of String)
|
||
type.Add("eof")
|
||
type.Add("DATA")
|
||
type.Add("IMAGE")
|
||
type.Add("SND")
|
||
If IsNothing(BinFile) Then Exit Sub
|
||
|
||
For Each r In BinFile
|
||
|
||
Dim xy = ""
|
||
|
||
If r.Type = 2 Then xy = ", Vx" & r.x & " Vy" & r.y & ", w" & r.w & " h" & r.h
|
||
|
||
|
||
Select Case r.Compr
|
||
Case 0
|
||
SelBinFiles.Items.Add(r.SectorID & ":" & r.ID & " : " & type(r.Type) & xy & " : " & compr(r.Compr) & ", Sz: " & r.Size & " Gap: " & r.SectorGap)
|
||
Case 1
|
||
If r.Type <> 3 Then
|
||
SelBinFiles.Items.Add(r.SectorID & ":" & r.ID & " : " & type(r.Type) & xy & " : " & compr(r.Compr) & ", Sz: " & r.Size & " unp:" & r.UnpackSize & " Gap: " & r.SectorGap)
|
||
Else
|
||
SelBinFiles.Items.Add(r.SectorID & ":" & r.ID & " : SNDPACK : " & compr(r.Compr) & ", Sz: " & r.Size & " Gap: " & r.SectorGap)
|
||
End If
|
||
Case 2
|
||
SelBinFiles.Items.Add(r.SectorID & ":" & r.ID & " : " & type(r.Type) & xy & " : " & compr(r.Compr) & ", Sz: " & r.Size & " unp:" & r.UnpackSize & " Gap: " & r.SectorGap)
|
||
Case Else
|
||
SelBinFiles.Items.Add(r.SectorID & ":" & r.ID & " : " & type(r.Type) & xy & " : UNKNOWN COMPR, Sz: " & r.Size & " unp:" & r.UnpackSize & " Gap: " & r.SectorGap)
|
||
|
||
End Select
|
||
|
||
|
||
Next
|
||
|
||
End Sub
|
||
|
||
Private Sub SelBinFiles_SelectedIndexChanged(sender As Object, e As EventArgs) Handles SelBinFiles.SelectedIndexChanged
|
||
Savedlbl.Text = "-----"
|
||
|
||
If SelBinFiles.SelectedIndex = -1 Then Exit Sub
|
||
CurrentImgMode = 0
|
||
|
||
'Image working
|
||
Dim r As rleFile = binFile(SelBinFiles.SelectedIndex)
|
||
If r.Type <> 2 Then PngExport.Enabled = False : Exit Sub Else PngExport.Enabled = True
|
||
If SelBinFiles.SelectedIndex = SelBinFiles.Items.Count - 1 Then Exit Sub
|
||
Dim nx = binFile(SelBinFiles.SelectedIndex + 1)
|
||
If (nx.w <> 16) And (nx.w <> 256 Or nx.h <> 1) Then
|
||
CLUTid.Value = 0
|
||
CLUTid.Enabled = False
|
||
ImgShow.Enabled = False
|
||
|
||
Exit Sub
|
||
End If
|
||
|
||
|
||
CLUTid.Value = 0
|
||
CLUTid.Enabled = True
|
||
ImgShow.Enabled = True
|
||
CLUTs.Text = "CLUTs Num: " & nx.h
|
||
' CLUTid.Maximum = nx.h - 1
|
||
CLUTid.Minimum = 0
|
||
DrawImage()
|
||
|
||
End Sub
|
||
|
||
Public Sub DrawImage()
|
||
' PictureBox1.BackColor = Color.Transparent
|
||
PictureBox1.Invalidate()
|
||
drawSurface = New Bitmap(PictureBox1.ClientSize.Width * 3, PictureBox1.ClientSize.Height * 3)
|
||
PictureBox1.Image = drawSurface
|
||
Dim rle = New rleTools
|
||
Dim curF As rleFile = binFile(SelBinFiles.SelectedIndex)
|
||
Dim pic
|
||
If curF.Compr = 0 Then pic = rle.UnrleNocompr(curF.Bytes)
|
||
If curF.Compr = 1 Then pic = rle.Unrle2(curF.Bytes)
|
||
Dim nx = binFile(SelBinFiles.SelectedIndex + 1)
|
||
If LowerCLUT.Checked Then nx = binFile(SelBinFiles.SelectedIndex + 2)
|
||
If UpperCLUT.Checked Then nx = binFile(SelBinFiles.SelectedIndex - 1)
|
||
If nx.w = 256 Then Imp8bit.Checked = True Else imp4bit.Checked = True
|
||
If Force4bit.Checked Then imp4bit.Checked = True
|
||
Dim cluts As New List(Of Color)
|
||
cluts = MakeCLUTList(nx)
|
||
Dim x = 0, y = 0, reader = 0
|
||
Do
|
||
If nx.w = 16 Or Force4bit.Checked Then
|
||
If x = curF.w * 2 Then x = 0 : y += 1
|
||
'4bit mode
|
||
Dim fs = pic(reader)
|
||
Dim lp = fs And &HF 'get left byte
|
||
Dim rp = (fs And &HF0) >> 4 'get right byte
|
||
drawpixel(x * 2, y, cluts(lp))
|
||
drawpixel(x * 2 + 1, y, cluts(rp))
|
||
'End If
|
||
Else
|
||
|
||
''8bit mode
|
||
'If nx.w = 256 Then
|
||
If x = curF.w Then x = 0 : y += 1
|
||
If reader + 1 > pic.Count - 1 Then Exit Do
|
||
Dim fs = pic(reader)
|
||
Dim fs2 = pic(reader + 1)
|
||
drawpixel(x * 2, y, cluts(fs))
|
||
drawpixel(x * 2 + 1, y, cluts(fs2))
|
||
reader += 1
|
||
End If
|
||
reader += 1
|
||
x += 1
|
||
If reader >= pic.Count Then Exit Do
|
||
Loop
|
||
PictureBox1.Invalidate()
|
||
|
||
End Sub
|
||
|
||
|
||
Private Sub Show16bit_Click(sender As Object, e As EventArgs) Handles Show16bit.Click
|
||
If SelBinFiles.SelectedIndex = -1 Then Exit Sub
|
||
PictureBox1.Invalidate()
|
||
imp16bit.Checked = True
|
||
CurrentImgMode = 16
|
||
drawSurface = New Bitmap(PictureBox1.ClientSize.Width * 3, PictureBox1.ClientSize.Height * 3)
|
||
PictureBox1.Image = drawSurface
|
||
Dim rle = New rleTools
|
||
Dim curF = binFile(SelBinFiles.SelectedIndex)
|
||
Dim pic As List(Of Byte)
|
||
Dim reader = 0
|
||
|
||
If curF.Compr <> 0 Then
|
||
pic = rle.Unrle2(curF.Bytes)
|
||
Else
|
||
pic = curF.Bytes.ToList
|
||
pic.RemoveRange(0, 16)
|
||
End If
|
||
Dim x = 0, y = 0
|
||
Dim fs = pic.ToArray
|
||
Do
|
||
If x = curF.w Then x = 0 : y += 1
|
||
drawpixel(x, y, GetColFrom1555(fs, reader))
|
||
reader += 2
|
||
x += 1
|
||
If reader >= pic.Count Then Exit Do
|
||
Loop
|
||
PictureBox1.Invalidate()
|
||
|
||
End Sub
|
||
|
||
Public Sub drawpixel(ByVal x As Integer, ByVal y As Integer, ByVal col As Color)
|
||
For a = 0 To 1
|
||
For b = 0 To 1
|
||
drawSurface.SetPixel(x * 2 + a, y * 2 + b, col)
|
||
Next
|
||
Next
|
||
End Sub
|
||
|
||
|
||
Public Function MakeCLUTList(ByRef nx As rleFile)
|
||
|
||
Dim a = New List(Of Color)
|
||
'4bit mode
|
||
Dim rle As New rleTools
|
||
Dim unrl() As Byte
|
||
|
||
Select Case nx.Compr
|
||
Case 0
|
||
unrl = rle.UnrleNocompr(nx.Bytes).ToArray
|
||
Case 1
|
||
unrl = rle.Unrle2(nx.Bytes).ToArray 'Image
|
||
Case Else
|
||
unrl = rle.Unrle(nx.Bytes).ToArray 'data
|
||
End Select
|
||
|
||
If nx.w = 16 Or Force4bit.Checked Then
|
||
For x = 0 To 15
|
||
a.Add(GetColFrom1555(unrl, CLUTid.Value * 32 + x * 2))
|
||
Next
|
||
End If
|
||
If nx.w = 256 Then
|
||
For x = 0 To 255
|
||
'a.Add(GetColFrom1555(nx.Bytes, 16 + CLUTid.Value * 256 + x * 2))
|
||
a.Add(GetColFrom1555(unrl, x * 2))
|
||
Next
|
||
End If
|
||
Return a
|
||
End Function
|
||
Private Sub PngExport_Click(sender As Object, e As EventArgs) Handles PngExport.Click
|
||
Dim png = New pngImage
|
||
Dim fil As List(Of Byte)
|
||
If SelBinFiles.SelectedIndex < SelBinFiles.Items.Count - 1 Then
|
||
Dim nx = binFile(SelBinFiles.SelectedIndex + 1)
|
||
If LowerCLUT.Checked Then nx = binFile(SelBinFiles.SelectedIndex + 2)
|
||
If UpperCLUT.Checked Then nx = binFile(SelBinFiles.SelectedIndex - 1)
|
||
|
||
fil = png.NewPng(binFile(SelBinFiles.SelectedIndex), nx)
|
||
Else
|
||
fil = png.NewPng(binFile(SelBinFiles.SelectedIndex), Nothing)
|
||
End If
|
||
|
||
Dim r As rleFile = binFile(SelBinFiles.SelectedIndex)
|
||
If CreateBinDirCheck.Checked And CDFileList.SelectedIndex > -1 Then
|
||
Dim cat = WorkDir.Text & Strings.Left(FilnamLabel.Text, 4) & "_" & files1(CDFileList.SelectedIndex).Descript
|
||
If Not Directory.Exists(cat) Then
|
||
Directory.CreateDirectory(cat)
|
||
End If
|
||
ExportBinPath.Text = cat & "\"
|
||
End If
|
||
Dim filename = ExportBinPath.Text & Strings.Left(FilnamLabel.Text, 4) & "_" & SelBinFiles.SelectedIndex.ToString("D2") & "_" & r.SectorID & "_" & r.ID & "_clut" & CLUTid.Value
|
||
If japRadio.Checked Then filename &= "_J"
|
||
If EngRadio.Checked Then filename &= "_E"
|
||
If UserRadio.Checked Then filename &= "_U"
|
||
If Not ExportRLEDec.Checked Then filename &= "_RAW"
|
||
filename &= ".png"
|
||
My.Computer.FileSystem.WriteAllBytes(filename, fil.ToArray, False)
|
||
Savedlbl.Text = "png SAVED TO " & filename
|
||
|
||
End Sub
|
||
|
||
|
||
Public Function GetColFrom1555(ByRef bytes As Byte(), ByVal ind As Integer)
|
||
If ind > UBound(bytes) - 1 Then Return Color.Black
|
||
Dim col As Int16 = BitConverter.ToInt16(bytes, ind)
|
||
Dim a = col And &H8000 >> 15, b = ((col And &H7C00) >> 10) * 8, g = ((col And &H3E0) >> 5) * 8, r = (col And &H1F) * 8
|
||
'Dim rgb = (r << 9) Or (g << 6) Or (b << 3)
|
||
If a <> 0 And r = 0 And g = 0 And b = 0 Then Return Color.FromArgb(0, 0, 0, 0)
|
||
Return Color.FromArgb(255, r, g, b)
|
||
|
||
|
||
End Function
|
||
|
||
Private Sub Form1_KeyDown(sender As Object, e As KeyEventArgs) Handles Me.KeyDown, SelBinFiles.KeyDown, CDFileList.KeyDown
|
||
If e.KeyCode = Keys.E Then
|
||
If SelBinFiles.SelectedIndex = -1 Then
|
||
If CDFileList.SelectedIndex = -1 Then Exit Sub
|
||
Dim a = New ISOTools
|
||
Dim fil = a.getCDfile(getFilnam, files1(CDFileList.SelectedIndex).Sector, files1(CDFileList.SelectedIndex).Sizw)
|
||
Dim filename = ExportBinPath.Text & CDFileList.SelectedIndex.ToString("D4") & ".bin"
|
||
My.Computer.FileSystem.WriteAllBytes(filename, fil.ToArray, False)
|
||
Savedlbl.Text = "SAVED TO " & filename
|
||
Else
|
||
ExportUnrleFile.PerformClick()
|
||
End If
|
||
End If
|
||
End Sub
|
||
|
||
|
||
Private Sub ExportUnrleFile_Click(sender As Object, e As EventArgs) Handles ExportUnrleFile.Click
|
||
|
||
|
||
If SelBinFiles.SelectedIndex = -1 Then Exit Sub
|
||
Dim filename As String
|
||
Dim unrl As List(Of Byte)
|
||
Dim r As rleFile = binFile(SelBinFiles.SelectedIndex)
|
||
|
||
If ExportRLEDec.Checked Then
|
||
Dim rle = New rleTools
|
||
|
||
filename = ExportBinPath.Text & FilnamLabel.Text & "_" & r.SectorID & "_" & r.ID
|
||
|
||
Select Case r.Compr
|
||
Case 0
|
||
unrl = rle.UnrleNocompr(r.Bytes)
|
||
Case 1
|
||
unrl = rle.Unrle2(r.Bytes) 'Image
|
||
Case 2
|
||
unrl = rle.Unrle(r.Bytes) 'data
|
||
End Select
|
||
|
||
|
||
Else
|
||
|
||
filename = ExportBinPath.Text & FilnamLabel.Text & "_" & r.SectorID & "_" & r.ID
|
||
unrl = r.Bytes.ToList
|
||
End If
|
||
|
||
If CDFileList.Items.Count > 0 Then
|
||
If CreateBinDirCheck.Checked And CDFileList.SelectedIndex > -1 Then
|
||
Dim cat = WorkDir.Text & Strings.Left(FilnamLabel.Text, 4) & "_" & Replace(files1(CDFileList.SelectedIndex).Descript, ".", "") & If(CDExtraBtn.Checked, "_CDEXTRA", "")
|
||
|
||
If Not Directory.Exists(cat) Then
|
||
Directory.CreateDirectory(cat)
|
||
|
||
End If
|
||
ExportBinPath.Text = cat & "\"
|
||
End If
|
||
|
||
|
||
|
||
filename = ExportBinPath.Text & Strings.Left(FilnamLabel.Text, 4) & "_" & SelBinFiles.SelectedIndex.ToString("D2") & "_" & r.SectorID & "_" & r.ID
|
||
|
||
If japRadio.Checked Then filename &= "_J"
|
||
If EngRadio.Checked Or KudosBtn.Checked Then filename &= "_E"
|
||
If UserRadio.Checked Then filename &= "_U"
|
||
If CDExtraBtn.Checked Then filename &= "_CDEXTRA"
|
||
End If
|
||
|
||
If Not ExportRLEDec.Checked Then filename &= "_RAW"
|
||
|
||
My.Computer.FileSystem.WriteAllBytes(filename, unrl.ToArray, False)
|
||
Savedlbl.Text = "SAVED TO " & filename
|
||
|
||
End Sub
|
||
|
||
Private Sub ReadCDFileTable_Click(sender As Object, e As EventArgs) Handles ReadCDFileTable.Click
|
||
|
||
Dim cd = New ISOTools
|
||
|
||
Dim filnam = getFilnam()
|
||
|
||
CDFileList.Items.Clear()
|
||
If Not File.Exists(filnam) Then MsgBox("File not found! Please select proper BIN file and check path!", MsgBoxStyle.Critical) : Exit Sub
|
||
If FileLen(filnam) < 621900000 Then MsgBox("File is not proper PERSONA2 EP bin image! Check it!", MsgBoxStyle.Critical) : Exit Sub
|
||
|
||
'Reading Files Descriptions
|
||
|
||
|
||
If CDExtraBtn.Checked Then
|
||
ExpMainExe.Text = "Export SLPS_028.26"
|
||
Else
|
||
ExpMainExe.Text = "Export SLPS_028.25"
|
||
End If
|
||
Dim descipts = Split(My.Computer.FileSystem.ReadAllText("FileDesc.txt", Encoding.GetEncoding(1251)), vbCrLf)
|
||
|
||
|
||
|
||
|
||
'Reading filetable and make array
|
||
files1 = cd.makeFileList(filnam)
|
||
|
||
For Each f In files1
|
||
|
||
Dim curInd = files1.IndexOf(f)
|
||
If curInd < descipts.Count Then f.Descript = descipts(curInd)
|
||
|
||
|
||
CDFileList.Items.Add(curInd.ToString("D4") & " " & String.Format("{0,-9}", f.Descript) & " Sec: " & f.Sector & " Size: " & f.Sizw & "b.")
|
||
|
||
Next
|
||
|
||
Dim ls As fileInfo = GetLastSector()
|
||
|
||
Dim freespace = FileLen(filnam) - (ls.Sector * &H930 + ls.Sizw)
|
||
|
||
LastSectorLbl.Text = "Last Sector: " & ls.Sector + ls.Sizw / 2048
|
||
|
||
CDFreeSpaceLabel.Text = Math.Round(freespace / 1024) & " Kbytes / " & Math.Round(freespace / &H930) & " sectors"
|
||
|
||
End Sub
|
||
|
||
Private Sub CDFileList_SelectedIndexChanged(sender As Object, e As EventArgs) Handles CDFileList.SelectedIndexChanged
|
||
|
||
If CDFileList.SelectedIndex = -1 Then Exit Sub
|
||
|
||
Dim filnam = getFilnam()
|
||
|
||
'Exit Sub
|
||
|
||
FilnamLabel.Text = CDFileList.SelectedItem.ToString
|
||
|
||
FileDescr.Text = files1(CDFileList.SelectedIndex).Descript
|
||
|
||
Dim a = New ISOTools
|
||
Dim fil = a.getCDfile(filnam, files1(CDFileList.SelectedIndex).Sector, files1(CDFileList.SelectedIndex).Sizw)
|
||
importSector.Text = files1(CDFileList.SelectedIndex).Sector
|
||
' Exit Sub
|
||
|
||
DeconstructFile(fil.ToArray)
|
||
ShowFileSectors(binFile)
|
||
End Sub
|
||
|
||
Private Sub FileDescr_TextChanged(sender As Object, e As EventArgs) Handles FileDescr.TextChanged
|
||
|
||
Dim curInd = CDFileList.SelectedIndex
|
||
|
||
If curInd = -1 Then Exit Sub
|
||
|
||
Dim f = files1(curInd)
|
||
f.Descript = FileDescr.Text
|
||
|
||
CDFileList.Items(curInd) = curInd.ToString("D4") & " " & String.Format("{0,-9}", f.Descript) & " Sec: " & f.Sector & " Size: " & f.Sizw & "b."
|
||
|
||
Dim txt = ""
|
||
|
||
For Each ee In files1
|
||
txt &= ee.Descript & vbCrLf
|
||
Next
|
||
|
||
My.Computer.FileSystem.WriteAllText("FileDesc.txt", txt, False)
|
||
|
||
|
||
End Sub
|
||
|
||
|
||
|
||
Public Function getFilnam()
|
||
Dim filnam = ""
|
||
|
||
If japRadio.Checked Then
|
||
filnam = JapISOPath.Text
|
||
ElseIf EngRadio.Checked Then
|
||
filnam = EngISOPath.Text
|
||
ElseIf UserRadio.Checked Then
|
||
filnam = UserPath.Text
|
||
ElseIf KUDOSbtn.Checked Then
|
||
filnam = KUDOSpath.Text
|
||
ElseIf CDExtraBtn.Checked Then
|
||
filnam = CDEXTRApath.Text
|
||
End If
|
||
Return filnam
|
||
End Function
|
||
Private Sub exportBinfiletoBIN_Click(sender As Object, e As EventArgs) Handles exportBinfiletoBIN.Click
|
||
If CDFileList.SelectedIndex = -1 Then Exit Sub
|
||
|
||
Dim a = New ISOTools
|
||
Dim fil = a.getCDfile(getFilnam, files1(CDFileList.SelectedIndex).Sector, files1(CDFileList.SelectedIndex).Sizw)
|
||
|
||
If SaveFileDialog1.ShowDialog <> DialogResult.OK Then Exit Sub
|
||
|
||
My.Computer.FileSystem.WriteAllBytes(SaveFileDialog1.FileName, fil.ToArray, False)
|
||
|
||
End Sub
|
||
|
||
|
||
|
||
|
||
|
||
Private Sub EngRadio_CheckedChanged(sender As Object, e As EventArgs) Handles EngRadio.CheckedChanged, japRadio.CheckedChanged, UserRadio.CheckedChanged, KudosBtn.CheckedChanged
|
||
CDFileList.Items.Clear()
|
||
SelBinFiles.Items.Clear()
|
||
|
||
End Sub
|
||
|
||
Private Sub ReadFontWide1_Click(sender As Object, e As EventArgs) Handles ReadFontWide1.Click
|
||
PatchBytes(FontWide1, 111972, False)
|
||
|
||
End Sub
|
||
|
||
Private Sub WriteFontWide3_Click(sender As Object, e As EventArgs) Handles WriteFontWide1.Click
|
||
PatchBytes(FontWide1, 111972, True)
|
||
End Sub
|
||
|
||
Private Sub ReadFontWide22_Click(sender As Object, e As EventArgs) Handles coordMultiAsmRd.Click
|
||
PatchBytes(TextCharSpacer, 119472, False)
|
||
|
||
End Sub
|
||
|
||
Private Sub WriteFontWide2_Click(sender As Object, e As EventArgs) Handles coordMultiAsmWr.Click
|
||
PatchBytes(TextCharSpacer, 119472, True)
|
||
End Sub
|
||
|
||
|
||
Private Sub ReadFontWide33_Click(sender As Object, e As EventArgs) Handles DialLeftSpaceRd.Click
|
||
PatchBytes(DialLeftSpaceText, 571965, False)
|
||
|
||
End Sub
|
||
|
||
Private Sub WriteFontWide1_Click(sender As Object, e As EventArgs) Handles DialLeftSpaceWr.Click
|
||
PatchBytes(DialLeftSpaceText, 571965, True)
|
||
End Sub
|
||
|
||
|
||
Private Sub PatchBytes(ByRef textbox As TextBox, ByVal address As Integer, ByVal Write As Boolean)
|
||
|
||
'this is for mainCodePatches
|
||
|
||
|
||
If Not File.Exists(UserPath.Text) Then MsgBox("USER BIN NOT FOUND!", MsgBoxStyle.Critical) : Exit Sub
|
||
If Write Then
|
||
If Not IsNumeric(textbox.Text) Then MsgBox("Not Numeric textBox!", MsgBoxStyle.Critical) : Exit Sub
|
||
End If
|
||
|
||
|
||
|
||
|
||
If Not Write Then
|
||
|
||
Dim fs As New FileStream(UserPath.Text, FileMode.Open, FileAccess.Read)
|
||
Dim br As New BinaryReader(fs)
|
||
|
||
br.BaseStream.Position = address
|
||
|
||
textbox.Text = br.ReadBytes(1)(0)
|
||
|
||
br.Dispose()
|
||
fs.Dispose()
|
||
|
||
Else
|
||
|
||
|
||
Dim fs As New FileStream(UserPath.Text, FileMode.Open, FileAccess.Write)
|
||
Dim bw As New BinaryWriter(fs)
|
||
|
||
bw.BaseStream.Position = address
|
||
Dim b() = {Convert.ToByte(textbox.Text)}
|
||
bw.Write(b, 0, 1)
|
||
|
||
bw.Dispose()
|
||
fs.Dispose()
|
||
|
||
End If
|
||
|
||
|
||
End Sub
|
||
|
||
Private Sub PatchCytyTextCoords_Click(sender As Object, e As EventArgs) Handles PatchCytyTextCoords.Click
|
||
|
||
'IN 1119 - 800AD320 (offs 8992) - need to 0,0,0,0 (its shift left 0x1) x3 instead x6 - Text and rect coord
|
||
'800AD328 need to 64 instead 128 (text pixels wide x2 instead x4) - rect X WIDE
|
||
'800AD360 (offs 9056)- need 5 instead 6 - pixels for X-offset text from start of rect
|
||
|
||
Dim ofs = New List(Of Integer)
|
||
Dim bts = New List(Of Byte)
|
||
ofs.AddRange({8992, 8993, 8994, 8995, 9000, 9056})
|
||
bts.AddRange({0, 0, 0, 0, 64, 5})
|
||
|
||
PatchFile(ofs, bts, files1(1119).Sector, files1(1119).Sizw)
|
||
|
||
End Sub
|
||
|
||
'Patching List of bytes :)
|
||
|
||
Private Sub PatchFile(ByVal offsets As List(Of Integer), ByRef bytes As List(Of Byte), ByVal Sector As Integer, ByVal Sizw As Integer)
|
||
Dim a = New ISOTools
|
||
Dim fil = a.getCDfile(getFilnam, Sector, Sizw)
|
||
For z = 0 To offsets.Count - 1
|
||
fil(offsets(z)) = bytes(z)
|
||
Next
|
||
a.saveCDfile(getFilnam, Sector, Sizw, fil.ToArray)
|
||
MsgBox("Patched! " & bytes.Count & " bytes!")
|
||
End Sub
|
||
|
||
|
||
Private Sub tstBtn_Click(sender As Object, e As EventArgs) Handles tstBtn.Click
|
||
For a = 100 To 0 Step -1
|
||
|
||
Debug.WriteLine(a)
|
||
|
||
Next
|
||
End Sub
|
||
|
||
Private Sub RawToSectorImport_Click(sender As Object, e As EventArgs) Handles RawToSectorImport.Click
|
||
If Not IsNumeric(RawSectorImport.Text) Then MsgBox("Enter sector count")
|
||
|
||
If CDFileList.SelectedIndex = -1 Then Exit Sub
|
||
If Not UserRadio.Checked Then MsgBox("YOU CAN REALLOCATE ONLY USER ISO!!!") : Exit Sub
|
||
|
||
|
||
Dim cd = New ISOTools
|
||
|
||
cd.ReallocateDown(UserPath.Text, files1, CDFileList.SelectedIndex + 1, RawSectorImport.Text)
|
||
|
||
MsgBox("REALLOCATE COMPLETE 8-O SUCCESSFULLY")
|
||
|
||
End Sub
|
||
|
||
|
||
|
||
|
||
|
||
Private Sub ImportTXT_Click(sender As Object, e As EventArgs) Handles ImportTXT.Click
|
||
|
||
DialogCounter = 0
|
||
Dim LineCounter = 0
|
||
|
||
OpenFileDialog1.Multiselect = True
|
||
If OpenFileDialog1.ShowDialog <> DialogResult.OK Then Exit Sub
|
||
Dim txt = New ScriptTools
|
||
OpenFileDialog1.Multiselect = False
|
||
|
||
For Each JFile In OpenFileDialog1.FileNames
|
||
Debug.WriteLine("Converting " & JFile)
|
||
txt.importTextFile(JFile, DialogCounter, LineCounter)
|
||
Next
|
||
|
||
MsgBox("Success! Converted " & UBound(OpenFileDialog1.FileNames) + 1 & " file(s)" & vbCrLf & "Overall Dialogs Count: " & DialogCounter &
|
||
vbCrLf & "Overall Lines Count: " & LineCounter)
|
||
|
||
End Sub
|
||
|
||
|
||
Private Sub ConvertContactScript_Click(sender As Object, e As EventArgs) Handles ConvertContactScript.Click
|
||
|
||
DialogCounter = 0
|
||
Dim LineCounter = 0
|
||
|
||
OpenFileDialog1.Multiselect = True
|
||
If OpenFileDialog1.ShowDialog <> DialogResult.OK Then Exit Sub
|
||
Dim txt = New ScriptTools
|
||
OpenFileDialog1.Multiselect = False
|
||
|
||
For Each JFile In OpenFileDialog1.FileNames
|
||
Debug.WriteLine("Converting " & JFile)
|
||
txt.importContactFile(JFile, DialogCounter, LineCounter)
|
||
Next
|
||
|
||
MsgBox("Success! Converted " & UBound(OpenFileDialog1.FileNames) + 1 & " file(s)" & vbCrLf & "Overall Dialogs Count: " & DialogCounter &
|
||
vbCrLf & "Overall Lines Count: " & LineCounter)
|
||
|
||
|
||
End Sub
|
||
|
||
|
||
|
||
Private Sub SelExportCript_Click(sender As Object, e As EventArgs) Handles SelExportCript.Click
|
||
OpenFileDialog1.Multiselect = True
|
||
If OpenFileDialog1.ShowDialog <> DialogResult.OK Then Exit Sub
|
||
OpenFileDialog1.Multiselect = False
|
||
Dim s = New ScriptTools
|
||
|
||
For Each JFile In OpenFileDialog1.FileNames
|
||
'Dim fileNamArr = Split(Path.GetFileName(JFile), "_")
|
||
Dim Efile = JFile.Substring(0, JFile.Length - 1) & "E"
|
||
If UnKudosScript.Checked Then Efile = JFile.Substring(0, JFile.Length - 1) & "K"
|
||
s.ExportTextFile(JFile, Efile)
|
||
Next
|
||
|
||
MsgBox(String.Format("Success! Exported {0} file(s)", UBound(OpenFileDialog1.FileNames) + 1))
|
||
End Sub
|
||
|
||
|
||
|
||
|
||
Private Sub TextBox5_TextChanged(sender As Object, e As EventArgs) Handles TextBox5.TextChanged
|
||
|
||
Dim text = New FontTools
|
||
Dim Colors = New List(Of Color)
|
||
Dim curColor As Integer = 1
|
||
text.GetColors() 'init colors array
|
||
|
||
|
||
drawSurface = New Bitmap(PictureBox1.ClientSize.Width, PictureBox1.ClientSize.Height)
|
||
|
||
'PictureBox1.BackColor = Color.DarkBlue
|
||
PictureBox1.BackColor = Color.White
|
||
PictureBox1.Image = drawSurface
|
||
|
||
|
||
'TextBox5.Text =
|
||
Dim srcTxt1 = TextBox5.Text.Replace(" ", "")
|
||
|
||
srcTxt1 = Replace(srcTxt1, Chr(9), "2011")
|
||
|
||
newtest:
|
||
If IsNothing(srcTxt1) Then Exit Sub
|
||
|
||
'Need To delete Skobki
|
||
For a = 0 To srcTxt1.Length - 1
|
||
Dim sss = srcTxt1(a)
|
||
' If sss = Chr(9) Then srcTxt1.Remove(a, 1) : GoTo newtest
|
||
If sss = "[" Then
|
||
Dim code = srcTxt1.Substring(a + 1, 4)
|
||
If code = "0111" Or code = "0311" Then
|
||
srcTxt1 = srcTxt1.Insert(a, vbCrLf)
|
||
a = a + 2
|
||
End If
|
||
deleteSkobki(srcTxt1, a)
|
||
GoTo newtest
|
||
End If
|
||
|
||
|
||
Next
|
||
|
||
Dim srcTxt2() = Split(srcTxt1, vbCrLf)
|
||
|
||
|
||
Dim y = 0
|
||
|
||
For Each line In srcTxt2
|
||
If line.Length Mod 4 > 0 Then Exit Sub
|
||
|
||
'Try
|
||
Dim bytes() = SoapHexBinary.Parse(line).Value
|
||
If bytes.Length = 0 Then Exit Sub
|
||
|
||
text.DrawChars(bytes.ToList, drawSurface, y, curColor)
|
||
'Catch ex As Exception
|
||
'MsgBox("Error in codes!")
|
||
'End Try
|
||
|
||
|
||
y += 15
|
||
Next
|
||
|
||
End Sub
|
||
|
||
Public Sub deleteSkobki(ByRef str As String, ByRef ind As Integer)
|
||
|
||
'searching end of skobki
|
||
For a = 0 To str.Length - 1
|
||
If str(a + ind) = "]" Then str = str.Remove(ind, a + 1) : Exit Sub
|
||
Next
|
||
|
||
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
|
||
Next
|
||
Return -1
|
||
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
|
||
|
||
Dim searchBytes = SoapHexBinary.Parse(HexPatternBox.Text).Value
|
||
|
||
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)
|
||
|
||
'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)
|
||
Next
|
||
|
||
If searchRes.Count Then
|
||
MsgBox("FOUND: " & vbCrLf & (Join(searchRes.ToArray, vbCrLf)))
|
||
Else
|
||
MsgBox("NOT FOUND")
|
||
End If
|
||
|
||
'5374617475733A2048756D616E
|
||
|
||
End Sub
|
||
|
||
Private Sub SaveShadowDisc_Click(sender As Object, e As EventArgs) Handles SaveShadowDisc.Click
|
||
Dim cd = New ISOTools
|
||
|
||
'My.Computer.FileSystem.WriteAllBytes(WorkDir.Text & "SHADOW.BIN", cd.getCDfile(UserPath.Text, 278075, 35000000).ToArray, False)
|
||
Dim f() = My.Computer.FileSystem.ReadAllBytes(WorkDir.Text & "SHADOW.BIN")
|
||
cd.saveCDfile(UserPath.Text, 278075, 35000000, f)
|
||
|
||
|
||
End Sub
|
||
|
||
Private Sub importToBin_Click(sender As Object, e As EventArgs) Handles importToBin.Click
|
||
|
||
|
||
If Not UserRadio.Checked And Not CDExtraBtn.Checked Then MsgBox("YOU CAN IMPORT ONLY IN USER OR CDEXTRA ISO!!!") : Exit Sub
|
||
|
||
'OpensFile
|
||
|
||
OpenFileDialog1.Multiselect = True
|
||
If OpenFileDialog1.ShowDialog <> DialogResult.OK Then Exit Sub
|
||
OpenFileDialog1.Multiselect = False
|
||
|
||
|
||
'Dim fil = My.Computer.FileSystem.ReadAllBytes(OpenFileDialog1.FileName)
|
||
|
||
|
||
Dim s = New ScriptTools
|
||
Dim endfil = New List(Of Byte)
|
||
|
||
For Each filee In OpenFileDialog1.FileNames
|
||
|
||
|
||
'///////////////////MULTIFILES LOOP START
|
||
'////////////FOR EACH FILE
|
||
|
||
|
||
Dim fileInfo = Split(Path.GetFileNameWithoutExtension(filee), "_")
|
||
Dim curFilePack As Integer = fileInfo(0)
|
||
Dim curFileIndexInPack As Integer = fileInfo(1)
|
||
Dim curFileSector As Integer = fileInfo(2)
|
||
Dim curFileRleID As Integer = fileInfo(3)
|
||
Debug.WriteLine("Importing... " & Path.GetFileNameWithoutExtension(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
|
||
Dim fil = My.Computer.FileSystem.ReadAllBytes(filee)
|
||
|
||
|
||
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
|
||
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)
|
||
rleEnd:
|
||
|
||
'adding bytes to read MOD4
|
||
Dim addedBytes = endfil.Count Mod 4
|
||
If addedBytes > 0 Then addedBytes = 4 - addedBytes
|
||
For a = 0 To addedBytes - 1
|
||
endfil.Add(0)
|
||
Next
|
||
|
||
Else
|
||
Dim r = New rleTools
|
||
|
||
|
||
endfil = r.decodeRLEnew(fil, curfile)
|
||
|
||
|
||
End If
|
||
|
||
|
||
Else
|
||
endfil = fil.ToList
|
||
End If
|
||
|
||
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
|
||
|
||
binFile(curFileIndexInPack).BytesAfter = 0
|
||
|
||
|
||
Next
|
||
'///////////////////MULTIFILES LOOP END
|
||
|
||
|
||
|
||
|
||
|
||
'АРХИВИРУЕМ МАССИВ ФАЙЛОВ ДЛЯ ЗАПИСИ В ОДИН ФАЙЛ
|
||
Dim lastSectorID As Integer = 0
|
||
Dim finalPack = New List(Of Byte)
|
||
Dim addresses = New List(Of Integer) 'Start Addr for all files
|
||
|
||
For Each bin In binFile
|
||
|
||
If Not IgnoreGaps.Checked Then
|
||
'filling sector to end (making sectorgap) in the middle of the file
|
||
If bin.SectorID <> lastSectorID Then
|
||
Dim gap = 2048 - (finalPack.Count Mod 2048)
|
||
For g = 0 To gap - 1
|
||
finalPack.Add(0)
|
||
Next
|
||
End If
|
||
End If
|
||
|
||
'Adding currentfile Sector Size (for at least 0004)
|
||
bin.SectorSize = bin.Bytes.Count \ 2048
|
||
If bin.Bytes.Count Mod 2048 > 0 Then bin.SectorSize += 1
|
||
|
||
|
||
'adding currentfile and address for filetables
|
||
addresses.Add(finalPack.Count)
|
||
finalPack.AddRange(bin.Bytes)
|
||
|
||
'AddingBytesAfter
|
||
For g = 0 To bin.BytesAfter - 1
|
||
finalPack.Add(0)
|
||
Next
|
||
|
||
|
||
If CDFileList.SelectedIndex = 735 Or CDFileList.SelectedIndex = 90 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
|
||
For g = 1 To ffff
|
||
finalPack.Add(0)
|
||
Next
|
||
End If
|
||
End If
|
||
|
||
|
||
lastSectorID = bin.SectorID
|
||
Next
|
||
|
||
Dim finalPackClean As Integer = finalPack.Count
|
||
|
||
'Fill file to END of Sector
|
||
|
||
If finalPack.Count Mod 2048 > 0 Then
|
||
For g = 1 To (2048 - (finalPack.Count Mod 2048))
|
||
finalPack.Add(0)
|
||
Next g
|
||
End If
|
||
|
||
'checking filesize if inserting into ORIGINAL place
|
||
If Not TestImportSize(finalPack, finalPackClean) Then Exit Sub
|
||
|
||
|
||
'UPDATE INSIDE ARCHIVES POINTERS
|
||
Select Case CDFileList.SelectedIndex
|
||
|
||
|
||
'EP pointers
|
||
|
||
Case 735
|
||
'Updating fileTable in externalCode for DUNGEON DIALOGS in 0736
|
||
MakePointersTable(addresses, files1(736).Sector, files1(736).Sizw, 110548)
|
||
|
||
|
||
|
||
'IS old pointers
|
||
'Case 4
|
||
' 'Updating fileTable in BattleCode for DIALOGS in 0004
|
||
' 'If binFile.Count <> 153 Then MsgBox("WRONG0004 FILE!!! (files count not 152)") : Exit Sub
|
||
' Update0004ScriptTable()
|
||
|
||
'Case 77
|
||
' If binFile.Count <> 150 Then MsgBox("WRONG 0077 FILE!!! (files count not 150)") : Exit Sub
|
||
' 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
|
||
|
||
|
||
|
||
|
||
|
||
'SaveFile To Sector
|
||
Dim cd = New ISOTools
|
||
|
||
|
||
|
||
Dim f = getFilnam()
|
||
|
||
'My.Computer.FileSystem.WriteAllBytes(savFile, finalPack.ToArray, False)
|
||
cd.saveCDfile(f, importSector.Text, finalPack.Count, finalPack.ToArray)
|
||
|
||
|
||
|
||
|
||
'Update SectorNumber and FileSize In FileArray
|
||
files1(CDFileList.SelectedIndex).Sizw = finalPack.Count
|
||
files1(CDFileList.SelectedIndex).Sector = importSector.Text
|
||
|
||
'Update FileTable In ISO
|
||
cd.UpdateFileListTable(f, files1)
|
||
|
||
|
||
|
||
|
||
|
||
'Done
|
||
MsgBox(String.Format("Imported {0} files in {1} - {2} bytes", UBound(OpenFileDialog1.FileNames) + 1, CDFileList.SelectedIndex, finalPack.Count), MsgBoxStyle.Exclamation)
|
||
End Sub
|
||
|
||
Public Sub UpdateBattleContactFileTable(ByRef addr As List(Of Integer))
|
||
|
||
Dim cd = New ISOTools
|
||
Dim fTable = cd.getCDfile(UserPath.Text, files1(1).Sector, files1(1).Sizw)
|
||
Dim TableOffset = 403232
|
||
|
||
For a = 0 To addr.Count - 1
|
||
Dim curAddr = a * 8 + TableOffset - 8
|
||
|
||
Dim cursect As Int16 = addr(a) \ 2048
|
||
Dim modSect As Int16 = addr(a) Mod 2048
|
||
|
||
If a = 0 Then
|
||
fTable(curAddr + 8) = addr(2) \ 2048 'First 2 files
|
||
fTable(curAddr + 8) = 0
|
||
a += 1
|
||
Continue For
|
||
Else
|
||
|
||
fTable(curAddr) = BitConverter.GetBytes(modSect)(0)
|
||
fTable(curAddr + 1) = BitConverter.GetBytes(modSect)(1) 'BE or LE???
|
||
fTable(curAddr + 2) = BitConverter.GetBytes(cursect)(0)
|
||
fTable(curAddr + 3) = BitConverter.GetBytes(cursect)(1) 'BE or LE???
|
||
|
||
Dim sz = binFile(a).Bytes.Count \ 2048 + 3
|
||
|
||
'If binFile(a).Bytes.Count Mod 2048 > 0 Then sz += 1
|
||
|
||
fTable(curAddr + 4) = sz 'Another Files
|
||
fTable(curAddr + 5) = 0
|
||
|
||
End If
|
||
Next
|
||
|
||
cd.saveCDfile(UserPath.Text, files1(1).Sector, files1(1).Sizw, fTable.ToArray)
|
||
|
||
End Sub
|
||
|
||
Public Sub Update0004ScriptTable()
|
||
|
||
Dim cd = New ISOTools
|
||
|
||
Dim fTable = cd.getCDfile(UserPath.Text, files1(1).Sector, files1(1).Sizw)
|
||
Dim lastSize = 0
|
||
For a = 0 To 50
|
||
Dim curAddr = a * 8 + 396444
|
||
Dim curBlockSects As Integer = binFile(a * 3).SectorSize + binFile(a * 3 + 1).SectorSize + binFile(a * 3 + 2).SectorSize
|
||
|
||
fTable(curAddr) = 0
|
||
fTable(curAddr + 1) = 0
|
||
fTable(curAddr + 2) = BitConverter.GetBytes(lastSize)(0)
|
||
fTable(curAddr + 3) = BitConverter.GetBytes(lastSize)(1)
|
||
fTable(curAddr + 4) = BitConverter.GetBytes(curBlockSects)(0)
|
||
fTable(curAddr + 5) = BitConverter.GetBytes(curBlockSects)(1)
|
||
fTable(curAddr + 6) = 3
|
||
fTable(curAddr + 7) = 0
|
||
|
||
lastSize += curBlockSects
|
||
|
||
Next
|
||
|
||
cd.saveCDfile(UserPath.Text, files1(1).Sector, files1(1).Sizw, fTable.ToArray)
|
||
|
||
End Sub
|
||
|
||
Public Sub Update0073SummonScriptTable(ByRef addr As List(Of Integer))
|
||
|
||
Dim cd = New ISOTools
|
||
|
||
Dim fTable = cd.getCDfile(UserPath.Text, files1(73).Sector, files1(73).Sizw)
|
||
Dim fTable2 = cd.getCDfile(UserPath.Text, files1(74).Sector, files1(74).Sizw)
|
||
|
||
Dim lastSize = 0
|
||
For a = 0 To 149
|
||
Dim curAddr = a * 8 + 16324
|
||
Dim curAddr2 = a * 8 + 15120
|
||
|
||
Dim cursect As Int16 = addr(a) \ 2048
|
||
Dim modSect As Int16 = addr(a) Mod 2048
|
||
|
||
fTable(curAddr) = BitConverter.GetBytes(modSect)(0)
|
||
fTable(curAddr + 1) = BitConverter.GetBytes(modSect)(1) 'BE or LE???
|
||
fTable(curAddr + 2) = BitConverter.GetBytes(cursect)(0)
|
||
fTable(curAddr + 3) = BitConverter.GetBytes(cursect)(1) 'BE or LE???
|
||
fTable2(curAddr2) = BitConverter.GetBytes(modSect)(0)
|
||
fTable2(curAddr2 + 1) = BitConverter.GetBytes(modSect)(1) 'BE or LE???
|
||
fTable2(curAddr2 + 2) = BitConverter.GetBytes(cursect)(0)
|
||
fTable2(curAddr2 + 3) = BitConverter.GetBytes(cursect)(1) 'BE or LE???
|
||
|
||
Dim sectorsToRead = 1
|
||
If modSect + binFile(a).Size > 2048 Then sectorsToRead = 2
|
||
fTable(curAddr + 4) = sectorsToRead
|
||
fTable(curAddr + 5) = 0
|
||
fTable(curAddr + 6) = 1
|
||
fTable(curAddr + 7) = 0
|
||
fTable2(curAddr2 + 4) = sectorsToRead
|
||
fTable2(curAddr2 + 5) = 0
|
||
fTable2(curAddr2 + 6) = 1
|
||
fTable2(curAddr2 + 7) = 0
|
||
|
||
|
||
Next
|
||
|
||
cd.saveCDfile(UserPath.Text, files1(73).Sector, files1(73).Sizw, fTable.ToArray)
|
||
cd.saveCDfile(UserPath.Text, files1(74).Sector, files1(74).Sizw, fTable2.ToArray)
|
||
|
||
End Sub
|
||
|
||
|
||
|
||
|
||
'Start with 104592 for 0090 in 0092 - 160files * 8bytes
|
||
'PointersTableFor BigFileLoad
|
||
'00 00 - Sector Addr
|
||
'00 00 - Sectors from filestart
|
||
'00 00 00 00
|
||
|
||
|
||
Public Sub MakePointersTable(ByRef addr As List(Of Integer), ByVal Sector As Integer, ByVal Sizw As Integer, ByVal offset As Integer)
|
||
|
||
Dim cd = New ISOTools
|
||
|
||
Dim fTable = cd.getCDfile(UserPath.Text, Sector, Sizw)
|
||
|
||
For a = 0 To binFile.Count - 1
|
||
Dim curAddr = a * 8 + offset
|
||
|
||
Dim cursect As Int16 = addr(a) \ 2048
|
||
Dim modSect As Int16 = addr(a) Mod 2048
|
||
|
||
|
||
fTable(curAddr) = BitConverter.GetBytes(modSect)(0)
|
||
fTable(curAddr + 1) = BitConverter.GetBytes(modSect)(1) 'BE or LE???
|
||
|
||
fTable(curAddr + 2) = BitConverter.GetBytes(cursect)(0)
|
||
fTable(curAddr + 3) = BitConverter.GetBytes(cursect)(1) 'BE or LE???
|
||
|
||
Dim bts As Integer = binFile(a).Bytes.Count
|
||
If binFile(a).Compr = 0 Then bts -= 8 'Its Uncompressed TIM??
|
||
|
||
|
||
fTable(curAddr + 4) = BitConverter.GetBytes(bts)(0) 'Saving Size of file
|
||
fTable(curAddr + 5) = BitConverter.GetBytes(bts)(1) 'BE or LE???
|
||
|
||
fTable(curAddr + 6) = BitConverter.GetBytes(bts)(2)
|
||
fTable(curAddr + 7) = BitConverter.GetBytes(bts)(3)
|
||
|
||
|
||
|
||
Next
|
||
|
||
cd.saveCDfile(UserPath.Text, Sector, Sizw, fTable.ToArray)
|
||
|
||
End Sub
|
||
|
||
Public Sub SavePointersTableToFile(ByRef addr As List(Of Integer), ByVal Filname As String, ByRef binf As List(Of rleFile))
|
||
|
||
Dim fil = New List(Of Byte)
|
||
|
||
For a = 0 To binFile.Count - 1
|
||
'Dim curAddr = a * 8 + offset
|
||
Dim cursect As Int16 = addr(a) \ 2048
|
||
Dim modSect As Int16 = addr(a) Mod 2048
|
||
fil.Add(BitConverter.GetBytes(modSect)(0))
|
||
fil.Add(BitConverter.GetBytes(modSect)(1)) 'BE or LE???
|
||
|
||
fil.Add(BitConverter.GetBytes(cursect)(0))
|
||
fil.Add(BitConverter.GetBytes(cursect)(1)) 'BE or LE???
|
||
|
||
Dim bts As Integer = binFile(a).Bytes.Count
|
||
'If binFile(a).Compr = 0 Then bts -= 8 'Its Uncompressed TIM??
|
||
|
||
|
||
fil.Add(BitConverter.GetBytes(bts)(0)) 'Saving Size of file
|
||
fil.Add(BitConverter.GetBytes(bts)(1)) 'BE or LE???
|
||
|
||
fil.Add(BitConverter.GetBytes(bts)(2))
|
||
fil.Add(BitConverter.GetBytes(bts)(3))
|
||
|
||
|
||
|
||
Next
|
||
|
||
My.Computer.FileSystem.WriteAllBytes(Filname, fil.ToArray, False)
|
||
|
||
End Sub
|
||
|
||
Public Function TestImportSize(ByRef finalPack As List(Of Byte), ByVal packsize As Integer)
|
||
|
||
Dim filesSorted = New List(Of fileInfo)
|
||
|
||
For Each fl In files1
|
||
filesSorted.Add(fl)
|
||
Next
|
||
|
||
filesSorted.Sort(Function(x, y) x.Sector.CompareTo(y.Sector))
|
||
|
||
|
||
Dim currentIndex = filesSorted.FindIndex(Function(x) x.FileID = CDFileList.SelectedIndex)
|
||
|
||
'checking filesize if inserting into ORIGINAL place
|
||
If importSector.Text < 278000 Then
|
||
|
||
Dim f1s As Integer = finalPack.Count \ 2048 : If finalPack.Count Mod 2048 > 0 Then f1s += 1
|
||
' Dim f2s As Integer = files1(CDFileList.SelectedIndex).Sizw \ 2048 : If files1(CDFileList.SelectedIndex).Sizw Mod 2048 > 0 Then f2s += 1
|
||
Dim CurSect As Integer = importSector.Text
|
||
Dim fNextSect As Integer = filesSorted(currentIndex + 1).Sector
|
||
|
||
If f1s + CurSect > fNextSect Then
|
||
If MsgBox("File is Overriding Next FILE sectors in ISO! " & vbCrLf & f1s & "sects > " & fNextSect - CurSect & " Free sectors" & vbCrLf & "Pack sz diff: " & packsize & " > " & filesSorted(currentIndex).Sizw & vbCrLf & "Want to save to .bin?", MsgBoxStyle.YesNo) = MsgBoxResult.No Then
|
||
Return False
|
||
Else
|
||
If SaveFileDialog1.ShowDialog <> DialogResult.OK Then Return False
|
||
|
||
My.Computer.FileSystem.WriteAllBytes(SaveFileDialog1.FileName, finalPack.ToArray, False)
|
||
Return False
|
||
End If
|
||
End If
|
||
' If f1s > f2s Then MsgBox("File has MORE sectors than in ISO! " & vbCrLf & f1s & "sec > " & f2s & "sec" & vbCrLf & "USE FREE SECTORS!", MsgBoxStyle.Information) : Return False
|
||
|
||
End If
|
||
Return True
|
||
End Function
|
||
|
||
Private Sub importRAWtoSel_Click(sender As Object, e As EventArgs) Handles importRAWtoSel.Click
|
||
If OpenFileDialog1.ShowDialog <> DialogResult.OK Then Exit Sub
|
||
|
||
If Not UserRadio.Checked And Not CDExtraBtn.Checked Then MsgBox("YOU CAN IMPORT ONLY IN USER OR CDEXTRA ISO!!!") : Exit Sub
|
||
|
||
|
||
Dim fil = My.Computer.FileSystem.ReadAllBytes(OpenFileDialog1.FileName).ToList
|
||
|
||
If Not Mode2352.Checked Then
|
||
If fil.Count Mod 2048 > 0 Then
|
||
For g = 1 To (2048 - (fil.Count Mod 2048))
|
||
fil.Add(0)
|
||
Next g
|
||
End If
|
||
|
||
'CheckingSize
|
||
'If Not TestImportSize(fil) Then Exit Sub
|
||
|
||
End If
|
||
|
||
|
||
Dim f = getFilnam()
|
||
|
||
Dim cd = New ISOTools
|
||
cd.saveCDfile(f, importSector.Text, fil.Count, fil.ToArray)
|
||
|
||
If UpdateSizeTable.Checked Then
|
||
files1(CDFileList.SelectedIndex).Sizw = fil.Count
|
||
files1(CDFileList.SelectedIndex).Sector = importSector.Text
|
||
cd.UpdateFileListTable(f, files1)
|
||
End If
|
||
|
||
|
||
MsgBox("RawFileImported :-X")
|
||
|
||
End Sub
|
||
|
||
Private Sub getFreeSector_Click(sender As Object, e As EventArgs) Handles getFreeSector.Click
|
||
|
||
Dim a As fileInfo = GetLastSector()
|
||
|
||
importSector.Text = a.Sector + a.Sizw \ 2048 + 10
|
||
|
||
End Sub
|
||
|
||
Public Function GetLastSector()
|
||
|
||
Return files1.OrderByDescending(Function(x) x.Sector).FirstOrDefault
|
||
|
||
End Function
|
||
|
||
Private Sub Export181577_Click(sender As Object, e As EventArgs) Handles Export181577.Click
|
||
|
||
|
||
Dim ver = ""
|
||
|
||
If CDFileList.Items.Count > 0 Then
|
||
|
||
|
||
Dim cat = WorkDir.Text & "0057_ALL_SCENERY"
|
||
If Not Directory.Exists(cat) Then
|
||
Directory.CreateDirectory(cat)
|
||
|
||
End If
|
||
ExportBinPath.Text = cat & "\"
|
||
|
||
|
||
If japRadio.Checked Then ver = "_J"
|
||
If EngRadio.Checked Then ver = "_E"
|
||
If UserRadio.Checked Then ver = "_U"
|
||
|
||
Else
|
||
MsgBox("Please,Select And Load ISO") : Exit Sub
|
||
End If
|
||
|
||
Dim iso = New ISOTools
|
||
Dim rle = New rleTools
|
||
Dim filnam = getFilnam()
|
||
|
||
|
||
|
||
For a = 57 To 397
|
||
|
||
Dim b(0) As Byte
|
||
|
||
Dim fil = iso.getCDfile(filnam, files1(a).Sector, files1(a).Sizw)
|
||
|
||
DeconstructFile(fil.ToArray) 'here is separated binfile
|
||
|
||
|
||
Dim r As rleFile = binFile.Last 'get scenery script
|
||
|
||
Dim filename = ExportBinPath.Text & "0" & a & "_" & binFile.Count - 1 & "_0_" & binFile.Count - 1 & ver
|
||
|
||
Dim unrl = New List(Of Byte)
|
||
If r.Compr = 2 Then
|
||
unrl = rle.Unrle(r.Bytes) 'unpacking
|
||
Else
|
||
unrl = rle.Unrle2(r.Bytes)
|
||
End If
|
||
|
||
|
||
'saving!
|
||
My.Computer.FileSystem.WriteAllBytes(filename, unrl.ToArray, False)
|
||
|
||
Next
|
||
|
||
MsgBox("EXPORTED TO " & ExportBinPath.Text)
|
||
End Sub
|
||
|
||
|
||
Private Sub Export518_675_Click(sender As Object, e As EventArgs) Handles Export518_675.Click
|
||
|
||
|
||
Dim ver = ""
|
||
|
||
If CDFileList.Items.Count > 0 Then
|
||
|
||
|
||
Dim cat = WorkDir.Text & "0518_EXTRA_SCENERY"
|
||
If Not Directory.Exists(cat) Then
|
||
Directory.CreateDirectory(cat)
|
||
|
||
End If
|
||
ExportBinPath.Text = cat & "\"
|
||
|
||
|
||
If japRadio.Checked Then ver = "_J"
|
||
If EngRadio.Checked Then ver = "_E"
|
||
If UserRadio.Checked Then ver = "_U"
|
||
|
||
Else
|
||
MsgBox("Please,Select And Load ISO") : Exit Sub
|
||
End If
|
||
|
||
Dim iso = New ISOTools
|
||
Dim rle = New rleTools
|
||
Dim filnam = getFilnam()
|
||
|
||
|
||
|
||
For a = 518 To 675
|
||
|
||
Dim b(0) As Byte
|
||
|
||
Dim fil = iso.getCDfile(filnam, files1(a).Sector, files1(a).Sizw)
|
||
|
||
DeconstructFile(fil.ToArray) 'here is separated binfile
|
||
|
||
|
||
Dim r As rleFile = binFile.Last 'get scenery script
|
||
|
||
Dim filename = ExportBinPath.Text & "0" & a & "_" & binFile.Count - 1 & "_0_" & binFile.Count - 1 & ver
|
||
|
||
Dim unrl = New List(Of Byte)
|
||
If r.Compr = 2 Then
|
||
unrl = rle.Unrle(r.Bytes) 'unpacking
|
||
Else
|
||
unrl = rle.Unrle2(r.Bytes)
|
||
End If
|
||
|
||
|
||
'saving!
|
||
My.Computer.FileSystem.WriteAllBytes(filename, unrl.ToArray, False)
|
||
|
||
Next
|
||
|
||
MsgBox("EXPORTED TO " & ExportBinPath.Text)
|
||
End Sub
|
||
|
||
|
||
Private Sub ShowSorted_Click(sender As Object, e As EventArgs) Handles ShowSorted.Click
|
||
SortedFileList.Items.Clear()
|
||
|
||
Dim filesSorted = New List(Of fileInfo)
|
||
|
||
For Each fl In files1
|
||
filesSorted.Add(fl)
|
||
Next
|
||
|
||
filesSorted.Sort(Function(x, y) x.Sector.CompareTo(y.Sector))
|
||
|
||
For Each f In filesSorted
|
||
Dim sectSize As Integer = f.Sizw / 2048
|
||
If f.Sizw Mod 2048 > 0 Then sectSize += 1
|
||
|
||
SortedFileList.Items.Add(f.FileID.ToString("D4") & " Sec: " & f.Sector & " - " & f.Sector + sectSize & " (" & sectSize & ")")
|
||
|
||
Next
|
||
|
||
End Sub
|
||
|
||
|
||
|
||
Private Sub ScriptView_Click(sender As Object, e As EventArgs) Handles ScriptView.Click
|
||
Dim s = New ScriptCheck
|
||
|
||
s.Show()
|
||
|
||
End Sub
|
||
|
||
Private Sub makeTreeTest_Click(sender As Object, e As EventArgs) Handles makeTreeTest.Click
|
||
|
||
Dim rle = New rleTools
|
||
Dim fil = My.Computer.FileSystem.ReadAllBytes("D:\Games\PSX\Persona.2.Innocent.Sin\Export\UnRLE\0181_ALL_SCENERY\1112").ToList
|
||
|
||
' rle.decodeRLEnew(fil)
|
||
|
||
End Sub
|
||
|
||
Private Sub OffsetEditorBtn_Click(sender As Object, e As EventArgs) Handles OffsetEditorBtn.Click
|
||
Dim o = New StringsOffsetEditorvb
|
||
o.Show()
|
||
End Sub
|
||
|
||
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
|
||
Dim o = New DungeonEditor
|
||
o.Show()
|
||
End Sub
|
||
|
||
|
||
Private Sub DistrEditor_Click(sender As Object, e As EventArgs) Handles DistrEditor.Click
|
||
Dim o = New CityEditor
|
||
o.Show()
|
||
End Sub
|
||
|
||
Private Sub ImgShow_Click(sender As Object, e As EventArgs) Handles ImgShow.Click
|
||
|
||
|
||
DrawImage()
|
||
End Sub
|
||
|
||
Private Sub ClutShift_ValueChanged(sender As Object, e As EventArgs) Handles ClutShift.ValueChanged
|
||
DrawImage()
|
||
End Sub
|
||
|
||
|
||
Private Sub PNGimport_Click(sender As Object, e As EventArgs) Handles PNGimport.Click
|
||
OpenFileDialog1.Multiselect = True
|
||
If OpenFileDialog1.ShowDialog <> DialogResult.OK Then Exit Sub
|
||
OpenFileDialog1.Multiselect = False
|
||
If Not UserRadio.Checked Then MsgBox("YOU CAN IMPORT ONLY IN USER ISO!!!") : Exit Sub
|
||
|
||
Dim s = New ScriptTools
|
||
Dim endfil = New List(Of Byte)
|
||
|
||
For Each filee In OpenFileDialog1.FileNames
|
||
|
||
Dim fileInfo = Split(Path.GetFileNameWithoutExtension(filee), "_")
|
||
Dim curFilePack As Integer = fileInfo(0)
|
||
Dim curFileIndexInPack As Integer = fileInfo(1)
|
||
Dim curFileSector As Integer = fileInfo(2)
|
||
Dim curFileRleID As Integer = fileInfo(3)
|
||
Debug.WriteLine("Importing... " & Path.GetFileNameWithoutExtension(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
|
||
|
||
|
||
Dim fil = My.Computer.FileSystem.ReadAllBytes(OpenFileDialog1.FileName).ToList
|
||
|
||
|
||
|
||
Dim curfile As rleFile = binFile(curFileIndexInPack)
|
||
|
||
|
||
|
||
|
||
Dim png = New pngImage
|
||
png.InitBitMap(filee)
|
||
Dim data = png.ParsePNGgetData(fil, curfile)
|
||
If data.Count = 0 Then MsgBox("ERROR! Returned EmptyData???") : Exit Sub
|
||
Dim rle = New rleTools
|
||
|
||
|
||
If curfile.Compr = 0 Then
|
||
endfil = rle.MakeUncompressedImage(data.ToArray, curfile)
|
||
Else
|
||
endfil = rle.decodeRLE2images(data.ToArray, curfile)
|
||
End If
|
||
If endfil.Count = 0 Then MsgBox("Import Error in file #" & curFileIndexInPack) : Exit Sub
|
||
binFile(curFileIndexInPack).Bytes = endfil.ToArray
|
||
|
||
binFile(curFileIndexInPack).BytesAfter = 0
|
||
|
||
Next
|
||
|
||
|
||
'АРХИВИРУЕМ МАССИВ ФАЙЛОВ ДЛЯ ЗАПИСИ В ОДИН ФАЙЛ
|
||
Dim lastSectorID As Integer = 0
|
||
Dim finalPack = New List(Of Byte)
|
||
Dim addresses = New List(Of Integer) 'Start Addr for all files
|
||
|
||
|
||
For Each bin In binFile
|
||
|
||
If Not IgnoreGaps.Checked Then
|
||
'filling sector to end (making sectorgap) in the middle of the file
|
||
If bin.SectorID <> lastSectorID Then
|
||
Dim gap = 2048 - (finalPack.Count Mod 2048)
|
||
For g = 0 To gap - 1
|
||
finalPack.Add(0)
|
||
Next
|
||
End If
|
||
End If
|
||
|
||
|
||
|
||
|
||
|
||
'adding currentfile and address for filetables
|
||
addresses.Add(finalPack.Count)
|
||
finalPack.AddRange(bin.Bytes)
|
||
|
||
'AddingBytesAfter
|
||
For g = 0 To bin.BytesAfter - 1
|
||
finalPack.Add(0)
|
||
Next
|
||
|
||
|
||
'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
|
||
For g = 1 To ffff
|
||
finalPack.Add(0)
|
||
Next
|
||
End If
|
||
|
||
|
||
lastSectorID = bin.SectorID
|
||
Next
|
||
|
||
Dim packsize = finalPack.Count
|
||
|
||
'Fill file to END of Sector
|
||
If finalPack.Count Mod 2048 > 0 Then
|
||
For g = 1 To (2048 - (finalPack.Count Mod 2048))
|
||
finalPack.Add(0)
|
||
Next g
|
||
End If
|
||
|
||
'checking filesize if inserting into ORIGINAL place
|
||
If Not TestImportSize(finalPack, packsize) Then Exit Sub
|
||
|
||
'UPDATING FILES TABLES
|
||
Select Case CDFileList.SelectedIndex
|
||
Case 682
|
||
'TITLE SCREENS IMPORT
|
||
MakePointersTable(addresses, files1(681).Sector, files1(681).Sizw, 50392)
|
||
|
||
|
||
|
||
End Select
|
||
|
||
|
||
' Exit Sub
|
||
|
||
'SaveFile To Sector
|
||
Dim cd = New ISOTools
|
||
cd.saveCDfile(UserPath.Text, importSector.Text, finalPack.Count, finalPack.ToArray)
|
||
|
||
'Update SectorNumber and FileSize In FileArray
|
||
files1(CDFileList.SelectedIndex).Sizw = finalPack.Count
|
||
files1(CDFileList.SelectedIndex).Sector = importSector.Text
|
||
|
||
'Update FileTable In ISO
|
||
cd.UpdateFileListTable(UserPath.Text, files1)
|
||
|
||
|
||
'Done
|
||
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
|
||
|
||
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)
|
||
|
||
|
||
End Sub
|
||
|
||
Private Sub SaveTitles_Click(sender As Object, e As EventArgs) Handles SaveTitles.Click
|
||
Dim iso = New ISOTools
|
||
Dim fil = iso.getCDfile(UserPath.Text, files1(1126).Sector, files1(1126).Sizw)
|
||
Dim scr = New ScriptTools
|
||
Dim writer As Integer = 13804
|
||
Dim lastByte = 16253
|
||
Dim adresses = New List(Of Integer)
|
||
Dim bytes = New List(Of Byte)
|
||
|
||
For Each row In TGrid.Rows
|
||
|
||
If row.Cells(0).Value = "------" Then bytes.Add(59) : Continue For
|
||
adresses.Add(bytes.Count + 668)
|
||
Dim cur As String = row.Cells(0).Value
|
||
|
||
For a = 0 To cur.Length - 1
|
||
If cur(a) = "[" Then
|
||
Dim str() = Split(scr.getFromSkobki(cur, a), "=")
|
||
If str(0) = "B" Then bytes.Add(Convert.ToByte(str(1)))
|
||
If str(0) = "C" Then bytes.Add(Convert.ToByte(str(1) + 128))
|
||
'If a = cur.Length Then Continue For
|
||
a = a - 1
|
||
Continue For
|
||
End If
|
||
If cur(a) = " " Then bytes.Add(129)
|
||
If Asc(cur(a)) >= 97 And Asc(cur(a)) <= 122 Then bytes.Add(Asc(cur(a)) - 70)
|
||
If Asc(cur(a)) >= 65 And Asc(cur(a)) <= 90 Then bytes.Add(Asc(cur(a)) - 64)
|
||
Next
|
||
bytes.Add(128)
|
||
Next
|
||
If (lastByte - writer - bytes.Count) < 0 Then
|
||
MsgBox("Error. Not enought bytes = " & (lastByte - 13804 - bytes.Count))
|
||
Exit Sub
|
||
End If
|
||
|
||
For a = 0 To bytes.Count - 1
|
||
fil(a + writer) = bytes(a)
|
||
Next
|
||
|
||
'RefTable
|
||
For a = 0 To 163
|
||
fil(13148 + a * 4) = BitConverter.GetBytes(adresses(a))(0)
|
||
fil(13149 + a * 4) = BitConverter.GetBytes(adresses(a))(1)
|
||
Next
|
||
|
||
|
||
iso.saveCDfile(UserPath.Text, files1(1126).Sector, files1(1126).Sizw, fil.Toarray)
|
||
|
||
'Dim filnam As String = "D:\Games\PSX\Persona.2.Innocent.Sin\Export\1126_TITLES\Titles.bin"
|
||
'My.Computer.FileSystem.WriteAllBytes(filnam, bytes.ToArray, False)
|
||
End Sub
|
||
|
||
Private Sub LoadTitles_Click(sender As Object, e As EventArgs) Handles LoadTitles.Click
|
||
Dim filnam As String = "D:\Games\PSX\Persona.2.Innocent.Sin\Export\1126_TITLES\Titles.txt"
|
||
|
||
Dim txt = Split(My.Computer.FileSystem.ReadAllText(filnam), vbCrLf)
|
||
ReDim Preserve txt(TGrid.Rows.Count - 1)
|
||
|
||
|
||
|
||
For Each row In TGrid.Rows
|
||
|
||
row.Cells(0).Value = txt(TGrid.Rows.IndexOf(row))
|
||
Next
|
||
End Sub
|
||
|
||
Private Sub SaveTit_Click(sender As Object, e As EventArgs) Handles SaveTit.Click
|
||
Dim filnam As String = "D:\Games\PSX\Persona.2.Innocent.Sin\Export\1126_TITLES\Titles.txt"
|
||
|
||
Dim txt As String = ""
|
||
|
||
For Each row In TGrid.Rows
|
||
Dim aaa = TGrid.CurrentCell
|
||
If IsNothing(row.Cells(0).Value) Then MsgBox("Error reading tgable! Pleasem, resave!") : Exit Sub
|
||
txt += row.Cells(0).Value.ToString & vbCrLf
|
||
Next
|
||
|
||
|
||
My.Computer.FileSystem.WriteAllText(filnam, txt, False)
|
||
End Sub
|
||
|
||
Private Sub CDLoadSortedFiles_Click(sender As Object, e As EventArgs) Handles CDLoadSortedFiles.Click
|
||
CDGrid.Rows.Clear()
|
||
|
||
Dim filesSorted = New List(Of fileInfo)
|
||
Dim SectorType = 2048
|
||
If IsNothing(files1) Then ReadCDFileTable.PerformClick()
|
||
|
||
For Each fl In files1
|
||
filesSorted.Add(fl)
|
||
Next
|
||
|
||
filesSorted.Sort(Function(x, y) x.Sector.CompareTo(y.Sector))
|
||
|
||
For Each f In filesSorted
|
||
|
||
If f.FileID >= 865 And f.FileID <= 879 Then SectorType = 2352 Else SectorType = 2048
|
||
|
||
Dim sectSize As Integer = f.Sizw \ SectorType
|
||
Dim sizeadd = ""
|
||
If f.Sizw Mod SectorType > 0 Then sectSize += 1 : If sectSize > 1 Then sizeadd = " + " & f.Sizw Mod SectorType
|
||
|
||
Dim curFil = CDGrid.Rows.Count
|
||
|
||
Dim secGap = 0
|
||
If curFil < 880 Then 'calculating sectors gap between files
|
||
secGap = filesSorted(curFil + 1).Sector - f.Sector - sectSize
|
||
End If
|
||
Dim printsize = f.Sizw
|
||
If sectSize > 1 Then printsize = sectSize * SectorType : If sizeadd <> "" Then printsize -= SectorType
|
||
CDGrid.Rows.Add(f.FileID.ToString("D4"), f.Sector, printsize & sizeadd & "b", sectSize, f.Sector + sectSize - 1, secGap)
|
||
If secGap > 0 Then CDGrid.Rows(curFil).Cells(5).Style.BackColor = Color.DarkGreen
|
||
If SectorType > 2048 Then
|
||
For Each col In CDGrid.Rows(curFil).Cells
|
||
col.Style.BackColor = Color.DarkRed
|
||
Next
|
||
End If
|
||
|
||
Next
|
||
|
||
End Sub
|
||
|
||
Private Sub SortCDFiles_Click(sender As Object, e As EventArgs) Handles SortCDFiles.Click
|
||
|
||
If MsgBox("TOCHNO???? Continue??", MsgBoxStyle.YesNo) <> MsgBoxResult.Yes Then Exit Sub
|
||
|
||
|
||
Dim a1 = 0, a2 = 0
|
||
Dim iso = New ISOTools
|
||
If RadioSort1.Checked Then a1 = 0 : a2 = 864
|
||
|
||
|
||
For a = a1 To a2
|
||
files1(a).Data = iso.getCDfile(UserPath.Text, files1(a).Sector, files1(a).Sizw)
|
||
Next
|
||
|
||
'init
|
||
Dim curSector = 939
|
||
Dim max = 166072
|
||
|
||
Dim filnam = UserPath.Text
|
||
|
||
For a = a1 To a2
|
||
|
||
Debug.WriteLine("Working On......" & a.ToString("D4"))
|
||
Dim SectorSizw As Integer = (files1(a).Data.Count) \ 2048
|
||
|
||
Select Case a
|
||
Case a > 269, a < 285
|
||
files1(a).Sector = files1(268).Sector
|
||
|
||
End Select
|
||
|
||
|
||
|
||
If files1(a).Data.Count Mod 2048 > 0 Then SectorSizw += 1
|
||
If curSector + SectorSizw > max Then MsgBox("NE LEZET!!! OVERLOAD at file " & a) : Exit For
|
||
iso.saveCDfile(filnam, curSector, files1(a).Data.Count, files1(a).Data.ToArray)
|
||
'Update SectorNumber In FileArray
|
||
'files1(a).Sizw = files1(a).Sizw
|
||
files1(a).Sector = curSector
|
||
|
||
'If a = 577 Then curSector += 5
|
||
|
||
curSector += SectorSizw
|
||
|
||
Next
|
||
|
||
iso.UpdateFileListTable(filnam, files1)
|
||
|
||
MsgBox("Files Sorted")
|
||
|
||
End Sub
|
||
|
||
Private Sub conv3D_Click(sender As Object, e As EventArgs) Handles conv3D.Click
|
||
Dim o = New convEventToObj
|
||
|
||
o.Show()
|
||
End Sub
|
||
|
||
Private Sub GenChars_Click(sender As Object, e As EventArgs) Handles GenChars.Click
|
||
Dim maxcols = 12
|
||
Dim txt = ""
|
||
Dim blockId = 0
|
||
Dim blockline = 0
|
||
Dim lineChar = 0
|
||
For a = 0 To 3000
|
||
Dim x As Integer = a Mod 256
|
||
Dim y As Integer = Math.Floor(a / 256)
|
||
txt &= x.ToString("X2") & y.ToString("X2")
|
||
If lineChar > maxcols Then
|
||
If blockline = 21 Then blockline = 0 : blockId += 1
|
||
If blockline = 0 Then Debug.WriteLine(blockId & " ===========================================")
|
||
blockline += 1
|
||
lineChar = 0
|
||
Debug.WriteLine(txt)
|
||
txt = ""
|
||
Continue For
|
||
End If
|
||
lineChar += 1
|
||
Next
|
||
End Sub
|
||
|
||
Private Sub CharCodeGenerator_Click(sender As Object, e As EventArgs) Handles CharCodeGenerator.Click
|
||
Dim w = New JapCharCodeGenerator
|
||
w.Show()
|
||
End Sub
|
||
|
||
Private Sub ParseEvent_Click(sender As Object, e As EventArgs) Handles ParseEvent.Click
|
||
If OpenFileDialog1.ShowDialog <> DialogResult.OK Then Exit Sub
|
||
Dim s = New ScriptTools
|
||
s.ParseScript(OpenFileDialog1.FileName)
|
||
End Sub
|
||
|
||
End Class
|
||
|
||
|
||
Public Class fileInfo
|
||
|
||
Public FileID As Integer
|
||
Public Sector As Integer
|
||
Public Sizw As Integer
|
||
Public Data As List(Of Byte)
|
||
Public Descript As String
|
||
End Class
|
||
|
||
|
||
Public Class rleFile
|
||
Public SectorID As Integer
|
||
Public ID As Integer
|
||
Public Type As Byte '/* 0=eof, 1=data, 2=image */
|
||
Public Compr As Byte '/* 0=none, 1=rle, 2=lzss */
|
||
Public w, h, x, y As Int16
|
||
Public Size As Integer
|
||
Public UnpackSize As Integer
|
||
Public Mode As Byte
|
||
Public Bytes() As Byte
|
||
Public BytesAfter As Integer
|
||
Public SectorGap As Integer
|
||
Public SectorSize As Integer
|
||
End Class |