source: tools/dbc_export/UDBC.pas

unit UDBC;

{$mode Delphi}{$H+}

interface

uses
  Classes, SysUtils, Strings, Variants;

const
  HeaderSize = 20;
  DBCSignature = $43424457;

type
  TDBCColumnType = (ctUInt32, ctSInt32, ctSingle, ctString, ctByte);

  { TDBC }

  TDBC = class
  private
    FileStream: TFileStream;
    RecordCount: Integer;
    FieldCount: Integer;
    RecordSize: Integer;
    StringBlockSize: Integer;
  public
    Cells: array of array of Variant;
    ColumnFormat: array of TDBCColumnType;
    function DetectColumnType(Column: Integer): TDBCColumnType;
    procedure LoadFromFile(FileName: string);
    procedure LoadColumnStrings(Column: Integer);
    procedure SaveToFile(FileName: string);
    procedure SetString(Row, Column: Integer; Text: AnsiString);
  end;

implementation

{ TDBC }

procedure TDBC.LoadFromFile(FileName: string);
var
  Signature: Cardinal;
  Row, Col: Integer;
begin
  FileStream := TFileStream.Create(FileName, fmOpenRead);
  with FileStream do begin
    Signature := ReadDWord;
    if Signature <>  DBCSignature then
      raise Exception.Create('DBC type mismatch.');

    RecordCount := ReadDWord;
    FieldCount := ReadDWord;
    RecordSize := ReadDWord;
    StringBlockSize := ReadDWord;

    SetLength(Cells, RecordCount, FieldCount);
    for Row := 0 to RecordCount - 1 do
      for Col := 0 to FieldCount - 1 do begin
        Cells[Row, Col] := ReadDWord;
      end;
  end;
end;

procedure TDBC.LoadColumnStrings(Column: Integer);
var
  Row: Integer;
  Offset: Integer;
  Text: AnsiString;
  C: Char;
begin
  with FileStream do
  for Row := 0 to RecordCount - 1 do begin
    Offset := HeaderSize + RecordCount * RecordSize + Cells[Row, Column];
    if Position <> Offset then Seek(Offset, soBeginning);

    Text := '';
    C := ' ';
    while (C <> #0) do begin
      C := Chr(ReadByte);
      if C <> #0 then Text := Text + C;
    end;
    Cells[Row, Column] := Text;
  end;
end;

procedure TDBC.SaveToFile(FileName: string);
var
  Row, Col: Integer;
  Offset: Integer;
  StringList: array of string;
begin
  if Assigned(FileStream) then FileStream.Free;
  FileStream := TFileStream.Create(FileName, fmCreate);
  with FileStream do begin
    WriteDWord(DBCSignature);
    WriteDWord(RecordCount);
    WriteDWord(FieldCount);
    WriteDWord(RecordSize);
    WriteDWord(StringBlockSize);

    Size := RecordSize * RecordCount;
    SetLength(StringList, 0);
    Offset := 1;
    // Write cells
    for Row := 0 to RecordCount - 1 do begin
      for Col := 0 to FieldCount - 1 do begin
        if VarIsStr(Cells[Row, Col]) then begin
          //System.Write(IntToStr(Offset) + ': "' + Cells[Row, Col] + '", ');
          WriteDWord(Offset);
          Offset := Offset + Length(Cells[Row, Col]) + 1;
          SetLength(StringList, Length(StringList) + 1);
          StringList[High(StringList)] := Cells[Row, Col];
        end else begin
          //System.Write(IntToStr(Cells[Row, Col]) + ', ');
          WriteDWord(Cells[Row, Col]);
        end;
      end;
      //WriteLn;
    end;

    // Write strings
    Offset := 1;
    WriteByte(0);
    for Row := 0 to Length(StringList) - 1 do begin
      //WriteLn('Id: ' + IntToStr(Row) + ', Offset: ' + IntToStr(Offset) + ', "' + StringList[Row] + '"');
      for Col := 1 to Length(StringList[Row]) do
        WriteByte(Ord(StringList[Row][Col]));
      WriteByte(0);
      Offset := Offset + Length(StringList[Row]) + 1;
    end;

    // Update string block size
    StringBlockSize := Offset;
    Seek(16, soFromBeginning);
    WriteDWord(StringBlockSize);
  end;
end;

procedure TDBC.SetString(Row, Column: Integer; Text: AnsiString);
begin
  if VarIsStr(Cells[Row,Column]) then begin
    StringBlockSize := StringBlockSize + strlen(Pchar(Text)) - strlen(Pchar(VarToStr(Cells[Row,Column])));
    Cells[Row,Column] := Text;
  end;
end;

function TDBC.DetectColumnType(Column: Integer): TDBCColumnType;
//var
//  Row: Integer;
begin
(*
  Result := ctString;
  for Row := 0 to RecordCount - 1 do
    if GetStringByOffset(Cells[Row, Column]) = '' then Result := ctInt32;
  if Result = ctString then Exit;
*)
end;

end.