path: root/libs/libbsarch/delphi/wbBSArchive.pas

{******************************************************************************

  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.