libbsarch/delphi/libbsarch.dpr

library libbsarch;

uses
  Math,
  Classes,
  Types,
  SysUtils,
  wbStreams,
  wbBSArchive;

type
  TwbBSResultCode = (
    BSA_RESULT_NONE = 0,
    BSA_RESULT_EXCEPTION = -1
  );
  TwbBSResultMessage = packed record
    code: ShortInt;
    text: array[0..1023] of WideChar;
  end;
  TwbBSResultMessageBuffer = packed record
    buffer: TwbBSResultBuffer;
    message: TwbBSResultMessage;
  end;  

{Shared}

function string_to_cstring(
  aString: String;
  const aStringBufferSize: Cardinal;
  const aStringBuffer: PChar
): Integer; stdcall;
begin
  Result := Min(aStringBufferSize, Length(AString));
  if (aStringBuffer <> nil) and (Result > 0) then
    Move(AString[1], aStringBuffer^, Result * SizeOf(WideChar));
end;

function string_to_cstring_end(
  aString: String;
  const aStringBufferSize: Cardinal;
  const aStringBuffer: PChar
): Integer; stdcall;
begin
  Result := Min(aStringBufferSize - 1, Length(AString));
  if (aStringBuffer <> nil) and (Result > 0) then
  begin
    Move(AString[1], aStringBuffer^, Result * SizeOf(WideChar));
    aStringBuffer[Result] := #0;
  end;
end;

procedure exception_handler(E: Exception; var Result: TwbBSResultMessage); stdcall;
begin
  Result.code := ShortInt(BSA_RESULT_EXCEPTION);
  string_to_cstring_end(E.Message, Length(Result.text), Result.text);
end;

procedure buffer_exception_handler(E: Exception; var Result: TwbBSResultMessageBuffer); stdcall;
begin
  Result.buffer.size := 0;
  Result.buffer.data := nil;
  Result.message.code := ShortInt(BSA_RESULT_EXCEPTION);
  string_to_cstring_end(E.Message, Length(Result.message.text), Result.message.text);
end;

{BSA File List}

function bsa_entry_list_create:Pointer; stdcall;
begin
  try
    Result := TwbBSEntryList.Create;
  except
    Result := nil;
  end;
end;

function bsa_entry_list_free(obj: Pointer): TwbBSResultMessage; stdcall;
begin
  Result.code := Ord(BSA_RESULT_NONE);
  try
    TwbBSEntryList(obj).Clear();
    TwbBSEntryList(obj).free;
  except
    on E: Exception do
      exception_handler(E, Result);
  end;
end;

function bsa_entry_list_count(obj: Pointer): Integer; stdcall;
begin
  try
    Result := TwbBSEntryList(obj).Count;
  except
    Result := Ord(BSA_RESULT_EXCEPTION);
  end;
end;

function bsa_entry_list_add(obj: Pointer; const aEntryString: PChar): TwbBSResultMessage; stdcall;
begin
  Result.code := Ord(BSA_RESULT_NONE);
  try
    TwbBSEntryList(obj).Add(String(aEntryString));
  except
    on E: Exception do
      exception_handler(E, Result);
  end;
end;

function bsa_entry_list_get(obj: Pointer; const aIndex: Cardinal; const aStringBufferSize: Cardinal; const aStringBuffer: PChar): Integer; stdcall;
begin
  try
    Result := string_to_cstring_end(TwbBSEntryList(obj).Strings[aIndex], aStringBufferSize, aStringBuffer);
  except
    Result := Integer(BSA_RESULT_EXCEPTION);
  end;
end;

{BSArchive}

function bsa_create:Pointer; stdcall;
begin
  try
    Result := TwbBSArchive.Create;
  except
    Result := nil;
  end;
end;

function bsa_free(obj: Pointer): TwbBSResultMessage; stdcall;
begin
  Result.code := Ord(BSA_RESULT_NONE);
  try
    TwbBSArchive(obj).free;
  except
    on E: Exception do
      exception_handler(E, Result);
  end;
end;

function bsa_load_from_file(obj: Pointer; const aFilePath: PChar): TwbBSResultMessage; stdcall;
begin
  Result.code := Ord(BSA_RESULT_NONE);
  try
    TwbBSArchive(obj).LoadFromFile(String(aFilePath));
  except
    on E: Exception do
      exception_handler(E, Result);
  end;
end;

function bsa_create_archive(obj: Pointer; const aFilePath: PChar; aType: TBSArchiveType; aFileList: TwbBSEntryList): TwbBSResultMessage; stdcall;
begin
  Result.code := Ord(BSA_RESULT_NONE);
  try
    TwbBSArchive(obj).CreateArchiveCompat(String(aFilePath), aType, aFileList);
  except
    on E: Exception do
      exception_handler(E, Result);
  end;
end;

function bsa_save(obj: Pointer): TwbBSResultMessage; stdcall;
begin
  Result.code := Ord(BSA_RESULT_NONE);
  try
    TwbBSArchive(obj).Save;
  except
    on E: Exception do
      exception_handler(E, Result);
  end;
end;

function bsa_add_file_from_disk_root(obj: Pointer; const aRootDir, aSourcePath: PChar): TwbBSResultMessage; stdcall;
begin
  Result.code := Ord(BSA_RESULT_NONE);
  try
    TwbBSArchive(obj).AddFileDiskRoot(String(aRootDir), String(aSourcePath));
  except
    on E: Exception do
      exception_handler(E, Result);
  end;
end;

function bsa_add_file_from_disk(obj: Pointer; const aFilePath, aSourcePath: PChar): TwbBSResultMessage; stdcall;
begin
  Result.code := Ord(BSA_RESULT_NONE);
  try
    TwbBSArchive(obj).AddFileDisk(String(aFilePath), String(aSourcePath));
  except
    on E: Exception do
      exception_handler(E, Result);
  end;
end;

function bsa_add_file_from_memory(obj: Pointer; const aFilePath: PChar; const aSize: Cardinal; const aData: PByte): TwbBSResultMessage; stdcall;
begin
  Result.code := Ord(BSA_RESULT_NONE);
  try
    TwbBSArchive(obj).AddFileDataCompat(String(aFilePath), aSize, aData);
  except
    on E: Exception do
      exception_handler(E, Result);
  end;
end;

function bsa_find_file_record(obj: Pointer; const aFilePath: PChar): Pointer; stdcall;
begin
  try
    Result := TwbBSArchive(obj).FindFileRecord(String(aFilePath));
  except
    Result := nil
  end;
end;

function bsa_extract_file_data_by_record(obj: Pointer; aFileRecord: Pointer): TwbBSResultMessageBuffer; stdcall;
begin
  Result.message.code := Ord(BSA_RESULT_NONE);
  try
    Result.buffer := TwbBSArchive(obj).ExtractFileDataCompat(aFileRecord);
  except
    on E: Exception do
      buffer_exception_handler(E, Result);
  end;
end;

function bsa_extract_file_data_by_filename(obj: Pointer; const aFilePath: PChar): TwbBSResultMessageBuffer; stdcall;
begin
  Result.message.code := Ord(BSA_RESULT_NONE);
  try
    Result.buffer := TwbBSArchive(obj).ExtractFileDataCompat(String(aFilePath));
  except
    on E: Exception do
      buffer_exception_handler(E, Result);
  end;
end;

function bsa_file_data_free(obj: Pointer; fileDataResult: TwbBSResultMessageBuffer): TwbBSResultMessage; stdcall;
begin
  Result.code := Ord(BSA_RESULT_NONE);
  try
    TwbBSArchive(obj).ReleaseFileDataCompat(fileDataResult.buffer);
  except
    on E: Exception do
      exception_handler(E, Result);
  end;
end;

function bsa_extract_file(obj: Pointer; const aFilePath, aSaveAs: PChar): TwbBSResultMessage; stdcall;
begin
  Result.code := Ord(BSA_RESULT_NONE);
  try
    TwbBSArchive(obj).ExtractFile(String(aFilePath), String(aSaveAs));
  except
    on E: Exception do
      exception_handler(E, Result);
  end;
end;

function bsa_iterate_files(obj: Pointer; aProc: TBSFileIterationProcCompat; aContext: Pointer): TwbBSResultMessage; stdcall;
begin
  Result.code := Ord(BSA_RESULT_NONE);
  try
    TwbBSArchive(obj).IterateFilesCompat(aProc, aContext);
  except
    on E: Exception do
      exception_handler(E, Result);
  end;
end;

function bsa_file_exists(obj: Pointer; const aFilePath: string): Boolean; stdcall;
begin
  try
    Result := TwbBSArchive(obj).FileExists(aFilePath);
  except
    Result := False;
  end;
end;

function bsa_get_resource_list(obj: Pointer; const aEntryResultList: TwbBSEntryList; aFolder: PChar): TwbBSResultMessage; stdcall;
begin
  Result.code := Ord(BSA_RESULT_NONE);
  try
    TwbBSArchive(obj).ResourceListCompat(aEntryResultList, String(aFolder));
  except
    on E: Exception do
      exception_handler(E, Result);
  end;
end;

function bsa_resolve_hash(obj: Pointer; const aHash: UInt64; const aEntryResultList: TwbBSEntryList): TwbBSResultMessage; stdcall;
begin
  Result.code := Ord(BSA_RESULT_NONE);
  try
    TwbBSArchive(obj).ResolveHashCompat(aHash, aEntryResultList);
  except
    on E: Exception do
      exception_handler(E, Result);
  end;
end;     

function bsa_close(obj: Pointer): TwbBSResultMessage; stdcall;
begin
  Result.code := Ord(BSA_RESULT_NONE);
  try
    TwbBSArchive(obj).Close;
  except
    on E: Exception do
      exception_handler(E, Result);
  end;
end;

function bsa_filename_get(obj: Pointer; const aStringBufferSize: Cardinal; const aStringBuffer: PChar): Cardinal; stdcall;
begin
  Result := string_to_cstring_end(TwbBSArchive(obj).FileName, aStringBufferSize, aStringBuffer);
end;

function bsa_archive_type_get(obj: Pointer): TBSArchiveType; stdcall;
begin
  Result := TwbBSArchive(obj).ArchiveType;
end;

function bsa_version_get(obj: Pointer): Cardinal; stdcall;
begin
  Result := TwbBSArchive(obj).Version;
end;

function bsa_format_name_get(obj: Pointer; const aStringBufferSize: Cardinal; const aStringBuffer: PChar): Cardinal; stdcall;
begin
  Result := string_to_cstring_end(TwbBSArchive(obj).FormatName, aStringBufferSize, aStringBuffer);
end;

function bsa_file_count_get(obj: Pointer): Cardinal; stdcall;
begin
  Result := TwbBSArchive(obj).FileCount;
end;

function bsa_archive_flags_get(obj: Pointer): Cardinal; stdcall;
begin
  Result := TwbBSArchive(obj).ArchiveFlags;
end;

procedure bsa_archive_flags_set(obj: Pointer; flags: Cardinal); stdcall;
begin
  TwbBSArchive(obj).ArchiveFlags := flags;
end;

function bsa_file_flags_get(obj: Pointer): Cardinal; stdcall;
begin
  Result := TwbBSArchive(obj).FileFlags;
end;

procedure bsa_file_flags_set(obj: Pointer; flags: Cardinal); stdcall;
begin
  TwbBSArchive(obj).FileFlags := flags;
end;

function bsa_compress_get(obj: Pointer): Boolean; stdcall;
begin
  Result := TwbBSArchive(obj).Compress;
end;

procedure bsa_compress_set(obj: Pointer; compress: Boolean); stdcall;
begin
  TwbBSArchive(obj).Compress := compress;
end;

function bsa_share_data_get(obj: Pointer): Boolean; stdcall;
begin
  Result := TwbBSArchive(obj).ShareData;
end;

procedure bsa_share_data_set(obj: Pointer; shareData: Boolean); stdcall;
begin
  TwbBSArchive(obj).ShareData := shareData;
end;

procedure bsa_file_dds_info_callback_set(obj: Pointer; aProc: TBSFileDDSInfoProcCompat; aContext: Pointer); stdcall;
begin
  TwbBSArchive(obj).DDSInfoProc := aProc;
  TwbBSArchive(obj).DDSInfoProcContext := aContext;
end;

exports
  bsa_entry_list_create,
  bsa_entry_list_free,
  bsa_entry_list_count,
  bsa_entry_list_add,
  bsa_entry_list_get,

  bsa_filename_get,
  bsa_archive_type_get,
  bsa_version_get,
  bsa_format_name_get,
  bsa_file_count_get,
  bsa_archive_flags_get,
  bsa_archive_flags_set,
  bsa_file_flags_get,
  bsa_file_flags_set,
  bsa_compress_get,
  bsa_compress_set,
  bsa_share_data_get,
  bsa_share_data_set,
  bsa_file_dds_info_callback_set,

  bsa_close,
  bsa_resolve_hash,
  bsa_get_resource_list,
  bsa_file_exists,
  bsa_iterate_files,
  bsa_extract_file,
  bsa_file_data_free,
  bsa_extract_file_data_by_filename,
  bsa_extract_file_data_by_record,
  bsa_find_file_record,
  bsa_add_file_from_memory,
  bsa_add_file_from_disk_root,
  bsa_add_file_from_disk,
  bsa_save,
  bsa_create_archive,
  bsa_load_from_file,
  bsa_create,
  bsa_free
  ;
end.