Imports ManagedZLib
Public Enum BsaArchiveFlags As UInt32
HasDirectoryNames = 1
HasFileNames = 2
CompressionEnabled = 4
'Gli altri campi sono sconosciuti
End Enum
Public Enum BsaFileTypeFlags As UInt32
Nif = 1
Dds = 2
Xml = 4
Wav = 8
Mp3 = 16
TxtHtmlBatScc = 32
Spt = 64
TexFnt = 128
Ctl = 256
End Enum
Public Class BsaArchive
Private Structure FolderRecord
Public NameHash As UInt64
Public Count As UInt32
Public Offset As UInt32
End Structure
Private Structure FileRecord
Public NameHash As UInt64
Public Size As UInt32
Public Offset As UInt32
End Structure
Private Structure FileRecordBlock
Public FolderName As String
Public Records() As FileRecord
End Structure
Public Structure BsaFile
Private _Name As String
Private _Offset, _Size As UInt32
Public ReadOnly Property Name() As String
Get
Return _Name
End Get
End Property
Public ReadOnly Property Offset() As UInt32
Get
Return _Offset
End Get
End Property
Public Property Size() As UInt32
Get
Return _Size
End Get
Set(ByVal value As UInt32)
_Size = value
End Set
End Property
Sub New(ByVal Name As String, ByVal Offset As UInt32, ByVal Size As UInt32)
_Name = Name
_Offset = Offset
_Size = Size
End Sub
End Structure
Public Structure BsaFolder
Private _Name As String
Private _Files As List(Of BsaFile)
Public ReadOnly Property Name() As String
Get
Return _Name
End Get
End Property
Public ReadOnly Property Files() As List
(Of BsaFile
) Get
Return _Files
End Get
End Property
Sub New(ByVal Name As String)
_Name = Name
_Files = New List(Of BsaFile)
End Sub
End Structure
Private _FileName As String
Private _ArchiveFlags As BsaArchiveFlags
Private _FileTypeFlags As BsaFileTypeFlags
Private _FoldersCount, _FilesCount, _Version As UInt32
Private _Folders As List(Of BsaFolder)
Private Stream As IO.FileStream
Private TotalFolderNamesLength, TotalFileNamesLength As UInt32
Public ReadOnly Property FileName() As String
Get
Return _FileName
End Get
End Property
Public ReadOnly Property Version() As UInt32
Get
Return _Version
End Get
End Property
Public ReadOnly Property FoldersCount() As Int32
Get
Return _FoldersCount
End Get
End Property
Public ReadOnly Property FilesCount() As Int32
Get
Return _FilesCount
End Get
End Property
Public ReadOnly Property ArchiveFlags() As BsaArchiveFlags
Get
Return _ArchiveFlags
End Get
End Property
Public ReadOnly Property FileTypeFlags() As BsaFileTypeFlags
Get
Return _FileTypeFlags
End Get
End Property
Public ReadOnly Property Folders() As List
(Of BsaFolder
) Get
Return _Folders
End Get
End Property
Public ReadOnly Property IsCompressionEnabled() As Boolean
Get
Return (Me.ArchiveFlags And BsaArchiveFlags.CompressionEnabled) = BsaArchiveFlags.CompressionEnabled
End Get
End Property
Public Sub Open(ByVal FileName As String)
If Not IO.
File.
Exists(FileName
) Then Throw New IO.FileNotFoundException("File non trovato: " & Me.FileName)
End If
_FileName = FileName
Stream = New IO.FileStream(Me.FileName, IO.FileMode.Open)
Dim Reader As New IO.BinaryReader(Stream)
If Reader.ReadChars(3) <> "BSA" Then
Reader.Close()
Stream.Close()
Stream = Nothing
Throw New FormatException(IO.Path.GetFileName(Me.FileName) & " non è un archivio BSA valido.")
End If
Reader.ReadByte()
_Version = Reader.ReadUInt32()
Reader.ReadUInt32() 'Offset = 36
_ArchiveFlags = Reader.ReadUInt32()
_FoldersCount = Reader.ReadUInt32()
_FilesCount = Reader.ReadUInt32()
TotalFolderNamesLength = Reader.ReadUInt32()
TotalFileNamesLength = Reader.ReadUInt32()
_FileTypeFlags = Reader.ReadUInt32()
If ((Me.ArchiveFlags And BsaArchiveFlags.HasDirectoryNames) = 0) Or ((Me.ArchiveFlags And BsaArchiveFlags.HasFileNames) = 0) Then
Reader.Close()
Stream.Close()
Stream = Nothing
Throw New FormatException(IO.Path.GetFileName(Me.FileName) & " contiene tipologie di dati non supportate dal programma.")
End If
Dim FolderRecords As New List(Of FolderRecord)
Dim FR As FolderRecord
For I As Int32 = 1 To Me.FoldersCount
FR = New FolderRecord()
FR.NameHash = Reader.ReadUInt64()
FR.Count = Reader.ReadUInt32()
FR.Offset = Reader.ReadUInt32()
FolderRecords.Add(FR)
Next
Dim FileRecordBlocks As New List(Of FileRecordBlock)
Dim FRB As FileRecordBlock
For I As Int32 = 1 To Me.FoldersCount
Dim FileR As FileRecord
FRB = New FileRecordBlock()
FRB.FolderName = Reader.ReadFixedLenString()
ReDim FRB.Records(FolderRecords(I - 1).Count - 1)
For J As Int32 = 0 To FRB.Records.Length - 1
FileR = New FileRecord()
FileR.NameHash = Reader.ReadUInt64()
FileR.Size = Reader.ReadUInt32()
FileR.Offset = Reader.ReadUInt32()
FRB.Records(J) = FileR
Next
FileRecordBlocks.Add(FRB)
Next
Dim FileNames As New List(Of String)
For I As Int32 = 1 To Me.FilesCount
FileNames.Add(Reader.ReadNullTerminatedString())
Next
Dim FilesIndexed As Int32 = 0
_Folders = New List(Of BsaFolder)
For I As Int32 = 0 To Me.FoldersCount - 1
Dim BFolder As New BsaFolder(FileRecordBlocks(I).FolderName)
For J As Int32 = 0 To FileRecordBlocks(I).Records.Length - 1
Dim BFile As New BsaFile(FileNames(FilesIndexed), FileRecordBlocks(I).Records(J).Offset, FileRecordBlocks(I).Records(J).Size)
FilesIndexed += 1
Next
Next
FolderRecords.Clear()
FileRecordBlocks.Clear()
FileNames.Clear()
FolderRecords = Nothing
FileRecordBlocks = Nothing
FileNames = Nothing
Reader = Nothing
End Sub
Public Sub ExtractFile(ByVal Ref As BsaFile, ByVal OutputFolder As String)
Dim Output As IO.Stream
Dim Buffer(7999) As Byte
Dim BytesRead As UInt32 = 0
Stream.Position = Ref.Offset
Output = New IO.FileStream(OutputFolder & "\" & Ref.Name, IO.FileMode.Create)
If (((Me.ArchiveFlags And BsaArchiveFlags.CompressionEnabled) = BsaArchiveFlags.CompressionEnabled) And (Ref.Size < 2 ^ 31)) _
Or (((Me.ArchiveFlags And BsaArchiveFlags.CompressionEnabled) = 0) And (Ref.Size >= 2 ^ 31)) Then
If Ref.Size >= 2 ^ 31 Then
Ref.Size -= 2 ^ 31
End If
Stream.Position += 4
Dim CompressedStream As New IO.MemoryStream()
Dim Buffer2(Ref.Size - 1) As Byte
Stream.Read(Buffer2, 0, Buffer2.Length)
CompressedStream.Write(Buffer2, 0, Buffer2.Length)
CompressedStream.Position = 0
Dim DataReader As New ManagedZLib.Decompress(CompressedStream)
Dim DataWriter = New IO.BinaryWriter(Output)
Try
BytesRead = DataReader.Read(Buffer, 0, Buffer.Length)
Do While (BytesRead > 0)
DataWriter.Write(Buffer, 0, BytesRead)
BytesRead = DataReader.Read(Buffer, 0, Buffer.Length)
Loop
Catch Ex As Exception
Throw Ex
Finally
DataWriter.Close()
DataReader.Close()
End Try
Else
Dim TotalBytesRead As UInt32 = 0
Do
If Ref.Size - TotalBytesRead < Buffer.Length Then
BytesRead = Stream.Read(Buffer, 0, Ref.Size - TotalBytesRead)
Else
BytesRead = Stream.Read(Buffer, 0, Buffer.Length)
End If
Output.Write(Buffer, 0, BytesRead)
TotalBytesRead += BytesRead
Loop Until TotalBytesRead >= Ref.Size
End If
Output.Close()
End Sub
Public Sub Close()
_ArchiveFlags = 0
_FilesCount = 0
_FileTypeFlags = 0
_Folders.Clear()
_Folders = Nothing
_FoldersCount = 0
_Version = 0
Stream.Close()
End Sub
End Class
Module Globals
<System.Runtime.CompilerServices.Extension()> _
Public Function ReadNullTerminatedString(ByVal Reader As IO.BinaryReader) As String
Dim S As New System.Text.StringBuilder()
Dim B As Byte
B = Reader.ReadByte()
Do While B <> 0
S.Append(Chr(B))
B = Reader.ReadByte()
Loop
Return S.ToString()
End Function
<System.Runtime.CompilerServices.Extension()> _
Public Function ReadFixedLenString(ByVal Reader As IO.BinaryReader) As String
Dim S As New System.Text.StringBuilder()
Dim Len As Byte
Dim B As Byte
Len = Reader.ReadByte()
For I As Byte = 1 To Len - 1
B = Reader.ReadByte()
S.Append(Chr(B))
Next
Reader.ReadByte() ' = Null
Return S.ToString()
End Function
<System.Runtime.CompilerServices.Extension()> _
Public Sub AddItem(ByVal List As ListView, ByVal ParamArray SubItemTexts() As String)
Dim L As New ListViewItem(SubItemTexts)
List.Items.Add(L)
End Sub
End Module
