mo2/libbsarch
0
0
Fork 0
mirror of https://github.com/ModOrganizer2/libbsarch.git synced 2026-07-27 14:06:31 -07:00
Code Issues Packages Projects Releases Wiki Activity
Files
2a544ac3de342ef2027134333c7ee61851607f4f
libbsarch/delphi/wbBSArchive.pas
T
Jeremy Rimpo 4f32506570 Restore mistakenly removed size increment 
- Should fix missing texture data
2024-07-11 01:55:00 -05:00

2638 lines
90 KiB
ObjectPascal
Raw Blame History

{******************************************************************************
This Source Code Form is subject to the terms of the Mozilla Public License,
v. 2.0. If a copy of the MPL was not distributed with this file, You can obtain
one at https://mozilla.org/MPL/2.0/.
*******************************************************************************}
unit wbBSArchive;
interface
uses
System.SysUtils,
System.Classes,
Winapi.Windows,
System.Threading,
System.SyncObjs,
System.Generics.Defaults,
System.Generics.Collections,
wbStreams,
tfTypes,
tfMD5;
const
csBSAVersion = '0.9d';
type
// per file compression options
TPackingCompression = (pcGlobal, pcCompress, pcUncompress);
TBGSCompressionType = (ctZlib, ctLZ4Frame, ctLZ4Block);
TMagic4 = array [0..3] of AnsiChar;
PMagic4 = ^TMagic4;
TDXGI = (
DXGI_FORMAT_UNKNOWN,
DXGI_FORMAT_R32G32B32A32_TYPELESS,
DXGI_FORMAT_R32G32B32A32_FLOAT,
DXGI_FORMAT_R32G32B32A32_UINT,
DXGI_FORMAT_R32G32B32A32_SINT,
DXGI_FORMAT_R32G32B32_TYPELESS,
DXGI_FORMAT_R32G32B32_FLOAT,
DXGI_FORMAT_R32G32B32_UINT,
DXGI_FORMAT_R32G32B32_SINT,
DXGI_FORMAT_R16G16B16A16_TYPELESS,
DXGI_FORMAT_R16G16B16A16_FLOAT,
DXGI_FORMAT_R16G16B16A16_UNORM,
DXGI_FORMAT_R16G16B16A16_UINT,
DXGI_FORMAT_R16G16B16A16_SNORM,
DXGI_FORMAT_R16G16B16A16_SINT,
DXGI_FORMAT_R32G32_TYPELESS,
DXGI_FORMAT_R32G32_FLOAT,
DXGI_FORMAT_R32G32_UINT,
DXGI_FORMAT_R32G32_SINT,
DXGI_FORMAT_R32G8X24_TYPELESS,
DXGI_FORMAT_D32_FLOAT_S8X24_UINT,
DXGI_FORMAT_R32_FLOAT_X8X24_TYPELESS,
DXGI_FORMAT_X32_TYPELESS_G8X24_UINT,
DXGI_FORMAT_R10G10B10A2_TYPELESS,
DXGI_FORMAT_R10G10B10A2_UNORM,
DXGI_FORMAT_R10G10B10A2_UINT,
DXGI_FORMAT_R11G11B10_FLOAT,
DXGI_FORMAT_R8G8B8A8_TYPELESS,
DXGI_FORMAT_R8G8B8A8_UNORM,
DXGI_FORMAT_R8G8B8A8_UNORM_SRGB,
DXGI_FORMAT_R8G8B8A8_UINT,
DXGI_FORMAT_R8G8B8A8_SNORM,
DXGI_FORMAT_R8G8B8A8_SINT,
DXGI_FORMAT_R16G16_TYPELESS,
DXGI_FORMAT_R16G16_FLOAT,
DXGI_FORMAT_R16G16_UNORM,
DXGI_FORMAT_R16G16_UINT,
DXGI_FORMAT_R16G16_SNORM,
DXGI_FORMAT_R16G16_SINT,
DXGI_FORMAT_R32_TYPELESS,
DXGI_FORMAT_D32_FLOAT,
DXGI_FORMAT_R32_FLOAT,
DXGI_FORMAT_R32_UINT,
DXGI_FORMAT_R32_SINT,
DXGI_FORMAT_R24G8_TYPELESS,
DXGI_FORMAT_D24_UNORM_S8_UINT,
DXGI_FORMAT_R24_UNORM_X8_TYPELESS,
DXGI_FORMAT_X24_TYPELESS_G8_UINT,
DXGI_FORMAT_R8G8_TYPELESS,
DXGI_FORMAT_R8G8_UNORM,
DXGI_FORMAT_R8G8_UINT,
DXGI_FORMAT_R8G8_SNORM,
DXGI_FORMAT_R8G8_SINT,
DXGI_FORMAT_R16_TYPELESS,
DXGI_FORMAT_R16_FLOAT,
DXGI_FORMAT_D16_UNORM,
DXGI_FORMAT_R16_UNORM,
DXGI_FORMAT_R16_UINT,
DXGI_FORMAT_R16_SNORM,
DXGI_FORMAT_R16_SINT,
DXGI_FORMAT_R8_TYPELESS,
DXGI_FORMAT_R8_UNORM,
DXGI_FORMAT_R8_UINT,
DXGI_FORMAT_R8_SNORM,
DXGI_FORMAT_R8_SINT,
DXGI_FORMAT_A8_UNORM,
DXGI_FORMAT_R1_UNORM,
DXGI_FORMAT_R9G9B9E5_SHAREDEXP,
DXGI_FORMAT_R8G8_B8G8_UNORM,
DXGI_FORMAT_G8R8_G8B8_UNORM,
DXGI_FORMAT_BC1_TYPELESS,
DXGI_FORMAT_BC1_UNORM,
DXGI_FORMAT_BC1_UNORM_SRGB,
DXGI_FORMAT_BC2_TYPELESS,
DXGI_FORMAT_BC2_UNORM,
DXGI_FORMAT_BC2_UNORM_SRGB,
DXGI_FORMAT_BC3_TYPELESS,
DXGI_FORMAT_BC3_UNORM,
DXGI_FORMAT_BC3_UNORM_SRGB,
DXGI_FORMAT_BC4_TYPELESS,
DXGI_FORMAT_BC4_UNORM,
DXGI_FORMAT_BC4_SNORM,
DXGI_FORMAT_BC5_TYPELESS,
DXGI_FORMAT_BC5_UNORM,
DXGI_FORMAT_BC5_SNORM,
DXGI_FORMAT_B5G6R5_UNORM,
DXGI_FORMAT_B5G5R5A1_UNORM,
DXGI_FORMAT_B8G8R8A8_UNORM,
DXGI_FORMAT_B8G8R8X8_UNORM,
DXGI_FORMAT_R10G10B10_XR_BIAS_A2_UNORM,
DXGI_FORMAT_B8G8R8A8_TYPELESS,
DXGI_FORMAT_B8G8R8A8_UNORM_SRGB,
DXGI_FORMAT_B8G8R8X8_TYPELESS,
DXGI_FORMAT_B8G8R8X8_UNORM_SRGB,
DXGI_FORMAT_BC6H_TYPELESS,
DXGI_FORMAT_BC6H_UF16,
DXGI_FORMAT_BC6H_SF16,
DXGI_FORMAT_BC7_TYPELESS,
DXGI_FORMAT_BC7_UNORM,
DXGI_FORMAT_BC7_UNORM_SRGB,
DXGI_FORMAT_AYUV,
DXGI_FORMAT_Y410,
DXGI_FORMAT_Y416,
DXGI_FORMAT_NV12,
DXGI_FORMAT_P010,
DXGI_FORMAT_P016,
DXGI_FORMAT_420_OPAQUE,
DXGI_FORMAT_YUY2,
DXGI_FORMAT_Y210,
DXGI_FORMAT_Y216,
DXGI_FORMAT_NV11,
DXGI_FORMAT_AI44,
DXGI_FORMAT_IA44,
DXGI_FORMAT_P8,
DXGI_FORMAT_A8P8,
DXGI_FORMAT_B4G4R4A4_UNORM,
DXGI_FORMAT_P208,
DXGI_FORMAT_V208,
DXGI_FORMAT_V408
);
TDDSHeader = packed record
Magic: TMagic4;
dwSize: Cardinal;
dwFlags: Cardinal;
dwHeight: Cardinal;
dwWidth: Cardinal;
dwPitchOrLinearSize: Cardinal;
dwDepth: Cardinal;
dwMipMapCount: Cardinal;
dwReserved1: array [0..10] of Cardinal;
ddspf: packed record
dwSize: Cardinal;
dwFlags: Cardinal;
dwFourCC: TMagic4;
dwRGBBitCount: Cardinal;
dwRBitMask: Cardinal;
dwGBitMask: Cardinal;
dwBBitMask: Cardinal;
dwABitMask: Cardinal;
end;
dwCaps: Cardinal;
dwCaps2: Cardinal;
dwCaps3: Cardinal;
dwCaps4: Cardinal;
dwReserved2: Cardinal;
end;
PDDSHeader = ^TDDSHeader;
TDDSHeaderDX10 = packed record
dxgiFormat: Integer;
resourceDimension: Cardinal;
miscFlags: Cardinal;
arraySize: Cardinal;
miscFlags2: Cardinal;
end;
PDDSHeaderDX10 = ^TDDSHeaderDX10;
const
DDSD_CAPS = $00000001;
DDSD_HEIGHT = $00000002;
DDSD_WIDTH = $00000004;
DDSD_PITCH = $00000008;
DDSD_PIXELFORMAT = $00001000;
DDSD_MIPMAPCOUNT = $00020000;
DDSD_LINEARSIZE = $00080000;
DDSD_DEPTH = $00800000;
DDSCAPS_COMPLEX = $00000008;
DDSCAPS_TEXTURE = $00001000;
DDSCAPS_MIPMAP = $00400000;
DDSCAPS2_CUBEMAP = $00000200;
DDSCAPS2_POSITIVEX = $00000400;
DDSCAPS2_NEGATIVEX = $00000800;
DDSCAPS2_POSITIVEY = $00001000;
DDSCAPS2_NEGATIVEY = $00002000;
DDSCAPS2_POSITIVEZ = $00004000;
DDSCAPS2_NEGATIVEZ = $00008000;
DDSCAPS2_VOLUME = $00200000;
DDPF_ALPHAPIXELS = $00000001;
DDPF_ALPHA = $00000002;
DDPF_FOURCC = $00000004;
DDPF_RGB = $00000040;
DDPF_YUV = $00000200;
DDPF_LUMINANCE = $00020000;
// DX10
DDS_DIMENSION_TEXTURE2D = $00000003;
DDS_RESOURCE_MISC_TEXTURECUBE = $00000004;
type
TwbBSArchive = class;
TwbResourceDict = TDictionary<string, TwbNothing>;
TBSArchiveType = (baNone, baTES3, baTES4, baFO3, baSSE, baFO4, baFO4dds, baSF, baSFdds);
TBSArchiveState = (stReading, stWriting);
TBSArchiveStates = set of TBSArchiveState;
TBSFileIterationProc = function(aArchive: Pointer; const aFileName: string;
aFileRecord: Pointer; aFolderRecord: Pointer; aData: Pointer): Boolean; stdcall;
TDDSInfo = record Width, Height, MipMaps: Integer; end;
TBSFileDDSInfoProc = procedure(aArchive: Pointer; const aFileName: string;
var aInfo: TDDSInfo; aContext: Pointer); stdcall;
TwbBSHeaderTES3 = packed record
HashOffset: Cardinal;
FileCount: Cardinal;
end;
TwbBSFileTES3 = record
Hash: UInt64;
Size: Cardinal;
Offset: Cardinal;
Name: string;
end;
PwbBSFileTES3 = ^TwbBSFileTES3;
TwbBSHeaderTES4 = packed record
FoldersOffset: Cardinal;
Flags: Cardinal;
FolderCount: Cardinal;
FileCount: Cardinal;
FolderNamesLength: Cardinal;
FileNamesLength: Cardinal;
FileFlags: Cardinal;
end;
TwbBSFileTES4 = record
Hash: UInt64;
Size: Cardinal;
Offset: Int64;
Name: string;
PackingCompression: TPackingCompression;
function Compress(bsa: TwbBSArchive): Boolean; // compress when packing into a new archive
function Compressed(bsa: TwbBSArchive): Boolean; // compressed in existing archive
function RawSize: Cardinal;
end;
PwbBSFileTES4 = ^TwbBSFileTES4;
TwbBSFolderTES4 = record
Hash: UInt64;
FileCount: Cardinal;
Unk32: Cardinal;
Offset: Int64;
Name: string;
Files: array of TwbBSFileTES4;
end;
PwbBSFolderTES4 = ^TwbBSFolderTES4;
TwbBSHeaderFO4 = packed record
Magic: TMagic4;
FileCount: Cardinal;
FileTableOffset: Int64;
end;
TwbBSHeaderSFv2 = packed record
Unknown1: Cardinal;
Unknown2: Cardinal;
end;
TwbBSHeaderSFv3 = packed record
Unknown1: Cardinal;
Unknown2: Cardinal;
CompressionMethod: Cardinal;
end;
TwbBSTexChunkRec = record
Size : Cardinal;
PackedSize : Cardinal;
Offset : Int64;
StartMip : Word;
EndMip : Word;
end;
PwbBSTexChunkRec = ^TwbBSTexChunkRec;
TwbBSFileFO4 = record
NameHash: Cardinal;
Ext: TMagic4;
DirHash: Cardinal;
// GNRL archive format
Unknown: Cardinal;
Offset: Int64;
PackedSize: Cardinal;
Size: Cardinal;
//
// DX10 archive format
UnknownTex : Byte;
//ChunkHeaderSize: Word;
Height : Word;
Width : Word;
NumMips : Byte;
DXGIFormat : Byte;
CubeMaps : Word;
TexChunks : array of TwbBSTexChunkRec;
//
Name: string;
PackingCompression: TPackingCompression;
function DXGIFormatName: string;
function Compress(bsa: TwbBSArchive): Boolean; // compress when packing into a new archive
function Compressed(bsa: TwbBSArchive): Boolean; // compressed in existing archive
end;
PwbBSFileFO4 = ^TwbBSFileFO4;
TPackedDataHash = TMD5Digest;
TPackedDataInfo = record
Size: Cardinal;
Hash: TPackedDataHash;
FileRecord: Pointer;
end;
PPackedDataInfo = ^TPackedDataInfo;
TwbBSResultBuffer = packed record
size: Cardinal;
data: PByte;
end;
TwbBSArchive = class
private
fStream: TwbBaseCachedFileStream;
fStates: TBSArchiveStates;
fType: TBSArchiveType;
fFileName: string;
fMagic: TMagic4;
fVersion: Cardinal;
fCompress: Boolean;
fCompressionType: TBGSCompressionType;
fShareData: Boolean;
fMultiThreaded: Boolean;
fDDSInfoProc: TBSFileDDSInfoProc;
fDDSInfoProcContext: Pointer;
fHeaderTES3: TwbBSHeaderTES3;
fFilesTES3: array of TwbBSFileTES3;
fHeaderTES4: TwbBSHeaderTES4;
fFoldersTES4: array of TwbBSFolderTES4;
fHeaderFO4: TwbBSHeaderFO4;
fHeaderSFv2: TwbBSHeaderSFv2;
fHeaderSFv3: TwbBSHeaderSFv3;
fFilesFO4: array of TwbBSFileFO4;
fMaxChunkCount: Integer;
fSingleMipChunkX: Integer;
fSingleMipChunkY: Integer;
fDataOffset: Int64;
fPackedData: array of TPackedDataInfo;
fPackedDataCount: Integer;
{$IF CompilerVersion >= 34.0} { Delphi 10.4 }
Sync: TLightweightMREW;
{$ELSE}
Sync: IReadWriteSync;
{$IFEND}
function GetArchiveFormatName: string;
function GetFileCount: Cardinal;
function GetCreatedArchiveSize: Int64;
procedure SetArchiveFlags(aFlags: Cardinal);
procedure SetMultiThreaded(aValue: Boolean);
function FindFileRecordTES3(const aFileName: string; var aFileIdx: Integer): Boolean;
function FindFileRecordTES4(const aFileName: string; var aFolderIdx, aFileIdx: Integer): Boolean;
function FindFileRecordFO4(const aFileName: string; var aFileIdx: Integer): Boolean;
function GetDDSMipChunkNum(var aDDSInfo: TDDSInfo): Integer;
function CalcDataHash(aData: Pointer; aLen: Cardinal): TPackedDataHash;
function FindPackedData(aSize: Cardinal; aHash: TPackedDataHash; aFileRecord: Pointer): Boolean;
procedure AddPackedData(aSize: Cardinal; aHash: TPackedDataHash; aFileRecord: Pointer);
procedure PackData(aFileRecord: Pointer; const aFileName: string;
aDataHash: TPackedDataHash; aData: PByte; aSize: Integer;
aCompress: Boolean; aDoCompress: Boolean = False);
procedure CompressStream(aSrc, aDst: TStream);
procedure DecompressBuf(aSrc: Pointer; aSrcSize: Integer; aDst: Pointer; aDstSize: Integer);
public
constructor Create;
destructor Destroy; override;
procedure LoadFromFile(const aFileName: string);
procedure CreateArchive(const aFileName: string; aType: TBSArchiveType;
aFilesList: TStringList = nil);
procedure Save;
procedure AddFileDisk(const aFilePath, aSourcePath: string);
procedure AddFileDiskRoot(const aRootDir, aSourcePath: string);
procedure AddFileData(const aFileName: string; const aSize: Cardinal; const aData: PByte); overload;
function FindFileRecord(const aFileName: string): Pointer;
function ExtractFileData(aFileRecord: Pointer): TwbBSResultBuffer; overload;
function ExtractFileData(const aFileName: string): TwbBSResultBuffer; overload;
procedure ReleaseFileData(fileDataResult: TwbBSResultBuffer);
procedure ExtractFile(const aFileName, aSaveAs: string);
procedure IterateFiles(aProc: TBSFileIterationProc; aData: Pointer = nil;
aSingleThreaded: Boolean = False);
function FileExists(const aFileName: string): Boolean;
procedure ResourceList(const aList: TStrings; aFolder: string = '');
procedure ResourceDict(const aDict: TwbResourceDict; aFolder: string = '');
//procedure IterateFolders(aProc: TBSFileIterationProc);
procedure Close;
procedure SyncBeginWrite;
procedure SyncEndWrite;
property FileName: string read fFileName;
property ArchiveType: TBSArchiveType read fType;
property Version: Cardinal read fVersion;
property FormatName: string read GetArchiveFormatName;
property FileCount: Cardinal read GetFileCount;
property CreatedArchiveSize: Int64 read GetCreatedArchiveSize;
property ArchiveFlags: Cardinal read fHeaderTES4.Flags write SetArchiveFlags;
property FileFlags: Cardinal read fHeaderTES4.FileFlags write fHeaderTES4.FileFlags;
property Compress: Boolean read fCompress write fCompress;
property ShareData: Boolean read fShareData write fShareData;
property MultiThreaded: Boolean read fMultiThreaded write SetMultiThreaded;
property DDSInfoProc: TBSFileDDSInfoProc read fDDSInfoProc write fDDSInfoProc;
property DDSInfoProcContext: Pointer read fDDSInfoProcContext write fDDSInfoProcContext;
end;
const
cArchiveFormatNames: array[TBSArchiveType] of string = (
'None',
'Morrowind',
'Oblivion',
'Skyrim LE, New Vegas, Fallout 3',
'Skyrim SE, Skyrim AE',
'Fallout 4',
'Fallout 4 DDS',
'Starfield',
'Starfield DDS'
);
cArchiveTypeExtensions: array[TBSArchiveType] of string = (
'.bsa',
'.bsa',
'.bsa',
'.bsa',
'.bsa',
'.ba2',
'.ba2',
'.ba2',
'.ba2'
);
cArchiveFlagNames: array [0..31] of string = (
'Include Directory Names', 'Include File Names', 'Compressed',
'Retain Directory Names', 'Retain File Names',
'Retain File Name Offsets', 'XBox 360 Archive',
'Retain Strings During Startup',
'Embed File Names', 'XMem Codec', '', '',
'', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', ''
);
cFileFlagNames: array [0..31] of string = (
'Meshes', 'Textures', 'Menus', 'Sounds',
'Voices', 'Shaders', 'Trees', 'Fonts',
'Misc', '', '', '',
'', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', ''
);
function SplitDirName(const aFileName: string; var Dir, Name: string): Integer;
function SplitNameExt(const aFileName: string; var Name, Ext: string; aNoExtDot: Boolean = False): Integer;
function CreateHashTES3(const aFileName: string): UInt64;
function CreateHashTES4(const aFileName: string): UInt64; overload;
function CreateHashTES4(const aName, aExt: string): UInt64; overload;
function CreateHashFO4(const aFileName: string): Cardinal;
implementation
uses
TypInfo,
zlibEx,
lz4io;
const
MAGIC_TES3: TMagic4 = #0#1#0#0;
MAGIC_BSA : TMagic4 = 'BSA'#0;
MAGIC_BTDX: TMagic4 = 'BTDX';
MAGIC_GNRL: TMagic4 = 'GNRL';
MAGIC_DX10: TMagic4 = 'DX10';
MAGIC_DDS : TMagic4 = 'DDS ';
MAGIC_DXT1: TMagic4 = 'DXT1';
MAGIC_DXT3: TMagic4 = 'DXT3';
MAGIC_DXT5: TMagic4 = 'DXT5';
MAGIC_ATI1: TMagic4 = 'ATI1';
MAGIC_ATI2: TMagic4 = 'ATI2';
MAGIC_BC4S: TMagic4 = 'BC4S';
MAGIC_BC4U: TMagic4 = 'BC4U';
MAGIC_BC5S: TMagic4 = 'BC5S';
MAGIC_BC5U: TMagic4 = 'BC5U';
iFileFO4Unknown = $00100100;
iFileFO4Tail = $BAADF00D;
{ https://github.com/jonwd7/bae/blob/master/src/bsa.h }
// header versions
HEADER_VERSION_TES4 = $67; // Oblivion
HEADER_VERSION_FO3 = $68; // FO3, FNV, TES5
HEADER_VERSION_SSE = $69; // SSE
HEADER_VERSION_FO4v1 = $01; // FO4
HEADER_VERSION_SF2 = $02; // SF
HEADER_VERSION_SF3 = $03; // SF
HEADER_VERSION_FO4NGv7 = $07; // FO4NG
HEADER_VERSION_FO4NGv8 = $08; // FO4NG2
// archive flags
ARCHIVE_PATHNAMES = $0001; // Whether the BSA has names for paths
ARCHIVE_FILENAMES = $0002; // Whether the BSA has names for files
ARCHIVE_COMPRESS = $0004; // Whether the files are compressed in archive (invert file's compression flag)
ARCHIVE_RETAINDIR = $0008;
ARCHIVE_RETAINNAME = $0010;
ARCHIVE_RETAINFOFF = $0020;
ARCHIVE_XBOX360 = $0040;
ARCHIVE_STARTUPSTR = $0080;
ARCHIVE_EMBEDNAME = $0100; // Whether the name is prefixed to the data
ARCHIVE_XMEM = $0200;
ARCHIVE_UNKNOWN10 = $0400;
// file flags
FILE_NIF = $0001;
FILE_DDS = $0002;
FILE_XML = $0004;
FILE_WAV = $0008;
FILE_MP3 = $0010;
FILE_TXT = $0020; // TXT, HTML, BAT, SCC
FILE_SPT = $0040;
FILE_FNT = $0080; // TEX, FNT
FILE_MISC = $0100; // CTL and others
FILE_SIZE_COMPRESS = $40000000; // Whether the file is compressed
crc32table : array [0..255] of Cardinal = (
$00000000, $77073096, $ee0e612c, $990951ba, $076dc419, $706af48f,
$e963a535, $9e6495a3, $0edb8832, $79dcb8a4, $e0d5e91e, $97d2d988,
$09b64c2b, $7eb17cbd, $e7b82d07, $90bf1d91, $1db71064, $6ab020f2,
$f3b97148, $84be41de, $1adad47d, $6ddde4eb, $f4d4b551, $83d385c7,
$136c9856, $646ba8c0, $fd62f97a, $8a65c9ec, $14015c4f, $63066cd9,
$fa0f3d63, $8d080df5, $3b6e20c8, $4c69105e, $d56041e4, $a2677172,
$3c03e4d1, $4b04d447, $d20d85fd, $a50ab56b, $35b5a8fa, $42b2986c,
$dbbbc9d6, $acbcf940, $32d86ce3, $45df5c75, $dcd60dcf, $abd13d59,
$26d930ac, $51de003a, $c8d75180, $bfd06116, $21b4f4b5, $56b3c423,
$cfba9599, $b8bda50f, $2802b89e, $5f058808, $c60cd9b2, $b10be924,
$2f6f7c87, $58684c11, $c1611dab, $b6662d3d, $76dc4190, $01db7106,
$98d220bc, $efd5102a, $71b18589, $06b6b51f, $9fbfe4a5, $e8b8d433,
$7807c9a2, $0f00f934, $9609a88e, $e10e9818, $7f6a0dbb, $086d3d2d,
$91646c97, $e6635c01, $6b6b51f4, $1c6c6162, $856530d8, $f262004e,
$6c0695ed, $1b01a57b, $8208f4c1, $f50fc457, $65b0d9c6, $12b7e950,
$8bbeb8ea, $fcb9887c, $62dd1ddf, $15da2d49, $8cd37cf3, $fbd44c65,
$4db26158, $3ab551ce, $a3bc0074, $d4bb30e2, $4adfa541, $3dd895d7,
$a4d1c46d, $d3d6f4fb, $4369e96a, $346ed9fc, $ad678846, $da60b8d0,
$44042d73, $33031de5, $aa0a4c5f, $dd0d7cc9, $5005713c, $270241aa,
$be0b1010, $c90c2086, $5768b525, $206f85b3, $b966d409, $ce61e49f,
$5edef90e, $29d9c998, $b0d09822, $c7d7a8b4, $59b33d17, $2eb40d81,
$b7bd5c3b, $c0ba6cad, $edb88320, $9abfb3b6, $03b6e20c, $74b1d29a,
$ead54739, $9dd277af, $04db2615, $73dc1683, $e3630b12, $94643b84,
$0d6d6a3e, $7a6a5aa8, $e40ecf0b, $9309ff9d, $0a00ae27, $7d079eb1,
$f00f9344, $8708a3d2, $1e01f268, $6906c2fe, $f762575d, $806567cb,
$196c3671, $6e6b06e7, $fed41b76, $89d32be0, $10da7a5a, $67dd4acc,
$f9b9df6f, $8ebeeff9, $17b7be43, $60b08ed5, $d6d6a3e8, $a1d1937e,
$38d8c2c4, $4fdff252, $d1bb67f1, $a6bc5767, $3fb506dd, $48b2364b,
$d80d2bda, $af0a1b4c, $36034af6, $41047a60, $df60efc3, $a867df55,
$316e8eef, $4669be79, $cb61b38c, $bc66831a, $256fd2a0, $5268e236,
$cc0c7795, $bb0b4703, $220216b9, $5505262f, $c5ba3bbe, $b2bd0b28,
$2bb45a92, $5cb36a04, $c2d7ffa7, $b5d0cf31, $2cd99e8b, $5bdeae1d,
$9b64c2b0, $ec63f226, $756aa39c, $026d930a, $9c0906a9, $eb0e363f,
$72076785, $05005713, $95bf4a82, $e2b87a14, $7bb12bae, $0cb61b38,
$92d28e9b, $e5d5be0d, $7cdcefb7, $0bdbdf21, $86d3d2d4, $f1d4e242,
$68ddb3f8, $1fda836e, $81be16cd, $f6b9265b, $6fb077e1, $18b74777,
$88085ae6, $ff0f6a70, $66063bca, $11010b5c, $8f659eff, $f862ae69,
$616bffd3, $166ccf45, $a00ae278, $d70dd2ee, $4e048354, $3903b3c2,
$a7672661, $d06016f7, $4969474d, $3e6e77db, $aed16a4a, $d9d65adc,
$40df0b66, $37d83bf0, $a9bcae53, $debb9ec5, $47b2cf7f, $30b5ffe9,
$bdbdf21c, $cabac28a, $53b39330, $24b4a3a6, $bad03605, $cdd70693,
$54de5729, $23d967bf, $b3667a2e, $c4614ab8, $5d681b02, $2a6f2b94,
$b40bbe37, $c30c8ea1, $5a05df1b, $2d02ef8d
);
type
TPreallocatedMemoryStream = class(TCustomMemoryStream)
public
constructor Create(Ptr: Pointer; Size: Int64);
function Write(const Buffer; Count: Longint): Longint; override;
end;
constructor TPreallocatedMemoryStream.Create(Ptr: Pointer; Size: Int64);
begin
inherited Create;
SetPointer(Ptr, Size);
end;
function TPreallocatedMemoryStream.Write(const Buffer; Count: Integer): Longint;
begin
Result := Size-Position;
if Result > Count then
Result := Count;
System.Move(Buffer, Pointer(PByte(Memory) + Position)^, Result);
Seek(Result, soCurrent);
end;
function Magic2Int(aMagic: TMagic4): Cardinal; inline;
begin
Result := PCardinal(@aMagic)^;
end;
function Int2Magic(aInt: Cardinal): TMagic4; inline;
begin
Result := PMagic4(@aInt)^;
end;
function String2Magic(const aStr: string): TMagic4;
begin
Result := #0#0#0#0;
if Length(aStr) > 0 then Result[0] := AnsiChar(aStr[1]);
if Length(aStr) > 1 then Result[1] := AnsiChar(aStr[2]);
if Length(aStr) > 2 then Result[2] := AnsiChar(aStr[3]);
if Length(aStr) > 3 then Result[3] := AnsiChar(aStr[4]);
end;
function LowerByte(ch: AnsiChar): Byte; inline;
begin
case ch of
'A'..'Z':
Result := Byte(Ord(ch) + Ord('a')-Ord('A'));
else
Result := Byte(ch);
end;
end;
function LastCharPos(const s: string; const Chr: char): Integer; inline;
begin
for Result := Length(s) downto 1 do
if s[Result] = Chr then
Exit;
Result := 0;
end;
function Str2MagicInt(const s: string): Cardinal;
var
i: integer;
begin
Result := 0;
for i := 1 to Length(s) do begin
PByte(PByte(@Result) + i-1)^ := LowerByte(AnsiChar(s[i]));
if i = 4 then Break;
end;
end;
function SplitDirName(const aFileName: string; var Dir, Name: string): Integer;
begin
Result := LastCharPos(aFileName, '\');
if Result = 0 then
Result := LastCharPos(aFileName, '/');
if Result <> 0 then begin
Dir := Copy(aFileName, 1, Pred(Result));
Name := Copy(aFileName, Succ(Result), Length(aFileName) - Result);
end
else begin
Dir := '';
Name := aFileName;
end;
end;
function SplitNameExt(const aFileName: string; var Name, Ext: string; aNoExtDot: Boolean = False): Integer;
begin
Result := LastCharPos(aFileName, '.');
if Result <> 0 then begin
Name := Copy(aFileName, 1, Pred(Result));
if aNoExtDot then
Inc(Result);
Ext := Copy(aFileName, Result, Length(aFileName) - Result + 1);
end
else begin
Name := aFileName;
Ext := '';
end;
end;
function CreateHashTES3(const aFileName: string): UInt64;
var
s: AnsiString;
i, l: integer;
sum, off, temp, n: Cardinal;
begin
s := AnsiString(aFileName);
l := Length(s) shr 1;
sum := 0; off := 0;
for i := 1 to l do begin
temp := Cardinal(LowerByte(s[i])) shl (off and $1F);
sum := sum xor temp;
off := off + 8;
end;
Result := UInt64(sum) shl 32;
sum := 0; off := 0;
for i := l + 1 to Length(s) do begin
temp := Cardinal(LowerByte(s[i])) shl (off and $1F);
sum := sum xor temp;
n := temp and $1F;
sum := (sum shr n) or (sum shl (32 - n));
off := off + 8;
end;
Result := Result or sum;
end;
function CreateHashTES4(const aName, aExt: string): UInt64; overload;
var
i, l: integer;
hash: Cardinal;
ext: array [0..3] of Byte;
s, e: AnsiString;
begin
Result := 0;
s := AnsiString(aName);
e := AnsiString(aExt);
l := Length(s);
if l = 0 then
Exit;
Result := LowerByte(s[l]);
if l > 2 then
Result := Result or (Cardinal(LowerByte(s[l-1])) shl 8);
Result := Result or (l shl 16);
Result := Result or (Cardinal(LowerByte(s[1])) shl 24);
PCardinal(@ext)^ := 0;
for i := 1 to Length(e) do begin
ext[i-1] := LowerByte(e[i]);
if i = 4 then Break;
end;
case PCardinal(@ext)^ of
$00666B2E: Result := Result or $80; // .kf
$66696E2E: Result := Result or $8000; // .nif
$7364642E: Result := Result or $8080; // .dds
$7661772E: Result := Result or $80000000; // .wav
end;
hash := 0;
for i := 2 to l-2 do
hash := LowerByte(s[i]) + (hash shl 6) + (hash shl 16) - hash;
Result := Result + UInt64(hash) shl 32;
hash := 0;
for i := 1 to Length(e) do
hash := LowerByte(e[i]) + (hash shl 6) + (hash shl 16) - hash;
Result := Result + UInt64(hash) shl 32;
end;
function CreateHashTES4(const aFileName: string): UInt64; overload;
var
fname, fext: string;
begin
SplitNameExt(aFileName, fname, fext);
Result := CreateHashTES4(fname, fext);
end;
function CreateHashFO4(const aFileName: string): Cardinal;
var
i: Integer;
s: AnsiString;
c: AnsiChar;
begin
Result := 0;
s := AnsiString(aFileName);
for i := 1 to Length(s) do begin
c := s[i];
if Byte(c) > 127 then Continue;
if c = '/' then c := '\';
Result := (Result shr 8) xor crc32table[(Result xor LowerByte(c)) and $FF];
end;
end;
function TwbBSFileTES4.Compress(bsa: TwbBSArchive): Boolean;
begin
case PackingCompression of
pcCompress : Result := True;
pcUncompress: Result := False;
else
Result := bsa.Compress;
end;
end;
function TwbBSFileTES4.Compressed(bsa: TwbBSArchive): Boolean;
begin
Result := (bsa.ArchiveFlags and ARCHIVE_COMPRESS <> 0) xor (Size and FILE_SIZE_COMPRESS <> 0);
end;
function TwbBSFileTES4.RawSize: Cardinal;
begin
Result := Size and not FILE_SIZE_COMPRESS;
end;
function TwbBSFileFO4.DXGIFormatName: string;
begin
Result := GetEnumName(TypeInfo(TDXGI), Integer(DXGIFormat));
end;
function TwbBSFileFO4.Compress(bsa: TwbBSArchive): Boolean;
begin
case PackingCompression of
pcCompress : Result := True;
pcUncompress: Result := False;
else
Result := bsa.Compress;
end;
end;
function TwbBSFileFO4.Compressed(bsa: TwbBSArchive): Boolean;
begin
if bsa.ArchiveType = baFO4 then
Result := PackedSize <> 0
else
Result := (Length(TexChunks) <> 0) and (TexChunks[0].PackedSize <> 0);
end;
{ TwbBSArchive }
constructor TwbBSArchive.Create;
begin
fType := baNone;
fMaxChunkCount := 4;
fSingleMipChunkX := 512;
fSingleMipChunkY := 512;
end;
destructor TwbBSArchive.Destroy;
begin
if fStates * [stReading, stWriting] <> [] then
Close;
end;
function TwbBSArchive.GetArchiveFormatName: string;
begin
Result := cArchiveFormatNames[fType];
end;
function TwbBSArchive.GetFileCount: Cardinal;
begin
case fType of
baTES3:
Result := fHeaderTES3.FileCount;
baTES4, baFO3, baSSE:
Result := fHeaderTES4.FileCount;
baFO4, baFO4dds, baSF, baSFdds:
Result := fHeaderFO4.FileCount;
else
Result := 0;
end;
end;
procedure TwbBSArchive.SetArchiveFlags(aFlags: Cardinal);
begin
if not (fType in [baTES4, baFO3, baSSE]) then
raise Exception.Create('Archive flags are not supported for this archive type');
fHeaderTES4.Flags := aFlags;
// force compression flag if needed
if fCompress then
fHeaderTES4.Flags := fHeaderTES4.Flags or ARCHIVE_COMPRESS;
end;
procedure TwbBSArchive.SetMultiThreaded(aValue: Boolean);
begin
fMultiThreaded := aValue;
{$IF CompilerVersion < 34.0}
if aValue and not Assigned(Sync) then
Sync := TReadWriteSync.Create;
{$IFEND}
end;
function TwbBSArchive.FindFileRecordTES3(const aFileName: string; var aFileIdx: Integer): Boolean;
var
h: UInt64;
i: integer;
begin
h := CreateHashTES3(aFileName);
Result := False;
for i := Low(fFilesTES3) to High(fFilesTES3) do
if fFilesTES3[i].Hash = h then begin
aFileIdx := i;
Result := True;
Exit;
end;
end;
function TwbBSArchive.FindFileRecordTES4(const aFileName: string; var aFolderIdx, aFileIdx: Integer): Boolean;
var
fdir, fname, name, ext: string;
h: UInt64;
i, j: integer;
begin
SplitDirName(aFileName, fdir, fname);
Result := False;
h := CreateHashTES4(fdir, '');
for i := Low(fFoldersTES4) to High(fFoldersTES4) do begin
if h <> fFoldersTES4[i].Hash then
// since table is sorted by hash, we can abort when our hash is lesser
if h < fFoldersTES4[i].Hash then
Exit
else
Continue;
SplitNameExt(fname, name, ext);
h := CreateHashTES4(name, ext);
for j := Low(fFoldersTES4[i].Files) to High(fFoldersTES4[i].Files) do begin
if h <> fFoldersTES4[i].Files[j].Hash then
if h < fFoldersTES4[i].Files[j].Hash then
Exit
else
Continue;
Result := True;
aFolderIdx := i;
aFileIdx := j;
Exit;
end;
end;
end;
function TwbBSArchive.FindFileRecordFO4(const aFileName: string; var aFileIdx: Integer): Boolean;
var
fdir, fname, name, ext: string;
hdir, hfile: Cardinal;
hext: TMagic4;
i: integer;
begin
SplitDirName(aFileName, fdir, fname);
SplitNameExt(fname, name, ext, True);
hdir := CreateHashFO4(fdir);
hfile := CreateHashFO4(name);
hext := String2Magic(LowerCase(ext));
Result := False;
for i := Low(fFilesFO4) to High(fFilesFO4) do
if (fFilesFO4[i].DirHash = hdir) and (fFilesFO4[i].NameHash = hfile) and (fFilesFO4[i].Ext = hext) then begin
aFileIdx := i;
Result := True;
Exit;
end;
end;
function TwbBSArchive.FindFileRecord(const aFileName: string): Pointer;
var
i, j: integer;
begin
Result := nil;
case fType of
baTES3:
if FindFileRecordTES3(aFileName, i) then Result := @fFilesTES3[i];
baTES4, baFO3, baSSE:
if FindFileRecordTES4(aFileName, i, j) then Result := @fFoldersTES4[i].Files[j];
baFO4, baFO4dds, baSF, baSFdds:
if FindFileRecordFO4(aFileName, i) then Result := @fFilesFO4[i];
end;
end;
function TwbBSArchive.GetDDSMipChunkNum(var aDDSInfo: TDDSInfo): Integer;
var
w, h: Integer;
begin
w := aDDSInfo.Width;
h := aDDSInfo.Height;
Result := 1;
while (Result < aDDSInfo.MipMaps) and
(Result < fMaxChunkCount) and
(w >= fSingleMipChunkX) and
(h >= fSingleMipChunkY)
do begin
Inc(Result);
w := w div 2;
h := h div 2;
end;
end;
function TwbBSArchive.CalcDataHash(aData: Pointer; aLen: Cardinal): TPackedDataHash;
var
fMD5: TMD5Alg;
begin
fMD5.Init(@fMD5);
fMD5.Update(@fMD5, aData, aLen);
fMD5.Done(@fMD5, @Result);
end;
function TwbBSArchive.FindPackedData(aSize: Cardinal; aHash: TPackedDataHash; aFileRecord: Pointer): Boolean;
var
i: Integer;
begin
Result := False;
if not fShareData then
Exit;
for i := 0 to Pred(fPackedDataCount) do
if (aSize = fPackedData[i].Size) and CompareMem(@aHash, @fPackedData[i].Hash, SizeOf(aHash)) then begin
case fType of
baTES3: begin
PwbBSFileTES3(aFileRecord).Size := PwbBSFileTES3(fPackedData[i].FileRecord).Size;
PwbBSFileTES3(aFileRecord).Offset := PwbBSFileTES3(fPackedData[i].FileRecord).Offset;
end;
baTES4, baFO3, baSSE: begin
PwbBSFileTES4(aFileRecord).Size := PwbBSFileTES4(fPackedData[i].FileRecord).Size;
PwbBSFileTES4(aFileRecord).Offset := PwbBSFileTES4(fPackedData[i].FileRecord).Offset;
end;
baFO4, baSF: begin
PwbBSFileFO4(aFileRecord).Size := PwbBSFileFO4(fPackedData[i].FileRecord).Size;
PwbBSFileFO4(aFileRecord).PackedSize := PwbBSFileFO4(fPackedData[i].FileRecord).PackedSize;
PwbBSFileFO4(aFileRecord).Offset := PwbBSFileFO4(fPackedData[i].FileRecord).Offset;
end;
baFO4dds, baSFdds: begin
PwbBSTexChunkRec(aFileRecord).Size := PwbBSTexChunkRec(fPackedData[i].FileRecord).Size;
PwbBSTexChunkRec(aFileRecord).PackedSize := PwbBSTexChunkRec(fPackedData[i].FileRecord).PackedSize;
PwbBSTexChunkRec(aFileRecord).Offset := PwbBSTexChunkRec(fPackedData[i].FileRecord).Offset;
end;
end;
Result := True;
Exit;
end;
end;
procedure TwbBSArchive.AddPackedData(aSize: Cardinal; aHash: TPackedDataHash; aFileRecord: Pointer);
begin
if not fShareData then
Exit;
if fPackedDataCount = Length(fPackedData) then
if Length(fPackedData) = 0 then
SetLength(fPackedData, 2048)
else
SetLength(fPackedData, Length(fPackedData) * 2);
fPackedData[fPackedDataCount].Size := aSize;
fPackedData[fPackedDataCount].Hash := aHash;
fPackedData[fPackedDataCount].FileRecord := aFileRecord;
Inc(fPackedDataCount);
end;
procedure TwbBSArchive.LoadFromFile(const aFileName: string);
var
i, j: Integer;
begin
if fStates * [stReading, stWriting] <> [] then
Close;
fStream := TwbReadOnlyCachedFileStream.Create(aFileName, fmOpenRead or fmShareDenyWrite);
// magic
fMagic := Int2Magic(fStream.ReadCardinal);
if fMagic = MAGIC_TES3 then fType := baTES3 else
if fMagic = MAGIC_BSA then fType := baTES4 else
if fMagic = MAGIC_BTDX then fType := baFO4 else
raise Exception.Create('Unknown archive format');
// archive version except Morrowind
if fType <> baTES3 then begin
fVersion := fStream.ReadCardinal;
fCompressionType := ctZlib; // default compression type
case fVersion of
HEADER_VERSION_TES4:
fType := baTES4;
HEADER_VERSION_FO3 :
fType := baFO3;
HEADER_VERSION_SSE :
fType := baSSE;
HEADER_VERSION_FO4v1,
HEADER_VERSION_FO4NGv7,
HEADER_VERSION_FO4NGv8 :
fType := baFO4;
HEADER_VERSION_SF2,
HEADER_VERSION_SF3:
fType := baSF;
else
raise Exception.Create('Unknown archive version 0x' + IntToHex(fVersion, 8));
end;
end;
case fType of
//--------------------------------------------------
// Morrowind
baTES3: begin
// read header
fStream.ReadBuffer(fHeaderTES3, SizeOf(fHeaderTES3));
SetLength(fFilesTES3, fHeaderTES3.FileCount);
for i := Low(fFilesTES3) to High(fFilesTES3) do begin
fFilesTES3[i].Size := fStream.ReadCardinal;
fFilesTES3[i].Offset := fStream.ReadCardinal;
end;
// skip name offsets
fStream.Position := fStream.Position + 4 * fHeaderTES3.FileCount;
// read names
for i := Low(fFilesTES3) to High(fFilesTES3) do
fFilesTES3[i].Name := fStream.ReadStringTerm;
// read hashes
for i := Low(fFilesTES3) to High(fFilesTES3) do
fFilesTES3[i].Hash := fStream.ReadUInt64;
// remember binary data offset since stored files offsets are relative
fDataOffset := fStream.Position;
end;
//--------------------------------------------------
// Fallout 4, Starfield
baFO4, baSF: begin
// read header
fStream.ReadBuffer(fHeaderFO4, SizeOf(fHeaderFO4));
// SF header
if fType = baSF then
if fVersion = HEADER_VERSION_SF2 then
fStream.ReadBuffer(fHeaderSFv2, SizeOf(fHeaderSFv2))
else begin
fStream.ReadBuffer(fHeaderSFv3, SizeOf(fHeaderSFv3));
if fHeaderSFv3.CompressionMethod = 3 then
fCompressionType := ctLZ4Block;
end;
// read GNRL files
if fHeaderFO4.Magic = MAGIC_GNRL then begin
SetLength(fFilesFO4, fHeaderFO4.FileCount);
for i := Low(fFilesFO4) to High(fFilesFO4) do begin
fFilesFO4[i].NameHash := fStream.ReadCardinal;
fFilesFO4[i].Ext := Int2Magic(fStream.ReadCardinal);
fFilesFO4[i].DirHash := fStream.ReadCardinal;
fFilesFO4[i].Unknown := fStream.ReadCardinal;
fFilesFO4[i].Offset := fStream.ReadInt64;
fFilesFO4[i].PackedSize := fStream.ReadCardinal;
fFilesFO4[i].Size := fStream.ReadCardinal;
fStream.ReadCardinal; // BAADF00D
end;
end
// read DX10 textures
else if fHeaderFO4.Magic = MAGIC_DX10 then begin
if fType = baFO4 then
fType := baFO4dds
else if fType = baSF then
fType := baSFdds;
SetLength(fFilesFO4, fHeaderFO4.FileCount);
for i := Low(fFilesFO4) to High(fFilesFO4) do begin
fFilesFO4[i].NameHash := fStream.ReadCardinal;
fFilesFO4[i].Ext := Int2Magic(fStream.ReadCardinal);
fFilesFO4[i].DirHash := fStream.ReadCardinal;
fFilesFO4[i].UnknownTex := fStream.ReadByte;
SetLength(fFilesFO4[i].TexChunks, fStream.ReadByte);
fStream.ReadWord; // skip chunkHeaderSize, always 24
//fFilesFO4[i].ChunkHeaderSize := fStream.ReadWord;
fFilesFO4[i].Height := fStream.ReadWord;
fFilesFO4[i].Width := fStream.ReadWord;
fFilesFO4[i].NumMips := fStream.ReadByte;
fFilesFO4[i].DXGIFormat := fStream.ReadByte;
fFilesFO4[i].CubeMaps := fStream.ReadWord;
for j := Low(fFilesFO4[i].TexChunks) to High(fFilesFO4[i].TexChunks) do
with fFilesFO4[i].TexChunks[j] do begin
Offset := fStream.ReadInt64;
PackedSize := fStream.ReadCardinal;
Size := fStream.ReadCardinal;
StartMip := fStream.ReadWord;
EndMip := fStream.ReadWord;
fStream.ReadCardinal; // skip BAADF00D
end;
end;
end
else
raise Exception.Create('Unknown BA2 archive type');
// read file names
fStream.Position := fHeaderFO4.FileTableOffset;
for i := Low(fFilesFO4) to High(fFilesFO4) do
fFilesFO4[i].Name := StringReplace(fStream.ReadStringLen16, '/', '\', [rfReplaceAll]);
end;
//--------------------------------------------------
// Oblivion, Fallout 3, New Vegas, Skyrim, Skyrim SE
baTES4, baFO3, baSSE: begin
if fType = baSSE then
fCompressionType := ctLZ4Frame;
// read header
fStream.ReadBuffer(fHeaderTES4, SizeOf(fHeaderTES4));
fStream.Position := fHeaderTES4.FoldersOffset;
// read folder records
SetLength(fFoldersTES4, fHeaderTES4.FolderCount);
for i := Low(fFoldersTES4) to High(fFoldersTES4) do begin
fFoldersTES4[i].Hash := fStream.ReadUInt64;
fFoldersTES4[i].FileCount := fStream.ReadCardinal;
if fType = baSSE then begin
fFoldersTES4[i].Unk32 := fStream.ReadCardinal;
fFoldersTES4[i].Offset := fStream.ReadInt64;
end else
fFoldersTES4[i].Offset := fStream.ReadCardinal;
end;
// read folder names and file records
for i := Low(fFoldersTES4) to High(fFoldersTES4) do begin
fFoldersTES4[i].Name := fStream.ReadStringLen;
SetLength(fFoldersTES4[i].Files, fFoldersTES4[i].FileCount);
for j := Low(fFoldersTES4[i].Files) to High(fFoldersTES4[i].Files) do begin
fFoldersTES4[i].Files[j].Hash := fStream.ReadUInt64;
fFoldersTES4[i].Files[j].Size := fStream.ReadCardinal;
fFoldersTES4[i].Files[j].Offset := fStream.ReadCardinal;
end;
end;
// read file names
for i := Low(fFoldersTES4) to High(fFoldersTES4) do
for j := Low(fFoldersTES4[i].Files) to High(fFoldersTES4[i].Files) do
fFoldersTES4[i].Files[j].Name := fStream.ReadStringTerm;
end;
end;
fFileName := aFileName;
Include(fStates, stReading);
end;
type
THashPair = record DirHash, FileHash: UInt64; pc: TPackingCompression end;
PHashPair = ^THashPair;
function HashPairSort(List: TStringList; Index1, Index2: Integer): Integer;
var
h1, h2: PHashPair;
begin
h1 := PHashPair(List.Objects[Index1]);
h2 := PHashPair(List.Objects[Index2]);
if h1.DirHash < h2.DirHash then
Result := -1
else if h1.DirHash > h2.DirHash then
Result := 1
else if h1.FileHash < h2.FileHash then
Result := -1
else if h1.FileHash > h2.FileHash then
Result := 1
else
Result := 0;
end;
function AlphabeticalSort(List: TStringList; Index1, Index2: Integer): Integer;
begin
Result := CompareStr(List[Index1], List[Index2]);
end;
procedure TwbBSArchive.CreateArchive(const aFileName: string; aType: TBSArchiveType;
aFilesList: TStringList = nil);
var
HashPairs: array of THashPair;
h: PHashPair;
hdir: UInt64;
s, fdir, fname, fext, name: string;
i, len, folderidx, fileidx: Integer;
Buffer: TBytes;
ddsinfo: TDDSInfo;
begin
if stReading in fStates then
Close;
if stWriting in fStates then
raise Exception.Create('Archive is already being created');
case aType of
baTES3: begin
fMagic := MAGIC_TES3;
end;
baTES4: begin
fVersion := HEADER_VERSION_TES4;
fMagic := MAGIC_BSA;
fHeaderTES4.Flags := ARCHIVE_PATHNAMES or ARCHIVE_FILENAMES or ARCHIVE_EMBEDNAME or ARCHIVE_XMEM or ARCHIVE_UNKNOWN10;
fHeaderTES4.FileFlags := 0;
fHeaderTES4.FoldersOffset := SizeOf(fMagic) + SizeOf(fVersion) + SizeOf(fHeaderTES4);
fCompressionType := ctZlib;
end;
baFO3: begin
fVersion := HEADER_VERSION_FO3;
fMagic := MAGIC_BSA;
fHeaderTES4.Flags := ARCHIVE_PATHNAMES or ARCHIVE_FILENAMES;
fHeaderTES4.FileFlags := 0;
fHeaderTES4.FoldersOffset := SizeOf(fMagic) + SizeOf(fVersion) + SizeOf(fHeaderTES4);
fCompressionType := ctZlib;
end;
baSSE: begin
fVersion := HEADER_VERSION_SSE;
fMagic := MAGIC_BSA;
fHeaderTES4.Flags := ARCHIVE_PATHNAMES or ARCHIVE_FILENAMES;
fHeaderTES4.FileFlags := 0;
fHeaderTES4.FoldersOffset := SizeOf(fMagic) + SizeOf(fVersion) + SizeOf(fHeaderTES4);
fCompressionType := ctLZ4Frame;
end;
baFO4: begin
fMagic := MAGIC_BTDX;
fHeaderFO4.Magic := MAGIC_GNRL;
fVersion := HEADER_VERSION_FO4v1;
fCompressionType := ctZlib;
end;
baFO4dds: begin
fMagic := MAGIC_BTDX;
fHeaderFO4.Magic := MAGIC_DX10;
fVersion := HEADER_VERSION_FO4v1;
fCompressionType := ctZlib;
end;
baSF: begin
fMagic := MAGIC_BTDX;
fHeaderFO4.Magic := MAGIC_GNRL;
fVersion := HEADER_VERSION_SF2;
fCompressionType := ctZlib;
end;
baSFdds: begin
fMagic := MAGIC_BTDX;
fHeaderFO4.Magic := MAGIC_DX10;
fVersion := HEADER_VERSION_SF3;
fCompressionType := ctLZ4Block;
end;
else
raise Exception.Create('Unsupported archive type');
end;
fType := aType;
if fType in [baTES3] then begin
if not Assigned(aFilesList) or (aFilesList.Count = 0) then
raise Exception.Create('Archive requires predefined files list');
// sort files by hashes
SetLength(HashPairs, aFilesList.Count);
for i := 0 to Pred(aFilesList.Count) do begin
h := @HashPairs[i];
h.FileHash := CreateHashTES3(aFilesList[i]);
aFilesList.Objects[i] := Pointer(h);
end;
aFilesList.CustomSort(HashPairSort);
// create file records and calculate total names length
SetLength(fFilesTES3, aFilesList.Count);
len := 0;
for i := 0 to Pred(aFilesList.Count) do begin
fFilesTES3[i].Hash := PHashPair(aFilesList.Objects[i]).FileHash;
fFilesTES3[i].Name := LowerCase(aFilesList[i]);
Inc(len, Length(fFilesTES3[i].Name) + 1); // include terminator
end;
// offset to hash table
fDataOffset := SizeOf(fMagic) + SizeOf(fHeaderTES3) +
8 * Length(fFilesTES3) + // File sizes/offsets
4 * Length(fFilesTES3) + // Archive directory/name offsets
len; // Filename records
// stored as minus 12 (for header size)
fHeaderTES3.HashOffset := fDataOffset - 12;
fHeaderTES3.FileCount := aFilesList.Count;
// offset to files data
fDataOffset := fDataOffset + 8 * Length(fFilesTES3); // Hash table
// files are stored alphabetically in the data section in vanilla archives
// not really needed but whatever
aFilesList.CustomSort(AlphabeticalSort);
end
else if fType in [baTES4, baFO3, baSSE] then begin
if not Assigned(aFilesList) or (aFilesList.Count = 0) then
raise Exception.Create('Archive requires predefined files list');
fHeaderTES4.FolderNamesLength := 0;
fHeaderTES4.FileNamesLength := 0;
// dirs and files must be sorted by their hashes
SetLength(HashPairs, aFilesList.Count);
for i := 0 to Pred(aFilesList.Count) do begin
h := @HashPairs[i];
if SplitDirName(aFilesList[i], fdir, fname) = 0 then
raise Exception.Create('File is missing the folder part: ' + aFilesList[i]);
// calculate hashes
h.DirHash := CreateHashTES4(fdir, '');
SplitNameExt(fname, s, fext);
h.FileHash := CreateHashTES4(s, fext);
h.pc := TPackingCompression(aFilesList.Objects[i]);
aFilesList.Objects[i] := Pointer(h);
fext := LowerCase(fext);
with fHeaderTES4 do begin
// determine file flags
if fdir.StartsWith('meshes\', True) then FileFlags := FileFlags or FILE_NIF else
if fdir.StartsWith('textures\', True) then FileFlags := FileFlags or FILE_DDS else
if fdir.StartsWith('sound\', True) then FileFlags := FileFlags or FILE_WAV or FILE_MP3 else
if fext = '.nif' then FileFlags := FileFlags or FILE_NIF else
if fext = '.lod' then FileFlags := FileFlags or FILE_NIF else
if fext = '.bto' then FileFlags := FileFlags or FILE_NIF else
if fext = '.btr' then FileFlags := FileFlags or FILE_NIF else
if fext = '.btt' then FileFlags := FileFlags or FILE_NIF else
if fext = '.dtl' then FileFlags := FileFlags or FILE_NIF else
if fext = '.kf' then FileFlags := FileFlags or FILE_NIF else
if fext = '.kfm' then FileFlags := FileFlags or FILE_NIF else
if fext = '.hkx' then FileFlags := FileFlags or FILE_NIF else
if fext = '.dds' then FileFlags := FileFlags or FILE_DDS else
if fext = '.xml' then FileFlags := FileFlags or FILE_XML or FILE_MISC else
if fext = '.wav' then FileFlags := FileFlags or FILE_WAV else
if fext = '.fuz' then FileFlags := FileFlags or FILE_WAV else
if fext = '.lip' then FileFlags := FileFlags or FILE_MP3 else
if fext = '.mp3' then FileFlags := FileFlags or FILE_MP3 else
if fext = '.ogg' then FileFlags := FileFlags or FILE_MP3 else
if fext = '.txt' then FileFlags := FileFlags or FILE_TXT else
if fext = '.htm' then FileFlags := FileFlags or FILE_TXT else
if fext = '.bat' then FileFlags := FileFlags or FILE_TXT else
if fext = '.scc' then FileFlags := FileFlags or FILE_TXT else
if fext = '.spt' then FileFlags := FileFlags or FILE_SPT else
if fext = '.fnt' then FileFlags := FileFlags or FILE_FNT else
if fext = '.tex' then FileFlags := FileFlags or FILE_FNT else
FileFlags := FileFlags or FILE_MISC;
// determine archive flags
// packed scripts can't be added to objects in the SSE CK if the archive was packed
// without the "RetainNames" flag (the scripts aren't shown in the script adding window)
if fext = '.pex' then ArchiveFlags := ArchiveFlags or ARCHIVE_RETAINNAME;
end;
end;
// sort by hashes
aFilesList.CustomSort(HashPairSort);
// create folder and file records
fHeaderTES4.FileCount := 0;
hdir := 0;
folderidx := -1;
fileidx := 0;
for i := 0 to Pred(aFilesList.Count) do begin
SplitDirName(aFilesList[i], fdir, fname);
h := Pointer(aFilesList.Objects[i]);
// new folder
if h.DirHash <> hdir then begin
Inc(folderidx);
fileidx := 0;
hdir := h.DirHash;
SetLength(fFoldersTES4, folderidx + 1);
fFoldersTES4[folderidx].Hash := h.DirHash;
fFoldersTES4[folderidx].Name := LowerCase(fdir);
// calc folder names length
Inc(fHeaderTES4.FolderNamesLength, Length(fdir) + 1); // + terminator only, length prefix is not counted
end;
SetLength(fFoldersTES4[folderidx].Files, fileidx + 1);
fFoldersTES4[folderidx].Files[fileidx].Hash := h.FileHash;
fFoldersTES4[folderidx].Files[fileidx].Name := LowerCase(fname);
fFoldersTES4[folderidx].Files[fileidx].PackingCompression := h.pc;
Inc(fileidx);
Inc(fFoldersTES4[folderidx].FileCount);
Inc(fHeaderTES4.FileCount);
// calculate file names length
Inc(fHeaderTES4.FileNamesLength, Length(fname) + 1); // + terminator
end;
fHeaderTES4.FolderCount := Length(fFoldersTES4);
// calculate folders offsets
// at the end fDataOffset will hold the total size of header, folder and file records
// in other words the start of files data
fDataOffset := SizeOf(fMagic) + SizeOf(fVersion) + SizeOf(fHeaderTES4) + 16 * Length(fFoldersTES4);
// SSE folder record is 8 bytes larger
if fType = baSSE then
Inc(fDataOffset, 8 * Length(fFoldersTES4));
// Offsets are stored including this value
Inc(fDataOffset, fHeaderTES4.FileNamesLength);
for i := Low(fFoldersTES4) to High(fFoldersTES4) do begin
fFoldersTES4[i].Offset := fDataOffset;
// add folder name length
Inc(fDataOffset, Length(fFoldersTES4[i].Name) + 2); // + length prefix + terminator
// add file records length
Inc(fDataOffset, 16 * Length(fFoldersTES4[i].Files));
end;
// final flags detection
// misc file flag is not in Skyrim SE
if fType = baSSE then
fHeaderTES4.FileFlags := fHeaderTES4.FileFlags and not FILE_MISC;
// embedded names in texture only archives
// except Skyrim SE: crashing engine bug if texture is uncompressed and file name is embedded
if (fHeaderTES4.FileFlags = FILE_DDS) and (fType <> baSSE) then
fHeaderTES4.Flags := fHeaderTES4.Flags or ARCHIVE_EMBEDNAME;
// startupstr flag in archives with meshes
if fHeaderTES4.FileFlags and FILE_NIF <> 0 then
fHeaderTES4.Flags := fHeaderTES4.Flags or ARCHIVE_STARTUPSTR;
// retainname flag in archives with sounds
if fHeaderTES4.FileFlags and FILE_WAV <> 0 then
fHeaderTES4.Flags := fHeaderTES4.Flags or ARCHIVE_RETAINNAME;
// txt, xml and fnt file flags are exclusive for Oblivion
if fType <> baTES4 then
fHeaderTES4.FileFlags := fHeaderTES4.FileFlags and not (FILE_XML or FILE_TXT or FILE_FNT);
// set compression flag if needed
if fCompress then
fHeaderTES4.Flags := fHeaderTES4.Flags or ARCHIVE_COMPRESS;
end
else if fType in [baFO4, baFO4dds, baSF, baSFdds] then begin
if not Assigned(aFilesList) or (aFilesList.Count = 0) then
raise Exception.Create('Archive requires predefined files list');
fHeaderFO4.FileCount := aFilesList.Count;
SetLength(fFilesFO4, aFilesList.Count);
for i := 0 to Pred(aFilesList.Count) do begin
if SplitDirName(aFilesList[i], fdir, fname) = 0 then
raise Exception.Create('File is missing the folder part: ' + aFileName);
SplitNameExt(fname, name, fext, True);
// archive2.exe uses /
fFilesFO4[i].Name := StringReplace(aFilesList[i], '\', '/', [rfReplaceAll]);
fFilesFO4[i].DirHash := CreateHashFO4(fdir);
fFilesFO4[i].NameHash := CreateHashFO4(name);
fFilesFO4[i].Ext := String2Magic(LowerCase(fext));
fFilesFO4[i].Unknown := iFileFO4Unknown;
fFilesFO4[i].PackingCompression := TPackingCompression(aFilesList.Objects[i]);
end;
fDataOffset := SizeOf(fMagic) + SizeOf(fVersion) + SizeOf(fHeaderFO4);
if fType = baSF then
Inc(fDataOffset, SizeOf(fHeaderSFv2))
else if fType = baSFdds then
Inc(fDataOffset, SizeOf(fHeaderSFv3));
// file records have fixed length in general archive
if fType in [baFO4, baSF] then
fDataOffset := fDataOffset + 36 * Length(fFilesFO4)
// variable file record length depending on DDS chunks number
else if fType in [baFO4dds, baSFdds] then begin
if not Assigned(fDDSInfoProc) then
raise Exception.Create('DDS archive requires DDS file information callback');
for i := 0 to Pred(aFilesList.Count) do begin
fDDSInfoProc(Self, aFilesList[i], ddsinfo, Self.fDDSInfoProcContext);
fDataOffset := fDataOffset + 24 {size of file record} + 24 {size of each texchunk} * GetDDSMipChunkNum(ddsinfo);
end;
end;
end;
fStream := TwbWriteCachedFileStream.Create(aFileName, fmCreate);
fFileName := aFileName;
Include(fStates, stWriting);
// reserve space for the header
SetLength(Buffer, fDataOffset);
fStream.Write(Buffer[0], Length(Buffer));
end;
procedure TwbBSArchive.Save;
var
i, j: integer;
begin
if not (stWriting in fStates) then
raise Exception.Create('Archive is not in writing mode');
case fType of
baTES3: begin
for i := Low(fFilesTES3) to High(fFilesTES3) do
if fFilesTES3[i].Offset = 0 then
raise Exception.Create('Archived file has no data: ' + fFilesTES3[i].Name);
// write header
fStream.Position := 0;
// magic, header record
fStream.Write(fMagic, SizeOf(fMagic));
fStream.Write(fHeaderTES3, SizeOf(fHeaderTES3));
// file sizes/offsets
for i := Low(fFilesTES3) to High(fFilesTES3) do begin
fStream.WriteCardinal(fFilesTES3[i].Size);
fStream.WriteCardinal(fFilesTES3[i].Offset - fDataOffset); // offsets are relative
end;
// Archive directory/name offsets
j := 0;
for i := Low(fFilesTES3) to High(fFilesTES3) do begin
fStream.WriteCardinal(j);
Inc(j, Length(fFilesTES3[i].Name) + 1); // including terminator
end;
// Filename records
for i := Low(fFilesTES3) to High(fFilesTES3) do
fStream.WriteStringTerm(fFilesTES3[i].Name);
// Hash table
for i := Low(fFilesTES3) to High(fFilesTES3) do begin
fStream.WriteCardinal(fFilesTES3[i].Hash shr 32);
fStream.WriteCardinal(fFilesTES3[i].Hash and $FFFFFFFF);
end;
end;
baTES4, baFO3, baSSE: begin
// check that all files from files table have saved data
for i := Low(fFoldersTES4) to High(fFoldersTES4) do
for j := Low(fFoldersTES4[i].Files) to High(fFoldersTES4[i].Files) do
if fFoldersTES4[i].Files[j].Offset = 0 then
raise Exception.Create('Archived file has no data: ' + fFoldersTES4[i].Name + '\' + fFoldersTES4[i].Files[j].Name);
// write header
fStream.Position := 0;
// magic, version, header record
fStream.Write(fMagic, SizeOf(fMagic));
fStream.Write(fVersion, SizeOf(fVersion));
fStream.Write(fHeaderTES4, SizeOf(fHeaderTES4));
// folder records
for i := Low(fFoldersTES4) to High(fFoldersTES4) do begin
fStream.WriteUInt64(fFoldersTES4[i].Hash);
fStream.WriteCardinal(fFoldersTES4[i].FileCount);
if fType = baSSE then begin
fStream.WriteCardinal(fFoldersTES4[i].Unk32);
fStream.WriteInt64(fFoldersTES4[i].Offset);
end else
fStream.WriteCardinal(fFoldersTES4[i].Offset);
end;
// file records
for i := Low(fFoldersTES4) to High(fFoldersTES4) do begin
fStream.WriteStringLen(fFoldersTES4[i].Name);
for j := Low(fFoldersTES4[i].Files) to High(fFoldersTES4[i].Files) do begin
fStream.WriteUInt64(fFoldersTES4[i].Files[j].Hash);
fStream.WriteCardinal(fFoldersTES4[i].Files[j].Size);
fStream.WriteCardinal(fFoldersTES4[i].Files[j].Offset);
end;
end;
// file names
for i := Low(fFoldersTES4) to High(fFoldersTES4) do
for j := Low(fFoldersTES4[i].Files) to High(fFoldersTES4[i].Files) do
fStream.WriteStringTerm(fFoldersTES4[i].Files[j].Name);
end;
baFO4, baSF: begin
for i := Low(fFilesFO4) to High(fFilesFO4) do
if fFilesFO4[i].Offset = 0 then
raise Exception.Create('Archived file has no data: ' + fFilesFO4[i].Name);
// file names table
fHeaderFO4.FileTableOffset := fStream.Position;
for i := Low(fFilesFO4) to High(fFilesFO4) do
fStream.WriteStringLen16(fFilesFO4[i].Name);
// write header
fStream.Position := 0;
// magic, version, header record
fStream.Write(fMagic, SizeOf(fMagic));
fStream.Write(fVersion, SizeOf(fVersion));
fStream.Write(fHeaderFO4, SizeOf(fHeaderFO4));
// additional SF header
if fType = baSF then begin
fHeaderSFv2.Unknown1 := 1;
fHeaderSFv2.Unknown2 := 0;
fStream.Write(fHeaderSFv2, SizeOf(fHeaderSFv2));
end;
// file records
for i := Low(fFilesFO4) to High(fFilesFO4) do begin
fStream.WriteCardinal(fFilesFO4[i].NameHash);
fStream.WriteBuffer(fFilesFO4[i].Ext[0], SizeOf(fFilesFO4[i].Ext));
fStream.WriteCardinal(fFilesFO4[i].DirHash);
fStream.WriteCardinal(fFilesFO4[i].Unknown);
fStream.WriteInt64(fFilesFO4[i].Offset);
fStream.WriteCardinal(fFilesFO4[i].PackedSize);
fStream.WriteCardinal(fFilesFO4[i].Size);
fStream.WriteCardinal(iFileFO4Tail);
end;
end;
baFO4dds, baSFdds: begin
for i := Low(fFilesFO4) to High(fFilesFO4) do
if Length(fFilesFO4[i].TexChunks) = 0 then
raise Exception.Create('Archived file has no data: ' + fFilesFO4[i].Name);
// file names table
fHeaderFO4.FileTableOffset := fStream.Position;
for i := Low(fFilesFO4) to High(fFilesFO4) do
fStream.WriteStringLen16(fFilesFO4[i].Name);
// write header
fStream.Position := 0;
// magic, version, header record
fStream.Write(fMagic, SizeOf(fMagic));
fStream.Write(fVersion, SizeOf(fVersion));
fStream.Write(fHeaderFO4, SizeOf(fHeaderFO4));
// additional SF header
if fType = baSFdds then begin
fHeaderSFv3.Unknown1 := 1;
fHeaderSFv3.Unknown2 := 0;
fHeaderSFv3.CompressionMethod := 3; // lz4
fStream.Write(fHeaderSFv3, SizeOf(fHeaderSFv3));
end;
// file records
for i := Low(fFilesFO4) to High(fFilesFO4) do begin
fStream.WriteCardinal(fFilesFO4[i].NameHash);
fStream.WriteBuffer(fFilesFO4[i].Ext[0], SizeOf(fFilesFO4[i].Ext));
fStream.WriteCardinal(fFilesFO4[i].DirHash);
fStream.WriteByte(fFilesFO4[i].UnknownTex);
fStream.WriteByte(Length(fFilesFO4[i].TexChunks));
fStream.WriteWord(24); // fixed chunk header size
fStream.WriteWord(fFilesFO4[i].Height);
fStream.WriteWord(fFilesFO4[i].Width);
fStream.WriteByte(fFilesFO4[i].NumMips);
fStream.WriteByte(fFilesFO4[i].DXGIFormat);
fStream.WriteWord(fFilesFO4[i].CubeMaps);
for j := Low(fFilesFO4[i].TexChunks) to High(fFilesFO4[i].TexChunks) do
with fFilesFO4[i].TexChunks[j] do begin
fStream.WriteUInt64(Offset);
fStream.WriteCardinal(PackedSize);
fStream.WriteCardinal(Size);
fStream.WriteWord(StartMip);
fStream.WriteWord(EndMip);
fStream.WriteCardinal(iFileFO4Tail);
end;
end;
end;
end;
FreeAndNil(fStream);
Exclude(fStates, stWriting);
Close;
end;
function TwbBSArchive.GetCreatedArchiveSize: Int64;
begin
if (stWriting in fStates) and Assigned(fStream) then
Result := fStream.Position
else
Result := 0;
end;
procedure TwbBSArchive.AddFileDisk(const aFilePath, aSourcePath: string);
var
fname: string;
i: integer;
buffer: PByte;
stream: TFileStream;
begin
if not (stWriting in fStates) then
raise Exception.Create('Archive is not in writing mode');
stream := TFileStream.Create(aSourcePath, fmOpenRead + fmShareDenyNone);
try
// Modified: Make sure memory is zeroed when allocated
buffer := AllocMem(stream.Size);
try
stream.Read(buffer^, stream.Size);
AddFileData(aFilePath, stream.Size, buffer);
finally
if Assigned(buffer) then
FreeMem(buffer);
end;
finally
stream.Free;
end;
end;
procedure TwbBSArchive.AddFileDiskRoot(const aRootDir, aSourcePath: string);
var
fname: string;
i: integer;
begin
i := Length(aRootDir);
if (i > 1) and (aRootDir[Length(aRootDir)] <> '\') then
Inc(i);
fname := Copy(aSourcePath, i + 1, Length(aSourcePath));
AddFileDisk(fname, aSourcePath);
end;
procedure TwbBSArchive.SyncBeginWrite;
begin
if fMultiThreaded then
Sync.BeginWrite;
end;
procedure TwbBSArchive.SyncEndWrite;
begin
if fMultiThreaded then
Sync.EndWrite;
end;
procedure TwbBSArchive.CompressStream(aSrc, aDst: TStream);
begin
case fCompressionType of
ctZlib: ZCompressStream(aSrc, aDst);
ctLZ4Frame: lz4CompressStream(aSrc, aDst);
ctLZ4Block: lz4BlockCompressStream(aSrc, aDst);
else
raise Exception.Create('Archive compression type is undefined');
end;
end;
procedure TwbBSArchive.DecompressBuf(aSrc: Pointer; aSrcSize: Integer; aDst: Pointer; aDstSize: Integer);
begin
case fCompressionType of
ctZlib: try
DecompressToUserBuf(aSrc, aSrcSize, aDst, aDstSize);
except
// ignore zlib's Buffer error since it happens in vanilla "Fallout - Misc.bsa"
// Bethesda probably used old buggy zlib version when packing it
on E: Exception do if E.Message <> 'Buffer error' then raise;
end;
ctLZ4Frame: lz4DecompressToUserBuf(aSrc, aSrcSize, aDst, aDstSize);
ctLZ4Block: lz4BlockDecompressToUserBuf(aSrc, aSrcSize, aDst, aDstSize);
end;
end;
procedure TwbBSArchive.PackData(aFileRecord: Pointer; const aFileName: string;
aDataHash: TPackedDataHash; aData: PByte; aSize: Integer;
aCompress: Boolean; aDoCompress: Boolean = False);
var
zStream: TBytesStream;
msData: TPreallocatedMemoryStream;
DataSize: Integer;
Position: Int64;
begin
DataSize := aSize;
zStream := nil;
msData := nil;
if FindPackedData(DataSize, aDataHash, aFileRecord) then
Exit;
try
if aCompress then begin
// compressing in parallel when multithreaded
SyncEndWrite;
try
zStream := TBytesStream.Create;
msData := TPreallocatedMemoryStream.Create(aData, aSize);
CompressStream(msData, zStream);
// leave as compressed if compression reduced the size
// by at least let's say 32 bytes
// or data is forced to be compressed
if aDoCompress or (zStream.Size + 32 < aSize) then begin
aData := @zStream.Bytes[0];
aSize := zStream.Size;
end else
aCompress := False;
finally
SyncBeginWrite;
end;
end;
// let's try to find existing data again if multithreaded
// maybe some other thread has written the same data while we've been busy compressing
// zStream exists if we've really spent time compressing
if fMultiThreaded and Assigned(zStream) then
if FindPackedData(DataSize, aDataHash, aFileRecord) then
Exit;
Position := fStream.Position;
// embedded name for Fallout 3/NV/Skyrim/Skyrim SE
if (fType in [baFO3, baSSE]) and (fHeaderTES4.Flags and ARCHIVE_EMBEDNAME <> 0) then
fStream.WriteStringLen(aFileName, False);
// if compressed then write uncompressed size first for Oblivion/Fallout 3/NV/Skyrim/Skyrim SE
if (fType in [baTES4, baFO3, baSSE]) and aCompress then
fStream.WriteCardinal(DataSize);
fStream.Write(aData^, aSize);
// updating file record
case fType of
baTES3: with PwbBSFileTES3(aFileRecord)^ do begin
Offset := Position;
Size := DataSize;
end;
baTES4, baFO3, baSSE: with PwbBSFileTES4(aFileRecord)^ do begin
Offset := Position;
Size := fStream.Position - Offset;
// compress flag in Size inverts compression status from the header
// set it if archive's compression doesn't match file's compression
if Self.fCompress xor aCompress then
Size := Size or FILE_SIZE_COMPRESS;
end;
baFO4, baSF: with PwbBSFileFO4(aFileRecord)^ do begin
Offset := Position;
Size := DataSize;
if aCompress then
PackedSize := aSize;
end;
baFO4dds, baSFdds: with PwbBSTexChunkRec(aFileRecord)^ do begin
Offset := Position;
Size := DataSize;
if aCompress then
PackedSize := aSize;
end;
end;
AddPackedData(DataSize, aDataHash, aFileRecord);
finally
if Assigned(zStream) then
zStream.Free;
if Assigned(msData) then
msData.Free;
end;
end;
procedure TwbBSArchive.AddFileData(const aFileName: string; const aSize: Cardinal; const aData: PByte);
var
i, j, Off, MipSize, BitsPerPixel: integer;
DataHash: TPackedDataHash;
DDSHeader: PDDSHeader;
DDSHeaderDX10: PDDSHeaderDX10;
DDSInfo: TDDSInfo;
begin
if not (stWriting in fStates) then
raise Exception.Create('Archive is not in writing mode');
// dds mipmaps have their own partial hash calculation down below
if fShareData and not (fType in [baFO4dds, baSFdds]) then
DataHash := CalcDataHash(@aData[0], aSize);
SyncBeginWrite;
try
case fType of
baTES3: begin
if not FindFileRecordTES3(aFileName, i) then
raise Exception.Create('File not found in files table: ' + aFileName);
PackData(@fFilesTES3[i], aFileName, DataHash, @aData[0], aSize, False);
end;
baTES4, baFO3, baSSE: begin
if not FindFileRecordTES4(aFileName, i, j) then
raise Exception.Create('File not found in files table: ' + aFileName);
PackData(
@fFoldersTES4[i].Files[j], fFoldersTES4[i].Name + '\' + fFoldersTES4[i].Files[j].Name,
DataHash, @aData[0], aSize, fFoldersTES4[i].Files[j].Compress(Self)
);
end;
baFO4, baSF: begin
if not FindFileRecordFO4(aFileName, i) then
raise Exception.Create('File not found in files table: ' + aFileName);
fFilesFO4[i].Offset := fStream.Position;
fFilesFO4[i].Size := aSize;
PackData(
@fFilesFO4[i], fFilesFO4[i].Name,
DataHash, @aData[0], aSize, fFilesFO4[i].Compress(Self)
);
end;
baFO4dds, baSFdds: begin
if not FindFileRecordFO4(aFileName, i) then
raise Exception.Create('File not found in files table: ' + aFileName);
fFilesFO4[i].UnknownTex := 0;
// DDS file parameters
DDSHeader := @aData[0];
Off := SizeOf(DDSHeader^); // offset to image data
fFilesFO4[i].Width := DDSHeader.dwWidth;
fFilesFO4[i].Height := DDSHeader.dwHeight;
fFilesFO4[i].NumMips := DDSHeader.dwMipMapCount;
// no mipmaps is equal to a single one
if fFilesFO4[i].NumMips = 0 then
fFilesFO4[i].NumMips := 1;
// DXGI detection
if DDSHeader.ddspf.dwFourCC = MAGIC_DXT1 then
fFilesFO4[i].DXGIFormat := Byte(DXGI_FORMAT_BC1_UNORM)
else if DDSHeader.ddspf.dwFourCC = MAGIC_DXT3 then
fFilesFO4[i].DXGIFormat := Byte(DXGI_FORMAT_BC2_UNORM)
else if DDSHeader.ddspf.dwFourCC = MAGIC_DXT5 then
fFilesFO4[i].DXGIFormat := Byte(DXGI_FORMAT_BC3_UNORM)
else if DDSHeader.ddspf.dwFourCC = MAGIC_ATI1 then
fFilesFO4[i].DXGIFormat := Byte(DXGI_FORMAT_BC4_UNORM)
else if DDSHeader.ddspf.dwFourCC = MAGIC_BC4U then
fFilesFO4[i].DXGIFormat := Byte(DXGI_FORMAT_BC4_UNORM)
else if DDSHeader.ddspf.dwFourCC = MAGIC_BC4S then
fFilesFO4[i].DXGIFormat := Byte(DXGI_FORMAT_BC4_SNORM)
else if DDSHeader.ddspf.dwFourCC = MAGIC_ATI2 then
fFilesFO4[i].DXGIFormat := Byte(DXGI_FORMAT_BC5_UNORM)
else if DDSHeader.ddspf.dwFourCC = MAGIC_BC5U then
fFilesFO4[i].DXGIFormat := Byte(DXGI_FORMAT_BC5_UNORM)
else if DDSHeader.ddspf.dwFourCC = MAGIC_BC5S then
fFilesFO4[i].DXGIFormat := Byte(DXGI_FORMAT_BC5_SNORM)
else if DDSHeader.ddspf.dwFourCC = MAGIC_DX10 then begin
DDSHeaderDX10 := @aData[Off];
Off := Off + SizeOf(DDSHeaderDX10^);
fFilesFO4[i].DXGIFormat := Byte(DDSHeaderDX10.dxgiFormat);
end
else begin
if DDSHeader.ddspf.dwRGBBitCount = 32 then
if DDSHeader.ddspf.dwFlags and DDPF_ALPHAPIXELS = 0 then
fFilesFO4[i].DXGIFormat := Byte(DXGI_FORMAT_B8G8R8X8_UNORM)
else if DDSHeader.ddspf.dwRBitMask = $000000FF then
fFilesFO4[i].DXGIFormat := Byte(DXGI_FORMAT_R8G8B8A8_UNORM)
else
fFilesFO4[i].DXGIFormat := Byte(DXGI_FORMAT_B8G8R8A8_UNORM)
else if DDSHeader.ddspf.dwRGBBitCount = 16 then
if (DDSHeader.ddspf.dwRBitMask = $F800) and (DDSHeader.ddspf.dwGBitMask = $07E0) and
(DDSHeader.ddspf.dwBBitMask = $001F) and (DDSHeader.ddspf.dwABitMask = $0000) then
fFilesFO4[i].DXGIFormat := Byte(DXGI_FORMAT_B5G6R5_UNORM)
else if (DDSHeader.ddspf.dwRBitMask = $7C00) and (DDSHeader.ddspf.dwGBitMask = $03E0) and
(DDSHeader.ddspf.dwBBitMask = $001F) and (DDSHeader.ddspf.dwABitMask = $8000) then
fFilesFO4[i].DXGIFormat := Byte(DXGI_FORMAT_B5G5R5A1_UNORM)
else
fFilesFO4[i].DXGIFormat := Byte(DXGI_FORMAT_R8G8_UNORM)
else if DDSHeader.ddspf.dwRGBBitCount = 8 then
if DDSHeader.ddspf.dwFlags and DDPF_ALPHA <> 0 then
fFilesFO4[i].DXGIFormat := Byte(DXGI_FORMAT_A8_UNORM)
else
fFilesFO4[i].DXGIFormat := Byte(DXGI_FORMAT_R8_UNORM)
else
raise Exception.Create('Unsupported uncompressed DDS format');
end;
// MipMap size detection
case TDXGI(fFilesFO4[i].DXGIFormat) of
DXGI_FORMAT_BC1_UNORM, DXGI_FORMAT_BC1_UNORM_SRGB,
DXGI_FORMAT_BC4_UNORM, DXGI_FORMAT_BC4_SNORM:
BitsPerPixel := 4;
DXGI_FORMAT_BC2_UNORM, DXGI_FORMAT_BC2_UNORM_SRGB,
DXGI_FORMAT_BC3_UNORM, DXGI_FORMAT_BC3_UNORM_SRGB,
DXGI_FORMAT_BC5_UNORM, DXGI_FORMAT_BC5_SNORM,
DXGI_FORMAT_BC6H_SF16, DXGI_FORMAT_BC6H_UF16,
DXGI_FORMAT_BC7_UNORM, DXGI_FORMAT_BC7_UNORM_SRGB,
DXGI_FORMAT_A8_UNORM,
DXGI_FORMAT_R8_SINT, DXGI_FORMAT_R8_SNORM,
DXGI_FORMAT_R8_UINT, DXGI_FORMAT_R8_UNORM:
BitsPerPixel := 8;
DXGI_FORMAT_B5G6R5_UNORM, DXGI_FORMAT_B5G5R5A1_UNORM,
DXGI_FORMAT_R8G8_SINT, DXGI_FORMAT_R8G8_UINT, DXGI_FORMAT_R8G8_UNORM:
BitsPerPixel := 16;
DXGI_FORMAT_B8G8R8A8_UNORM, DXGI_FORMAT_B8G8R8A8_UNORM_SRGB,
DXGI_FORMAT_B8G8R8X8_UNORM, DXGI_FORMAT_B8G8R8X8_UNORM_SRGB,
DXGI_FORMAT_R8G8B8A8_UNORM, DXGI_FORMAT_R8G8B8A8_SINT,
DXGI_FORMAT_R8G8B8A8_UINT, DXGI_FORMAT_R8G8B8A8_UNORM_SRGB:
BitsPerPixel := 32;
else
raise Exception.Create('Unsupported DDS format');
end;
MipSize := (fFilesFO4[i].Width * fFilesFO4[i].Height * BitsPerPixel) shr 3;
// cubemaps detection
fFilesFO4[i].CubeMaps := $800;
if DDSHeader.dwCaps2 and DDSCAPS2_CUBEMAP <> 0 then
fFilesFO4[i].CubeMaps := fFilesFO4[i].CubeMaps or 1;
// number of chunks to store in file record
DDSInfo.Width := fFilesFO4[i].Width;
DDSInfo.Height := fFilesFO4[i].Height;
DDSInfo.MipMaps := fFilesFO4[i].NumMips;
SetLength(fFilesFO4[i].TexChunks, GetDDSMipChunkNum(DDSInfo));
// storing chunks
for j := Low(fFilesFO4[i].TexChunks) to High(fFilesFO4[i].TexChunks) do begin
fFilesFO4[i].TexChunks[j].StartMip := j;
if j < High(fFilesFO4[i].TexChunks) then
fFilesFO4[i].TexChunks[j].EndMip := j
else begin
// last chunk stores all remaining mipmaps
fFilesFO4[i].TexChunks[j].EndMip := Pred(fFilesFO4[i].NumMips);
MipSize := Integer(aSize) - Off;
end;
DataHash := CalcDataHash(@aData[Off], MipSize);
PackData(
@fFilesFO4[i].TexChunks[j], fFilesFO4[i].Name,
DataHash, @aData[Off], MipSize,
fFilesFO4[i].Compress(Self), fFilesFO4[i].Compress(Self) // force compression
);
Inc(Off, MipSize);
MipSize := MipSize div 4;
end;
end;
end;
finally
SyncEndWrite;
end;
end;
function TwbBSArchive.ExtractFileData(aFileRecord: Pointer): TwbBSResultBuffer;
var
FileTES3: PwbBSFileTES3;
FileTES4: PwbBSFileTES4;
FileFO4: PwbBSFileFO4;
DDSHeader: PDDSHeader;
DDSHeaderDX10: PDDSHeaderDX10;
i, size, TexSize: integer;
bCompressed: Boolean;
Buffer: TBytes;
begin
if not (stReading in fStates) then
raise Exception.Create('Archive is not loaded');
if aFileRecord = nil then
Exit;
SyncBeginWrite;
try
case fType of
baTES3: begin
FileTES3 := aFileRecord;
fStream.Position := fDataOffset + FileTES3.Offset;
Result.size := FileTES3.Size;
// Modified: Make sure memory is zeroed when allocated
Result.data := AllocMem(FileTES3.Size);
end;
baTES4, baFO3, baSSE: begin
FileTES4 := aFileRecord;
fStream.Position := FileTES4.Offset;
size := FileTES4.Size;
bCompressed := size and FILE_SIZE_COMPRESS <> 0;
if bCompressed then
size := size and not FILE_SIZE_COMPRESS;
if fHeaderTES4.Flags and ARCHIVE_COMPRESS <> 0 then
bCompressed := not bCompressed;
// skip embedded file name + length prefix
if (fType in [baFO3, baSSE]) and (fHeaderTES4.Flags and ARCHIVE_EMBEDNAME <> 0) then
size := size - (Length(fStream.ReadStringLen(False)) + 1);
if bCompressed then begin
// reading uncompressed size
Result.size := fStream.ReadCardinal;
// Modified: Make sure memory is zeroed when allocated
Result.data := AllocMem(Result.size);
dec(size, SizeOf(Cardinal));
if (Result.size > 0) and (size > 0) then begin
SetLength(Buffer, size);
fStream.ReadBuffer(Buffer[0], Length(Buffer));
SyncEndWrite;
try
DecompressBuf(@Buffer[0], Length(Buffer), @Result.data[0], Result.size);
finally
SyncBeginWrite;
end;
end;
end
else begin
Result.size := size;
// Modified: Make sure memory is zeroed when allocated
Result.data := AllocMem(Result.size);
if size > 0 then
fStream.ReadBuffer(Result.data[0], Result.size);
end;
end;
baFO4, baSF: begin
FileFO4 := aFileRecord;
fStream.Position := FileFO4.Offset;
if FileFO4.PackedSize <> 0 then begin
SetLength(Buffer, FileFO4.PackedSize);
fStream.ReadBuffer(Buffer[0], Length(Buffer));
Result.size := FileFO4.Size;
// Modified: Make sure memory is zeroed when allocated
Result.data := AllocMem(Result.size);
SyncEndWrite;
try
DecompressBuf(@Buffer[0], Length(Buffer), @Result.data[0], Result.size);
finally
SyncBeginWrite;
end;
end
else begin
Result.size := FileFO4.Size;
// Modified: Make sure memory is zeroed when allocated
Result.data := AllocMem(Result.size);
fStream.ReadBuffer(Result.data[0], Result.size);
end;
end;
baFO4dds, baSFdds: begin
FileFO4 := aFileRecord;
TexSize := SizeOf(TDDSHeader);
for i := Low(FileFO4.TexChunks) to High(FileFO4.TexChunks) do
Inc(TexSize, FileFO4.TexChunks[i].Size);
Result.size := Texsize;
// Modified: Make sure memory is zeroed when allocated
Result.data := AllocMem(Result.size);
DDSHeader := @Result.data[0];
DDSHeader.Magic := MAGIC_DDS;
DDSHeader.dwSize := SizeOf(TDDSHeader) - SizeOf(TMagic4);
DDSHeader.dwWidth := FileFO4.Width;
DDSHeader.dwHeight := FileFO4.Height;
DDSHeader.dwFlags := DDSD_CAPS or DDSD_PIXELFORMAT or
DDSD_WIDTH or DDSD_HEIGHT or DDSD_MIPMAPCOUNT;
DDSHeader.dwCaps := DDSCAPS_TEXTURE;
DDSHeader.dwMipMapCount := FileFO4.NumMips;
if DDSHeader.dwMipMapCount > 1 then
DDSHeader.dwCaps := DDSHeader.dwCaps or DDSCAPS_MIPMAP or DDSCAPS_COMPLEX;
DDSHeader.dwDepth := 1;
DDSHeaderDX10 := @Result.data[SizeOf(TDDSHeader)];
DDSHeaderDX10.resourceDimension := DDS_DIMENSION_TEXTURE2D;
DDSHeaderDX10.arraySize := 1;
if FileFO4.CubeMaps = 2049 then begin
// Archive2.exe creates invalid textures like this
//DDSHeader.dwCaps := DDSHeader.dwCaps or DDSCAPS2_CUBEMAP or DDSCAPS_COMPLEX
// or DDSCAPS2_POSITIVEX or DDSCAPS2_NEGATIVEX
// or DDSCAPS2_POSITIVEY or DDSCAPS2_NEGATIVEY
// or DDSCAPS2_POSITIVEZ or DDSCAPS2_NEGATIVEZ;
// This is the correct way
DDSHeader.dwCaps := DDSHeader.dwCaps or DDSCAPS_COMPLEX;
DDSHeader.dwCaps2 := DDSCAPS2_CUBEMAP
or DDSCAPS2_POSITIVEX or DDSCAPS2_NEGATIVEX
or DDSCAPS2_POSITIVEY or DDSCAPS2_NEGATIVEY
or DDSCAPS2_POSITIVEZ or DDSCAPS2_NEGATIVEZ;
DDSHeaderDX10.miscFlags := DDS_RESOURCE_MISC_TEXTURECUBE;
end;
DDSHeader.ddspf.dwSize := SizeOf(DDSHeader.ddspf);
case TDXGI(FileFO4.DXGIFormat) of
DXGI_FORMAT_BC1_UNORM: begin
DDSHeader.dwFlags := DDSHeader.dwFlags or DDSD_LINEARSIZE;
DDSHeader.ddspf.dwFlags := DDPF_FOURCC;
DDSHeader.ddspf.dwFourCC := MAGIC_DXT1;
DDSHeader.dwPitchOrLinearSize := FileFO4.Width * FileFO4.Height div 2;
end;
DXGI_FORMAT_BC2_UNORM: begin
DDSHeader.dwFlags := DDSHeader.dwFlags or DDSD_LINEARSIZE;
DDSHeader.ddspf.dwFlags := DDPF_FOURCC;
DDSHeader.ddspf.dwFourCC := MAGIC_DXT3;
DDSHeader.dwPitchOrLinearSize := FileFO4.Width * FileFO4.Height;
end;
DXGI_FORMAT_BC3_UNORM: begin
DDSHeader.dwFlags := DDSHeader.dwFlags or DDSD_LINEARSIZE;
DDSHeader.ddspf.dwFlags := DDPF_FOURCC;
DDSHeader.ddspf.dwFourCC := MAGIC_DXT5;
DDSHeader.dwPitchOrLinearSize := FileFO4.Width * FileFO4.Height;
end;
DXGI_FORMAT_BC4_SNORM: begin
DDSHeader.dwFlags := DDSHeader.dwFlags or DDSD_LINEARSIZE;
DDSHeader.ddspf.dwFlags := DDPF_FOURCC;
DDSHeader.ddspf.dwFourCC := MAGIC_BC4S;
DDSHeader.dwPitchOrLinearSize := FileFO4.Width * FileFO4.Height div 2;
end;
DXGI_FORMAT_BC4_UNORM: begin
DDSHeader.dwFlags := DDSHeader.dwFlags or DDSD_LINEARSIZE;
DDSHeader.ddspf.dwFlags := DDPF_FOURCC;
DDSHeader.ddspf.dwFourCC := MAGIC_BC4U;
DDSHeader.dwPitchOrLinearSize := FileFO4.Width * FileFO4.Height div 2;
end;
DXGI_FORMAT_BC5_SNORM: begin
DDSHeader.dwFlags := DDSHeader.dwFlags or DDSD_LINEARSIZE;
DDSHeader.ddspf.dwFlags := DDPF_FOURCC;
DDSHeader.ddspf.dwFourCC := MAGIC_BC5S;
DDSHeader.dwPitchOrLinearSize := FileFO4.Width * FileFO4.Height;
end;
DXGI_FORMAT_BC5_UNORM: begin
DDSHeader.dwFlags := DDSHeader.dwFlags or DDSD_LINEARSIZE;
DDSHeader.ddspf.dwFlags := DDPF_FOURCC;
DDSHeader.ddspf.dwFourCC := MAGIC_BC5U;
DDSHeader.dwPitchOrLinearSize := FileFO4.Width * FileFO4.Height;
end;
DXGI_FORMAT_BC1_UNORM_SRGB: begin
DDSHeader.dwFlags := DDSHeader.dwFlags or DDSD_LINEARSIZE;
DDSHeader.ddspf.dwFlags := DDPF_FOURCC;
DDSHeader.ddspf.dwFourCC := MAGIC_DX10;
DDSHeaderDX10.dxgiFormat := Integer(FileFO4.DXGIFormat);
DDSHeader.dwPitchOrLinearSize := FileFO4.Width * FileFO4.Height div 2;
end;
DXGI_FORMAT_BC2_UNORM_SRGB, DXGI_FORMAT_BC3_UNORM_SRGB,
DXGI_FORMAT_BC6H_UF16, DXGI_FORMAT_BC6H_SF16,
DXGI_FORMAT_BC7_UNORM, DXGI_FORMAT_BC7_UNORM_SRGB: begin
DDSHeader.dwFlags := DDSHeader.dwFlags or DDSD_LINEARSIZE;
DDSHeader.ddspf.dwFlags := DDPF_FOURCC;
DDSHeader.ddspf.dwFourCC := MAGIC_DX10;
DDSHeaderDX10.dxgiFormat := Integer(FileFO4.DXGIFormat);
DDSHeader.dwPitchOrLinearSize := FileFO4.Width * FileFO4.Height;
end;
DXGI_FORMAT_B8G8R8A8_UNORM_SRGB, DXGI_FORMAT_B8G8R8X8_UNORM_SRGB,
DXGI_FORMAT_R8G8B8A8_SINT, DXGI_FORMAT_R8G8B8A8_UINT, DXGI_FORMAT_R8G8B8A8_UNORM_SRGB: begin
DDSHeader.dwFlags := DDSHeader.dwFlags or DDSD_PITCH;
DDSHeader.ddspf.dwFlags := DDPF_FOURCC;
DDSHeader.ddspf.dwFourCC := MAGIC_DX10;
DDSHeaderDX10.dxgiFormat := Integer(FileFO4.DXGIFormat);
DDSHeader.dwPitchOrLinearSize := FileFO4.Width * 4;
end;
DXGI_FORMAT_R8G8_SINT, DXGI_FORMAT_R8G8_UINT: begin
DDSHeader.dwFlags := DDSHeader.dwFlags or DDSD_PITCH;
DDSHeader.ddspf.dwFlags := DDPF_FOURCC;
DDSHeader.ddspf.dwFourCC := MAGIC_DX10;
DDSHeaderDX10.dxgiFormat := Integer(FileFO4.DXGIFormat);
DDSHeader.dwPitchOrLinearSize := FileFO4.Width * 2;
end;
DXGI_FORMAT_R8_SINT, DXGI_FORMAT_R8_SNORM, DXGI_FORMAT_R8_UINT: begin
DDSHeader.dwFlags := DDSHeader.dwFlags or DDSD_PITCH;
DDSHeader.ddspf.dwFlags := DDPF_FOURCC;
DDSHeader.ddspf.dwFourCC := MAGIC_DX10;
DDSHeaderDX10.dxgiFormat := Integer(FileFO4.DXGIFormat);
DDSHeader.dwPitchOrLinearSize := FileFO4.Width;
end;
DXGI_FORMAT_R8G8B8A8_UNORM: begin
DDSHeader.dwFlags := DDSHeader.dwFlags or DDSD_PITCH;
DDSHeader.ddspf.dwFlags := DDPF_RGB or DDPF_ALPHAPIXELS;
DDSHeader.ddspf.dwRGBBitCount := 32;
DDSHeader.ddspf.dwRBitMask := $000000FF;
DDSHeader.ddspf.dwGBitMask := $0000FF00;
DDSHeader.ddspf.dwBBitMask := $00FF0000;
DDSHeader.ddspf.dwABitMask := $FF000000;
DDSHeader.dwPitchOrLinearSize := FileFO4.Width * 4;
end;
DXGI_FORMAT_B8G8R8A8_UNORM: begin
DDSHeader.dwFlags := DDSHeader.dwFlags or DDSD_PITCH;
DDSHeader.ddspf.dwFlags := DDPF_RGB or DDPF_ALPHAPIXELS;
DDSHeader.ddspf.dwRGBBitCount := 32;
DDSHeader.ddspf.dwRBitMask := $00FF0000;
DDSHeader.ddspf.dwGBitMask := $0000FF00;
DDSHeader.ddspf.dwBBitMask := $000000FF;
DDSHeader.ddspf.dwABitMask := $FF000000;
DDSHeader.dwPitchOrLinearSize := FileFO4.Width * 4;
end;
DXGI_FORMAT_B8G8R8X8_UNORM: begin
DDSHeader.dwFlags := DDSHeader.dwFlags or DDSD_PITCH;
DDSHeader.ddspf.dwFlags := DDPF_RGB;
DDSHeader.ddspf.dwRGBBitCount := 32;
DDSHeader.ddspf.dwRBitMask := $00FF0000;
DDSHeader.ddspf.dwGBitMask := $0000FF00;
DDSHeader.ddspf.dwBBitMask := $000000FF;
DDSHeader.dwPitchOrLinearSize := FileFO4.Width * 4;
end;
DXGI_FORMAT_B5G6R5_UNORM: begin
DDSHeader.dwFlags := DDSHeader.dwFlags or DDSD_PITCH;
DDSHeader.ddspf.dwFlags := DDPF_RGB;
DDSHeader.ddspf.dwRGBBitCount := 16;
DDSHeader.ddspf.dwRBitMask := $0000F800;
DDSHeader.ddspf.dwGBitMask := $000007E0;
DDSHeader.ddspf.dwBBitMask := $0000001F;
DDSHeader.dwPitchOrLinearSize := FileFO4.Width * 2;
end;
DXGI_FORMAT_B5G5R5A1_UNORM: begin
DDSHeader.dwFlags := DDSHeader.dwFlags or DDSD_PITCH;
DDSHeader.ddspf.dwFlags := DDPF_RGB or DDPF_ALPHAPIXELS;
DDSHeader.ddspf.dwRGBBitCount := 16;
DDSHeader.ddspf.dwRBitMask := $00007C00;
DDSHeader.ddspf.dwGBitMask := $000003E0;
DDSHeader.ddspf.dwBBitMask := $0000001F;
DDSHeader.ddspf.dwABitMask := $00008000;
DDSHeader.dwPitchOrLinearSize := FileFO4.Width * 2;
end;
DXGI_FORMAT_R8G8_UNORM: begin
DDSHeader.dwFlags := DDSHeader.dwFlags or DDSD_PITCH;
DDSHeader.ddspf.dwFlags := DDPF_LUMINANCE OR DDPF_ALPHAPIXELS;
DDSHeader.ddspf.dwRGBBitCount := 16;
DDSHeader.ddspf.dwRBitMask := $000000FF;
DDSHeader.ddspf.dwABitMask := $0000FF00;
DDSHeader.dwPitchOrLinearSize := FileFO4.Width * 2;
end;
DXGI_FORMAT_A8_UNORM: begin
DDSHeader.dwFlags := DDSHeader.dwFlags or DDSD_PITCH;
DDSHeader.ddspf.dwFlags := DDPF_ALPHA;
DDSHeader.ddspf.dwRGBBitCount := 8;
DDSHeader.ddspf.dwABitMask := $000000FF;
DDSHeader.dwPitchOrLinearSize := FileFO4.Width;
end;
DXGI_FORMAT_R8_UNORM: begin
DDSHeader.dwFlags := DDSHeader.dwFlags or DDSD_PITCH;
DDSHeader.ddspf.dwFlags := DDPF_LUMINANCE;
DDSHeader.ddspf.dwRGBBitCount := 8;
DDSHeader.ddspf.dwRBitMask := $000000FF;
DDSHeader.dwPitchOrLinearSize := FileFO4.Width;
end;
end;
TexSize := SizeOf(TDDSHeader);
if DDSHeader.ddspf.dwFourCC = MAGIC_DX10 then begin
ReallocMem(Result.data, Result.size + SizeOf(TDDSHeaderDX10));
Inc(TexSize, SizeOf(TDDSHeaderDX10));
Result.size := TexSize;
end;
// append chunks
for i := Low(FileFO4.TexChunks) to High(FileFO4.TexChunks) do with FileFO4.TexChunks[i] do begin
fStream.Position := Offset;
// compressed chunk
if PackedSize <> 0 then begin
SetLength(Buffer, PackedSize);
fStream.ReadBuffer(Buffer[0], Length(Buffer));
SyncEndWrite;
try
DecompressBuf(@Buffer[0], Length(Buffer), @Result.data[TexSize], Size);
finally
SyncBeginWrite;
end;
end
// uncompressed chunk
else
fStream.ReadBuffer(Result.data[TexSize], Size);
Inc(TexSize, Size);
Result.size := TexSize;
end;
end
else
raise Exception.Create('Extraction is not supported for this archive');
end;
finally
SyncEndWrite;
end;
end;
function TwbBSArchive.ExtractFileData(const aFileName: string): TwbBSResultBuffer;
var
FileRecord: Pointer;
begin
if not (stReading in fStates) then
raise Exception.Create('Archive is not loaded');
FileRecord := FindFileRecord(aFileName);
if not Assigned(FileRecord) then
raise Exception.Create('File not found in archive');
Result := ExtractFileData(FileRecord);
end;
// Addded: For use in non-Borland C/C++
procedure TwbBSArchive.ReleaseFileData(fileDataResult: TwbBSResultBuffer);
begin
FreeMem(fileDataResult.data);
fileDataResult.size := 0;
end;
procedure TwbBSArchive.ExtractFile(const aFileName, aSaveAs: string);
var
fs: TFileStream;
fileData: TwbBSResultBuffer;
begin
if not (stReading in fStates) then
raise Exception.Create('Archive is not loaded');
fs := TFileStream.Create(aSaveAs, fmCreate);
try
fileData := ExtractFileData(aFileName);
fs.Write(fileData.data[0], fileData.size);
finally
ReleaseFileData(fileData);
fs.Free;
end;
end;
procedure TwbBSArchive.IterateFiles(aProc: TBSFileIterationProc; aData: Pointer = nil;
aSingleThreaded: Boolean = False);
var
i, j: Integer;
begin
if not Assigned(aProc) then
Exit;
if fMultiThreaded and not aSingleThreaded then
case fType of
baTES3:
TParallel.&For(Low(fFilesTES3), High(fFilesTES3), procedure(i: Integer; LoopState: TParallel.TLoopState) begin
if aProc(Self, fFilesTES3[i].Name, @fFilesTES3[i], nil, aData) then
LoopState.Stop;
end);
baTES4, baFO3, baSSE:
TParallel.&For(Low(fFoldersTES4), High(fFoldersTES4), procedure(i: Integer; OuterLoopState: TParallel.TLoopState) begin
TParallel.&For(Low(fFoldersTES4[i].Files), High(fFoldersTES4[i].Files), procedure(j: Integer; InnerLoopState: TParallel.TLoopState) begin
if aProc(Self, fFoldersTES4[i].Name + '\' + fFoldersTES4[i].Files[j].Name, @fFoldersTES4[i].Files[j], @fFoldersTES4[i], aData) then begin
OuterLoopState.Stop;
InnerLoopState.Stop;
end;
end);
end);
baFO4, baFO4dds, baSF, baSFdds:
TParallel.&For(Low(fFilesFO4), High(fFilesFO4), procedure(i: Integer; LoopState: TParallel.TLoopState) begin
if aProc(Self, fFilesFO4[i].Name, @fFilesFO4[i], nil, aData) then
LoopState.Stop;
end);
end
else
case fType of
baTES3:
for i := Low(fFilesTES3) to High(fFilesTES3) do
if aProc(Self, fFilesTES3[i].Name, @fFilesTES3[i], nil, aData) then
Break;
baTES4, baFO3, baSSE:
for i := Low(fFoldersTES4) to High(fFoldersTES4) do
for j := Low(fFoldersTES4[i].Files) to High(fFoldersTES4[i].Files) do
if aProc(Self, fFoldersTES4[i].Name + '\' + fFoldersTES4[i].Files[j].Name, @fFoldersTES4[i].Files[j], @fFoldersTES4[i], aData) then
Break;
baFO4, baFO4dds, baSF, baSFdds:
for i := Low(fFilesFO4) to High(fFilesFO4) do
if aProc(Self, fFilesFO4[i].Name, @fFilesFO4[i], nil, aData) then
Break;
end;
end;
{procedure TwbBSArchive.IterateFolders(aProc: TBSFileIterationProc);
var
i: Integer;
begin
if not Assigned(aProc) then
Exit;
if fType in [baTES4, baFO3, baSSE] then
for i := Low(fFoldersTES4) to High(fFoldersTES4) do
aProc(Self, fFoldersTES4[i].Name, nil, @fFoldersTES4[i]);
end;}
function TwbBSArchive.FileExists(const aFileName: string): Boolean;
begin
Result := Assigned(FindFileRecord(aFileName));
end;
procedure TwbBSArchive.Close;
begin
if Assigned(fStream) then
FreeAndNil(fStream);
if stWriting in fStates then
System.SysUtils.DeleteFile(fFileName);
fStates := [];
fType := baNone;
fFileName := '';
fDataOffset := 0;
FillChar(fHeaderTES3, SizeOf(fHeaderTES3), 0);
SetLength(fFilesTES3, 0);
FillChar(fHeaderTES4, SizeOf(fHeaderTES4), 0);
SetLength(fFoldersTES4, 0);
FillChar(fHeaderFO4, SizeOf(fHeaderFO4), 0);
SetLength(fFilesFO4, 0);
if fShareData then begin
SetLength(fPackedData, 0);
fPackedDataCount := 0;
end;
end;
procedure TwbBSArchive.ResourceDict(const aDict: TwbResourceDict; aFolder: string);
var
Folder : string;
i, j : Integer;
begin
if not Assigned(aDict) then
Exit;
Folder := ExcludeTrailingPathDelimiter(aFolder);
case fType of
baTES3:
for i := Low(fFilesTES3) to High(fFilesTES3) do
with fFilesTES3[i] do
if (Folder = '') or Name.StartsWith(Folder, True) then
aDict.TryAdd(Name, wbNothing);
baTES4, baFO3, baSSE:
for i := Low(fFoldersTES4) to High(fFoldersTES4) do
with fFoldersTES4[i] do begin
if (Folder = '') or Name.StartsWith(Folder, True) then
for j := Low(Files) to High(Files) do begin
var lName := Name + '\' + Files[j].Name;
aDict.TryAdd(lName, wbNothing);
end;
end;
baFO4, baFO4dds, baSF, baSFdds:
for i := Low(fFilesFO4) to High(fFilesFO4) do
with fFilesFO4[i] do
if (Folder = '') or Name.StartsWith(Folder, True) then
aDict.TryAdd(Name, wbNothing);
end;
end;
procedure TwbBSArchive.ResourceList(const aList: TStrings; aFolder: string = '');
var
Folder : string;
i, j : Integer;
begin
if not Assigned(aList) then
Exit;
Folder := ExcludeTrailingPathDelimiter(aFolder);
case fType of
baTES3:
for i := Low(fFilesTES3) to High(fFilesTES3) do
with fFilesTES3[i] do
if (Folder = '') or Name.StartsWith(Folder, True) then
aList.Add(Name);
baTES4, baFO3, baSSE:
for i := Low(fFoldersTES4) to High(fFoldersTES4) do
with fFoldersTES4[i] do begin
if (Folder = '') or Name.StartsWith(Folder, True) then
for j := Low(Files) to High(Files) do
aList.Add(Name + '\' + Files[j].Name);
end;
baFO4, baFO4dds, baSF, baSFdds:
for i := Low(fFilesFO4) to High(fFilesFO4) do
with fFilesFO4[i] do
if (Folder = '') or Name.StartsWith(Folder, True) then
aList.Add(Name);
end;
end;
end.
Reference in New Issue View Git Blame Copy Permalink