current/DataAccess/Access_OniArchive.pas

unit Access_OniArchive;
interface

uses DataAccess, Classes, TypeDefs;

type
  TAccess_OniArchive = class(TDataAccess)
  private
    Fdat_file:           TFileStream;
    Fraw_file:           TFileStream;
    Fsep_file:           TFileStream;
    Fdat_files:          TFiles;
    Fdat_extensionsmap:  TExtensionsMap;
    FUnloadWhenUnused:   Boolean;
    FDatOpened:          Boolean;
    FRawOpened:          Boolean;
    FSepOpened:          Boolean;
  protected
  public
    property UnloadWhenUnused: Boolean Read FUnloadWhenUnused Write FUnloadWhenUnused;

    constructor Create(DatFilename: String; ConnectionID: Integer; var Msg: TStatusMessages); override;
    procedure Close; override;

    function GetFileInfo(FileID: Integer): TFileInfo; override;
    function GetFilesList(Ext: String; Pattern: String;
      NoEmptyFiles: Boolean; SortType: TSortType): TStrings; override;
    function GetFileCount: Integer; override;
    function GetExtensionsList(ExtListFormat: TExtensionFormat): TStrings; override;

    procedure LoadDatFile(FileID: Integer; var Target: TStream); overload; override;
    procedure UpdateDatFile(FileID: Integer; Src: TStream); overload; override;
    procedure LoadDatFilePart(FileID, Offset, Size: Integer; var Target: TStream); overload; override;
    procedure UpdateDatFilePart(FileID, Offset, Size: Integer; Src: TStream); overload; override;

    function GetRawList(FileID: Integer): TRawDataList; override;
    function GetRawInfo(FileID, DatOffset: Integer): TRawDataInfo; override;

    procedure LoadRawOffset(LocSep: Boolean; RawAddr, Size: Integer; target: Pointer);
    procedure LoadRawFile(FileID, DatOffset: Integer; var Target: TStream); overload; override;
    procedure UpdateRawFile(FileID, DatOffset: Integer; Src: TStream); overload; override;
    procedure LoadRawFilePart(FileID, DatOffset, Offset, Size: Integer; var Target: TStream); overload; override;
    procedure UpdateRawFilePart(FileID, DatOffset, Offset, Size: Integer; Src: TStream); overload; override;

    function AppendRawFile(LocSep: Boolean; Src: TStream): Integer; overload; override;
  published
  end;

implementation

uses
  SysUtils, StrUtils, Data, Functions, RawList;


(*
================================================================================
                      Implementation of  TOniDataDat
*)


constructor TAccess_OniArchive.Create(DatFilename: String; ConnectionID: Integer; var Msg: TStatusMessages);
type
  THeader = packed record
    Ident:      array[0..$13] of Byte;
    Files:      Integer;
    NamedFiles: Integer;
    Extensions: Integer;
    DataAddr:   Integer;
    DataSize:   Integer;
    NamesAddr:  Integer;
    NamesSize:  Integer;
    Ident2:     array[0..$F] of Byte;
  end;
  TFilesMap = array of packed record
    Extension: array[0..$3] of Char;
    DataAddr:  Integer;
    NameAddr:  Integer;
    FileSize:  Integer;
    FileType:  LongWord;
  end;
  TNamedFilesMap = array of packed record
    FileNumber: Integer;
    blubb:      Integer;
  end;
const
  header_ident1_pc: array[0..$13] of Byte =
    ($1F, $27, $DC, $33, $DF, $BC, $03, $00, $31, $33, $52, $56, $40, $00,
    $14, $00, $10, $00, $08, $00);
  header_ident1_mac: array[0..$13] of Byte =
    ($61, $30, $C1, $23, $DF, $BC, $03, $00, $31, $33, $52, $56, $40, $00,
    $14, $00, $10, $00, $08, $00);
  header_ident1_macbeta: array[0..$13] of Byte =
    ($81, $11, $8D, $23, $DF, $BC, $03, $00, $31, $33, $52, $56, $40, $00,
    $14, $00, $10, $00, $08, $00);
  header_ident2: array[0..$F] of Byte =
    ($99, $CF, $40, $00, $90, $4F, $63, $00, $F4, $55, $5F, $00, $90, $4F, $63, $00);
var
  i: Integer;
  header_pc, header_mac, header_macbeta: Boolean;
  Fdat_header:   THeader;
  Fdat_filesmap: TFilesMap;
  Fdat_namedfilesmap: TNamedFilesMap;
begin
  FUnloadWhenUnused := True;
  FDatOpened := False;
  FRawOpened := False;
  Msg := SM_UnknownError;
  if not FileExists(DatFilename) then
  begin
    Msg := SM_FileNotFound;
    Exit;
  end;
  FFileName := DatFilename;
  Fdat_file := TFileStream.Create(FFileName, fmOpenRead);
  Fdat_file.Read(Fdat_header, SizeOf(Fdat_header));
  header_pc  := True;
  header_mac := True;
  header_macbeta := True;
  for i := 0 to High(Fdat_header.Ident) do
  begin
//    FLevelInfo.Ident[i] := Fdat_header.Ident[i];
    if Fdat_header.Ident[i] <> header_ident1_pc[i] then
      header_pc := False;
    if Fdat_header.Ident[i] <> header_ident1_mac[i] then
      header_mac := False;
    if Fdat_header.Ident[i] <> header_ident1_macbeta[i] then
      header_macbeta := False;
  end;
  if not (header_pc xor header_mac xor header_macbeta) then
  begin
    Msg := SM_IncompatibleFile;
    Exit;
  end
  else
  begin
    if (header_pc and not header_mac and not header_macbeta) then
      FDataOS := DOS_WIN
    else if (not header_pc and header_mac and not header_macbeta) then
      FDataOS := DOS_MAC
    else if (not header_pc and not header_mac and header_macbeta) then
      FDataOS := DOS_MACBETA;
  end;
  SetLength(Fdat_filesmap, Fdat_header.Files);
  SetLength(Fdat_files, Fdat_header.Files);
  for i := 0 to Fdat_header.Files - 1 do
    Fdat_file.Read(Fdat_filesmap[i], SizeOf(Fdat_filesmap[i]));
  for i := 0 to Fdat_header.Files - 1 do
  begin
    Fdat_files[i].ID := i;
    Fdat_files[i].Extension := Fdat_filesmap[i].Extension;
    Fdat_files[i].Extension := ReverseString(Fdat_files[i].Extension);
    Fdat_files[i].Size      := Fdat_filesmap[i].FileSize;
    Fdat_files[i].FileType  := Fdat_filesmap[i].FileType;
    Fdat_files[i].DatAddr   := Fdat_filesmap[i].DataAddr - 8 + Fdat_header.DataAddr;
    if (Fdat_filesmap[i].FileType and $01) = 0 then
    begin
      Fdat_file.Seek(Fdat_filesmap[i].NameAddr + Fdat_header.NamesAddr, soFromBeginning);
      SetLength(Fdat_files[i].Name, 100);
      Fdat_file.Read(Fdat_files[i].Name[1], 100);
      Fdat_files[i].Name := MidStr(Fdat_files[i].Name, 1 + 4, Pos(
        #0, Fdat_files[i].Name) - 1 - 4);
    end
    else
    begin
      Fdat_files[i].Name := '';
    end;
  end;
  Fdat_file.Seek($40 + Fdat_header.Files * $14, soFromBeginning);
  SetLength(Fdat_namedfilesmap, Fdat_header.NamedFiles);
  for i := 0 to Fdat_header.NamedFiles - 1 do
    Fdat_file.Read(Fdat_namedfilesmap[i], SizeOf(Fdat_namedfilesmap[i]));

  Fdat_file.Seek($40 + Fdat_header.Files * $14 + Fdat_header.NamedFiles * $8, soFromBeginning);
  SetLength(Fdat_extensionsmap, Fdat_header.Extensions);
  for i := 0 to Fdat_header.Extensions - 1 do
    Fdat_file.Read(Fdat_extensionsmap[i], SizeOf(Fdat_extensionsmap[i]));

  Fdat_file.Seek(Fdat_files[0].DatAddr + 7, soFromBeginning);
  Fdat_file.Read(FLevelNumber, 1);
  FLevelNumber := FLevelNumber div 2;

  Fdat_file.Free;

  Msg := SM_OK;
  FBackend := DB_ONI;
  FConnectionID := ConnectionID;
  FChangeRights := [CR_EditDat, CR_EditRaw, CR_AppendRaw];
end;


procedure TAccess_OniArchive.Close;
begin
  if FDatOpened then
    Fdat_file.Free;
  if FRawOpened then
    Fraw_file.Free;
  if FSepOpened then
    Fsep_file.Free;
  Self.Free;
end;


function TAccess_OniArchive.GetFileInfo(fileid: Integer): TFileInfo;
begin
  if fileid = -1 then
  begin
    Result := inherited GetFileInfo(fileid);
    Exit;
  end;
  if fileid < Self.GetFileCount then
    Result    := Fdat_files[fileid]
  else
    Result.ID := -1;
end;


function TAccess_OniArchive.GetFilesList(ext: String; pattern: String;
  NoEmptyFiles: Boolean; SortType: TSortType): TStrings;
var
  i:      Integer;
  list:   TStringList;
  id, name, extension: String;
  fields: TStrings;

  procedure getfields;
  begin
    fields.CommaText := StringReplace(AnsiQuotedStr(list.Strings[i], '"'), ';', '","', [rfReplaceAll]);
    if SortType in [ST_IDAsc, ST_IDDesc] then
    begin
      id := fields.Strings[0];
      name := fields.Strings[1];
      extension := fields.Strings[2];
    end;
    if SortType in [ST_NameAsc, ST_NameDesc] then
    begin
      id := fields.Strings[1];
      name := fields.Strings[0];
      extension := fields.Strings[2];
    end;
    if SortType in [ST_ExtAsc, ST_ExtDesc] then
    begin
      id := fields.Strings[1];
      name := fields.Strings[2];
      extension := fields.Strings[0];
    end;
  end;

begin
  list := TStringList.Create;
  list.Sorted := True;
  for i := 0 to GetFileCount - 1 do
  begin
    if ((Length(ext) = 0) or (Pos(Fdat_files[i].Extension, ext) > 0)) and
      ((Length(pattern) = 0) or
      (Pos(UpperCase(pattern), UpperCase(Fdat_files[i].Name)) > 0)) then
    begin
      if (NoEmptyFiles = False) or ((Fdat_files[i].FileType and $02) = 0) then
      begin
        if AppSettings.FilenumbersAsHex then
          id := IntToHex(Fdat_files[i].ID, 4)
        else
          id := FormatNumber(Fdat_files[i].ID, 5, '0');
        name := Fdat_files[i].Name;
        extension := Fdat_files[i].Extension;

        case SortType of
          ST_IDAsc, ST_IDDesc:     list.Add(id + ';' + name + ';' + extension);
          ST_NameAsc, ST_NameDesc: list.Add(name + ';' + id + ';' + extension);
          ST_ExtAsc, ST_ExtDesc:   list.Add(extension + ';' + id + ';' + name);
        end;
      end;
    end;
  end;
  Result := TStringList.Create;
  if list.Count > 0 then
  begin
    fields := TStringList.Create;
    if SortType in [ST_IDAsc, ST_NameAsc, ST_ExtAsc] then
      for i := 0 to list.Count - 1 do
      begin
        getfields;
        Result.Add(id + '-' + name + '.' + extension);
      end
    else
      for i := list.Count - 1 downto 0 do
      begin
        getfields;
        Result.Add(id + '-' + name + '.' + extension);
      end;
    fields.Free;
  end;
  list.Free;
end;


function TAccess_OniArchive.GetFileCount: Integer;
begin
  Result := Length(Fdat_files);
end;


function TAccess_OniArchive.GetExtensionsList(ExtListFormat: TExtensionFormat): TStrings;
var
  i: Integer;
begin
  Result := TStringList.Create;
  for i := 0 to Length(Fdat_extensionsmap) - 1 do
  begin
    with Fdat_extensionsmap[i] do
    begin
      case ExtListFormat of
        EF_ExtOnly:
          Result.Add(Extension[3] + Extension[2] + Extension[1] + Extension[0]);
        EF_ExtCount:
          Result.Add(Extension[3] + Extension[2] + Extension[1] + Extension[0] +
                ' (' + IntToStr(ExtCount) + ')');
      end;
    end;
  end;
end;


procedure TAccess_OniArchive.LoadDatFile(FileID: Integer; var Target: TStream);
var
  streampos: Integer;
begin
  if fileid < GetFileCount then
  begin
    if not Assigned(Target) then
      Target := TMemoryStream.Create;
    if not FDatOpened then
      Fdat_file := TFileStream.Create(FFileName, fmOpenReadWrite);
    Fdat_file.Seek(Fdat_files[fileid].DatAddr, soFromBeginning);
    streampos := Target.Position;
    Target.CopyFrom(Fdat_file, Fdat_files[fileid].Size);
    Target.Seek(streampos, soFromBeginning);
    if UnloadWhenUnused then
    begin
      Fdat_file.Free;
      FDatOpened := False;
    end
    else
      FDatOpened := True;
  end;
end;

procedure TAccess_OniArchive.UpdateDatFile(FileID: Integer; Src: TStream);
begin
  if fileid < GetFileCount then
  begin
    if not FDatOpened then
      Fdat_file := TFileStream.Create(FFileName, fmOpenReadWrite);
    Fdat_file.Seek(Fdat_files[fileid].DatAddr, soFromBeginning);
    Fdat_file.CopyFrom(Src, Fdat_files[fileid].Size);
    if UnloadWhenUnused then
    begin
      Fdat_file.Free;
      FDatOpened := False;
    end
    else
      FDatOpened := True;
  end;
end;

procedure TAccess_OniArchive.LoadDatFilePart(FileID, Offset, Size: Integer; var Target: TStream);
var
  streampos: Integer;
begin
  if fileid < GetFileCount then
  begin
    if not Assigned(Target) then
      Target := TMemoryStream.Create;
    if not FDatOpened then
      Fdat_file := TFileStream.Create(FFileName, fmOpenReadWrite);
    Fdat_file.Seek(Fdat_files[fileid].DatAddr + offset, soFromBeginning);
    streampos := Target.Position;
    Target.CopyFrom(Fdat_file, size);
    Target.Seek(streampos, soFromBeginning);
    if UnloadWhenUnused then
    begin
      FDatOpened := False;
      Fdat_file.Free;
    end
    else
      FDatOpened := True;
  end;
end;

procedure TAccess_OniArchive.UpdateDatFilePart(FileID, Offset, Size: Integer; Src: TStream);
begin
  if fileid < GetFileCount then
  begin
    if not FDatOpened then
      Fdat_file := TFileStream.Create(FFileName, fmOpenReadWrite);
    Fdat_file.Seek(Fdat_files[fileid].DatAddr + offset, soFromBeginning);
    Fdat_file.CopyFrom(Src, Size);
    if UnloadWhenUnused then
    begin
      Fdat_file.Free;
      FDatOpened := False;
    end
    else
      FDatOpened := True;
  end;
end;


function TAccess_OniArchive.GetRawList(FileID: Integer): TRawDataList;
begin
  Result := RawLists.GetRawList(FConnectionID, FileID);
end;


function TAccess_OniArchive.GetRawInfo(FileID, DatOffset: Integer): TRawDataInfo;
begin
  Result := RawLists.GetRawInfo(FConnectionID, FileID, DatOffset);
end;


procedure TAccess_OniArchive.LoadRawOffset(LocSep: Boolean; RawAddr, Size: Integer; target: Pointer);
begin
  if not LocSep then
  begin
    if not FRawOpened then
      Fraw_file := TFileStream.Create(AnsiReplaceStr(FFileName, '.dat', '.raw'),
        fmOpenReadWrite);
    if RawAddr <= Fraw_file.Size then
    begin
      Fraw_file.Seek(RawAddr, soFromBeginning);
      Fraw_file.Read(target^, size);
    end;
    if UnloadWhenUnused then
    begin
      FRawOpened := False;
      Fraw_file.Free;
    end
    else
      FRawOpened := True;
  end
  else
  begin
    if not FSepOpened then
      Fsep_file := TFileStream.Create(AnsiReplaceStr(FFileName, '.dat', '.sep'),
        fmOpenReadWrite);
    if RawAddr <= Fsep_file.Size then
    begin
      Fsep_file.Seek(RawAddr, soFromBeginning);
      Fsep_file.Read(target^, size);
    end;
    if UnloadWhenUnused then
    begin
      FSepOpened := False;
      Fsep_file.Free;
    end
    else
      FSepOpened := True;
  end;
end;

procedure TAccess_OniArchive.LoadRawFile(FileID, DatOffset: Integer; var Target: TStream);
var
  raw_info: TRawDataInfo;
  streampos: Integer;
begin
  if not Assigned(Target) then
    Target := TMemoryStream.Create;
  if fileid < GetFileCount then
  begin
    raw_info := Self.GetRawInfo(FileID, DatOffset);
    if not raw_info.LocSep then
    begin
      if not FRawOpened then
        Fraw_file := TFileStream.Create(AnsiReplaceStr(FFileName, '.dat', '.raw'),
          fmOpenReadWrite);
      Fraw_file.Seek(raw_info.RawAddr, soFromBeginning);
      streampos := Target.Position;
      Target.CopyFrom(Fraw_file, raw_info.RawSize);
      Target.Seek(streampos, soFromBeginning);
      if UnloadWhenUnused then
      begin
        FRawOpened := False;
        Fraw_file.Free;
      end
      else
        FRawOpened := True;
    end
    else
    begin
      if FUnloadWhenUnused or not FSepOpened then
        Fsep_file := TFileStream.Create(AnsiReplaceStr(FFileName, '.dat', '.sep'),
          fmOpenReadWrite);
      Fsep_file.Seek(raw_info.RawAddr, soFromBeginning);
      streampos := Target.Position;
      Target.CopyFrom(Fsep_file, raw_info.RawSize);
      Target.Seek(streampos, soFromBeginning);
      if UnloadWhenUnused then
      begin
        FSepOpened := False;
        Fsep_file.Free;
      end
      else
        FSepOpened := True;
    end;
  end;
end;

procedure TAccess_OniArchive.UpdateRawFile(FileID, DatOffset: Integer; Src: TStream);
var
  raw_info: TRawDataInfo;
begin
  if fileid < GetFileCount then
  begin
    raw_info := GetRawInfo(FileID, DatOffset);
    if not raw_info.LocSep then
    begin
      if not FRawOpened then
        Fraw_file := TFileStream.Create(AnsiReplaceStr(FFileName, '.dat', '.raw'),
          fmOpenReadWrite);
      Fraw_file.Seek(raw_info.RawAddr, soFromBeginning);
      Fraw_file.CopyFrom(Src, raw_info.RawSize);
      if UnloadWhenUnused then
      begin
        FRawOpened := False;
        Fraw_file.Free;
      end
      else
        FRawOpened := True;
    end
    else
    begin
      if not FSepOpened then
        Fsep_file := TFileStream.Create(AnsiReplaceStr(FFileName, '.dat', '.sep'),
          fmOpenReadWrite);
      Fsep_file.Seek(raw_info.RawAddr, soFromBeginning);
      Fsep_file.CopyFrom(Src, raw_info.RawSize);
      if UnloadWhenUnused then
      begin
        FSepOpened := False;
        Fsep_file.Free;
      end
      else
        FSepOpened := True;
    end;
  end;
end;

procedure TAccess_OniArchive.LoadRawFilePart(FileID, DatOffset, Offset, Size: Integer; var Target: TStream);
var
  Data: TStream;
  streampos: Integer;
begin
  if not Assigned(Target) then
    Target := TMemoryStream.Create;
  if fileid < Self.GetFileCount then
  begin
    data := nil;
    LoadRawFile(FileID, DatOffset, Data);
    Data.Seek(Offset, soFromBeginning);
    streampos := Target.Position;
    Target.CopyFrom(Data, Size);
    Target.Seek(streampos, soFromBeginning);
  end;
end;

procedure TAccess_OniArchive.UpdateRawFilePart(FileID, DatOffset, Offset, Size: Integer; Src: TStream);
var
  raw_info: TRawDataInfo;
begin
  if fileid < GetFileCount then
  begin
    raw_info := GetRawInfo(FileID, DatOffset);
    if not raw_info.LocSep then
    begin
      if not FRawOpened then
        Fraw_file := TFileStream.Create(AnsiReplaceStr(FFileName, '.dat', '.raw'),
          fmOpenReadWrite);
      Fraw_file.Seek(raw_info.RawAddr + Offset, soFromBeginning);
      Fraw_file.CopyFrom(Src, Size);
      if UnloadWhenUnused then
      begin
        FRawOpened := False;
        Fraw_file.Free;
      end
      else
        FRawOpened := True;
    end
    else
    begin
      if not FSepOpened then
        Fsep_file := TFileStream.Create(AnsiReplaceStr(FFileName, '.dat', '.sep'),
          fmOpenReadWrite);
      Fsep_file.Seek(raw_info.RawAddr + Offset, soFromBeginning);
      Fsep_file.CopyFrom(Src, Size);
      if UnloadWhenUnused then
      begin
        FSepOpened := False;
        Fsep_file.Free;
      end
      else
        FSepOpened := True;
    end;
  end;
end;

function TAccess_OniArchive.AppendRawFile(LocSep: Boolean; Src: TStream): Integer;
begin
  if not LocSep then
  begin
    if not FRawOpened then
      Fraw_file := TFileStream.Create(AnsiReplaceStr(FFileName, '.dat', '.raw'),
        fmOpenReadWrite);
    Result := Fraw_file.Size;
    Fraw_file.Seek(0, soFromEnd);
    Fraw_file.CopyFrom(Src, Src.Size);
    if UnloadWhenUnused then
    begin
      FRawOpened := False;
      Fraw_file.Free;
    end
    else
      FRawOpened := True;
  end
  else
  begin
    if not FSepOpened then
      Fsep_file := TFileStream.Create(AnsiReplaceStr(FFileName, '.dat', '.sep'),
        fmOpenReadWrite);
    Result := Fsep_file.Size;
    Fsep_file.Seek(0, soFromEnd);
    Fsep_file.CopyFrom(Src, Src.Size);
    if UnloadWhenUnused then
    begin
      FSepOpened := False;
      Fsep_file.Free;
    end
    else
      FSepOpened := True;
  end;
end;

end.
Revision:	105
Committed:	Wed Feb 21 00:29:27 2007 UTC (18 years, 8 months ago) by alloc
Content type:	text/x-pascal
Original Path:	*oup/rewrite/DataAccess/Access_OniArchive.pas*
File size:	19426 byte(s)
Log Message:
#	Content
1	unit Access_OniArchive;
2	interface
3
4	uses DataAccess, Classes, TypeDefs;
5
6	type
7	TAccess_OniArchive = class(TDataAccess)
8	private
9	Fdat_file: TFileStream;
10	Fraw_file: TFileStream;
11	Fsep_file: TFileStream;
12	Fdat_files: TFiles;
13	Fdat_extensionsmap: TExtensionsMap;
14	FUnloadWhenUnused: Boolean;
15	FDatOpened: Boolean;
16	FRawOpened: Boolean;
17	FSepOpened: Boolean;
18	protected
19	public
20	property UnloadWhenUnused: Boolean Read FUnloadWhenUnused Write FUnloadWhenUnused;
21
22	constructor Create(DatFilename: String; ConnectionID: Integer; var Msg: TStatusMessages); override;
23	procedure Close; override;
24
25	function GetFileInfo(FileID: Integer): TFileInfo; override;
26	function GetFilesList(Ext: String; Pattern: String;
27	NoEmptyFiles: Boolean; SortType: TSortType): TStrings; override;
28	function GetFileCount: Integer; override;
29	function GetExtensionsList(ExtListFormat: TExtensionFormat): TStrings; override;
30
31	procedure LoadDatFile(FileID: Integer; var Target: TStream); overload; override;
32	procedure UpdateDatFile(FileID: Integer; Src: TStream); overload; override;
33	procedure LoadDatFilePart(FileID, Offset, Size: Integer; var Target: TStream); overload; override;
34	procedure UpdateDatFilePart(FileID, Offset, Size: Integer; Src: TStream); overload; override;
35
36	function GetRawList(FileID: Integer): TRawDataList; override;
37	function GetRawInfo(FileID, DatOffset: Integer): TRawDataInfo; override;
38
39	procedure LoadRawOffset(LocSep: Boolean; RawAddr, Size: Integer; target: Pointer);
40	procedure LoadRawFile(FileID, DatOffset: Integer; var Target: TStream); overload; override;
41	procedure UpdateRawFile(FileID, DatOffset: Integer; Src: TStream); overload; override;
42	procedure LoadRawFilePart(FileID, DatOffset, Offset, Size: Integer; var Target: TStream); overload; override;
43	procedure UpdateRawFilePart(FileID, DatOffset, Offset, Size: Integer; Src: TStream); overload; override;
44
45	function AppendRawFile(LocSep: Boolean; Src: TStream): Integer; overload; override;
46	published
47	end;
48
49	implementation
50
51	uses
52	SysUtils, StrUtils, Data, Functions, RawList;
53
54
55	(*
56	================================================================================
57	Implementation of TOniDataDat
58	*)
59
60
61	constructor TAccess_OniArchive.Create(DatFilename: String; ConnectionID: Integer; var Msg: TStatusMessages);
62	type
63	THeader = packed record
64	Ident: array[0..$13] of Byte;
65	Files: Integer;
66	NamedFiles: Integer;
67	Extensions: Integer;
68	DataAddr: Integer;
69	DataSize: Integer;
70	NamesAddr: Integer;
71	NamesSize: Integer;
72	Ident2: array[0..$F] of Byte;
73	end;
74	TFilesMap = array of packed record
75	Extension: array[0..$3] of Char;
76	DataAddr: Integer;
77	NameAddr: Integer;
78	FileSize: Integer;
79	FileType: LongWord;
80	end;
81	TNamedFilesMap = array of packed record
82	FileNumber: Integer;
83	blubb: Integer;
84	end;
85	const
86	header_ident1_pc: array[0..$13] of Byte =
87	($1F, $27, $DC, $33, $DF, $BC, $03, $00, $31, $33, $52, $56, $40, $00,
88	$14, $00, $10, $00, $08, $00);
89	header_ident1_mac: array[0..$13] of Byte =
90	($61, $30, $C1, $23, $DF, $BC, $03, $00, $31, $33, $52, $56, $40, $00,
91	$14, $00, $10, $00, $08, $00);
92	header_ident1_macbeta: array[0..$13] of Byte =
93	($81, $11, $8D, $23, $DF, $BC, $03, $00, $31, $33, $52, $56, $40, $00,
94	$14, $00, $10, $00, $08, $00);
95	header_ident2: array[0..$F] of Byte =
96	($99, $CF, $40, $00, $90, $4F, $63, $00, $F4, $55, $5F, $00, $90, $4F, $63, $00);
97	var
98	i: Integer;
99	header_pc, header_mac, header_macbeta: Boolean;
100	Fdat_header: THeader;
101	Fdat_filesmap: TFilesMap;
102	Fdat_namedfilesmap: TNamedFilesMap;
103	begin
104	FUnloadWhenUnused := True;
105	FDatOpened := False;
106	FRawOpened := False;
107	Msg := SM_UnknownError;
108	if not FileExists(DatFilename) then
109	begin
110	Msg := SM_FileNotFound;
111	Exit;
112	end;
113	FFileName := DatFilename;
114	Fdat_file := TFileStream.Create(FFileName, fmOpenRead);
115	Fdat_file.Read(Fdat_header, SizeOf(Fdat_header));
116	header_pc := True;
117	header_mac := True;
118	header_macbeta := True;
119	for i := 0 to High(Fdat_header.Ident) do
120	begin
121	// FLevelInfo.Ident[i] := Fdat_header.Ident[i];
122	if Fdat_header.Ident[i] <> header_ident1_pc[i] then
123	header_pc := False;
124	if Fdat_header.Ident[i] <> header_ident1_mac[i] then
125	header_mac := False;
126	if Fdat_header.Ident[i] <> header_ident1_macbeta[i] then
127	header_macbeta := False;
128	end;
129	if not (header_pc xor header_mac xor header_macbeta) then
130	begin
131	Msg := SM_IncompatibleFile;
132	Exit;
133	end
134	else
135	begin
136	if (header_pc and not header_mac and not header_macbeta) then
137	FDataOS := DOS_WIN
138	else if (not header_pc and header_mac and not header_macbeta) then
139	FDataOS := DOS_MAC
140	else if (not header_pc and not header_mac and header_macbeta) then
141	FDataOS := DOS_MACBETA;
142	end;
143	SetLength(Fdat_filesmap, Fdat_header.Files);
144	SetLength(Fdat_files, Fdat_header.Files);
145	for i := 0 to Fdat_header.Files - 1 do
146	Fdat_file.Read(Fdat_filesmap[i], SizeOf(Fdat_filesmap[i]));
147	for i := 0 to Fdat_header.Files - 1 do
148	begin
149	Fdat_files[i].ID := i;
150	Fdat_files[i].Extension := Fdat_filesmap[i].Extension;
151	Fdat_files[i].Extension := ReverseString(Fdat_files[i].Extension);
152	Fdat_files[i].Size := Fdat_filesmap[i].FileSize;
153	Fdat_files[i].FileType := Fdat_filesmap[i].FileType;
154	Fdat_files[i].DatAddr := Fdat_filesmap[i].DataAddr - 8 + Fdat_header.DataAddr;
155	if (Fdat_filesmap[i].FileType and $01) = 0 then
156	begin
157	Fdat_file.Seek(Fdat_filesmap[i].NameAddr + Fdat_header.NamesAddr, soFromBeginning);
158	SetLength(Fdat_files[i].Name, 100);
159	Fdat_file.Read(Fdat_files[i].Name[1], 100);
160	Fdat_files[i].Name := MidStr(Fdat_files[i].Name, 1 + 4, Pos(
161	#0, Fdat_files[i].Name) - 1 - 4);
162	end
163	else
164	begin
165	Fdat_files[i].Name := '';
166	end;
167	end;
168	Fdat_file.Seek($40 + Fdat_header.Files * $14, soFromBeginning);
169	SetLength(Fdat_namedfilesmap, Fdat_header.NamedFiles);
170	for i := 0 to Fdat_header.NamedFiles - 1 do
171	Fdat_file.Read(Fdat_namedfilesmap[i], SizeOf(Fdat_namedfilesmap[i]));
172
173	Fdat_file.Seek($40 + Fdat_header.Files * $14 + Fdat_header.NamedFiles * $8, soFromBeginning);
174	SetLength(Fdat_extensionsmap, Fdat_header.Extensions);
175	for i := 0 to Fdat_header.Extensions - 1 do
176	Fdat_file.Read(Fdat_extensionsmap[i], SizeOf(Fdat_extensionsmap[i]));
177
178	Fdat_file.Seek(Fdat_files[0].DatAddr + 7, soFromBeginning);
179	Fdat_file.Read(FLevelNumber, 1);
180	FLevelNumber := FLevelNumber div 2;
181
182	Fdat_file.Free;
183
184	Msg := SM_OK;
185	FBackend := DB_ONI;
186	FConnectionID := ConnectionID;
187	FChangeRights := [CR_EditDat, CR_EditRaw, CR_AppendRaw];
188	end;
189
190
191
192
193	procedure TAccess_OniArchive.Close;
194	begin
195	if FDatOpened then
196	Fdat_file.Free;
197	if FRawOpened then
198	Fraw_file.Free;
199	if FSepOpened then
200	Fsep_file.Free;
201	Self.Free;
202	end;
203
204
205
206
207	function TAccess_OniArchive.GetFileInfo(fileid: Integer): TFileInfo;
208	begin
209	if fileid = -1 then
210	begin
211	Result := inherited GetFileInfo(fileid);
212	Exit;
213	end;
214	if fileid < Self.GetFileCount then
215	Result := Fdat_files[fileid]
216	else
217	Result.ID := -1;
218	end;
219
220
221
222
223	function TAccess_OniArchive.GetFilesList(ext: String; pattern: String;
224	NoEmptyFiles: Boolean; SortType: TSortType): TStrings;
225	var
226	i: Integer;
227	list: TStringList;
228	id, name, extension: String;
229	fields: TStrings;
230
231	procedure getfields;
232	begin
233	fields.CommaText := StringReplace(AnsiQuotedStr(list.Strings[i], '"'), ';', '","', [rfReplaceAll]);
234	if SortType in [ST_IDAsc, ST_IDDesc] then
235	begin
236	id := fields.Strings[0];
237	name := fields.Strings[1];
238	extension := fields.Strings[2];
239	end;
240	if SortType in [ST_NameAsc, ST_NameDesc] then
241	begin
242	id := fields.Strings[1];
243	name := fields.Strings[0];
244	extension := fields.Strings[2];
245	end;
246	if SortType in [ST_ExtAsc, ST_ExtDesc] then
247	begin
248	id := fields.Strings[1];
249	name := fields.Strings[2];
250	extension := fields.Strings[0];
251	end;
252	end;
253
254	begin
255	list := TStringList.Create;
256	list.Sorted := True;
257	for i := 0 to GetFileCount - 1 do
258	begin
259	if ((Length(ext) = 0) or (Pos(Fdat_files[i].Extension, ext) > 0)) and
260	((Length(pattern) = 0) or
261	(Pos(UpperCase(pattern), UpperCase(Fdat_files[i].Name)) > 0)) then
262	begin
263	if (NoEmptyFiles = False) or ((Fdat_files[i].FileType and $02) = 0) then
264	begin
265	if AppSettings.FilenumbersAsHex then
266	id := IntToHex(Fdat_files[i].ID, 4)
267	else
268	id := FormatNumber(Fdat_files[i].ID, 5, '0');
269	name := Fdat_files[i].Name;
270	extension := Fdat_files[i].Extension;
271
272	case SortType of
273	ST_IDAsc, ST_IDDesc: list.Add(id + ';' + name + ';' + extension);
274	ST_NameAsc, ST_NameDesc: list.Add(name + ';' + id + ';' + extension);
275	ST_ExtAsc, ST_ExtDesc: list.Add(extension + ';' + id + ';' + name);
276	end;
277	end;
278	end;
279	end;
280	Result := TStringList.Create;
281	if list.Count > 0 then
282	begin
283	fields := TStringList.Create;
284	if SortType in [ST_IDAsc, ST_NameAsc, ST_ExtAsc] then
285	for i := 0 to list.Count - 1 do
286	begin
287	getfields;
288	Result.Add(id + '-' + name + '.' + extension);
289	end
290	else
291	for i := list.Count - 1 downto 0 do
292	begin
293	getfields;
294	Result.Add(id + '-' + name + '.' + extension);
295	end;
296	fields.Free;
297	end;
298	list.Free;
299	end;
300
301
302
303
304	function TAccess_OniArchive.GetFileCount: Integer;
305	begin
306	Result := Length(Fdat_files);
307	end;
308
309
310
311
312	function TAccess_OniArchive.GetExtensionsList(ExtListFormat: TExtensionFormat): TStrings;
313	var
314	i: Integer;
315	begin
316	Result := TStringList.Create;
317	for i := 0 to Length(Fdat_extensionsmap) - 1 do
318	begin
319	with Fdat_extensionsmap[i] do
320	begin
321	case ExtListFormat of
322	EF_ExtOnly:
323	Result.Add(Extension[3] + Extension[2] + Extension[1] + Extension[0]);
324	EF_ExtCount:
325	Result.Add(Extension[3] + Extension[2] + Extension[1] + Extension[0] +
326	' (' + IntToStr(ExtCount) + ')');
327	end;
328	end;
329	end;
330	end;
331
332
333
334	procedure TAccess_OniArchive.LoadDatFile(FileID: Integer; var Target: TStream);
335	var
336	streampos: Integer;
337	begin
338	if fileid < GetFileCount then
339	begin
340	if not Assigned(Target) then
341	Target := TMemoryStream.Create;
342	if not FDatOpened then
343	Fdat_file := TFileStream.Create(FFileName, fmOpenReadWrite);
344	Fdat_file.Seek(Fdat_files[fileid].DatAddr, soFromBeginning);
345	streampos := Target.Position;
346	Target.CopyFrom(Fdat_file, Fdat_files[fileid].Size);
347	Target.Seek(streampos, soFromBeginning);
348	if UnloadWhenUnused then
349	begin
350	Fdat_file.Free;
351	FDatOpened := False;
352	end
353	else
354	FDatOpened := True;
355	end;
356	end;
357
358	procedure TAccess_OniArchive.UpdateDatFile(FileID: Integer; Src: TStream);
359	begin
360	if fileid < GetFileCount then
361	begin
362	if not FDatOpened then
363	Fdat_file := TFileStream.Create(FFileName, fmOpenReadWrite);
364	Fdat_file.Seek(Fdat_files[fileid].DatAddr, soFromBeginning);
365	Fdat_file.CopyFrom(Src, Fdat_files[fileid].Size);
366	if UnloadWhenUnused then
367	begin
368	Fdat_file.Free;
369	FDatOpened := False;
370	end
371	else
372	FDatOpened := True;
373	end;
374	end;
375
376	procedure TAccess_OniArchive.LoadDatFilePart(FileID, Offset, Size: Integer; var Target: TStream);
377	var
378	streampos: Integer;
379	begin
380	if fileid < GetFileCount then
381	begin
382	if not Assigned(Target) then
383	Target := TMemoryStream.Create;
384	if not FDatOpened then
385	Fdat_file := TFileStream.Create(FFileName, fmOpenReadWrite);
386	Fdat_file.Seek(Fdat_files[fileid].DatAddr + offset, soFromBeginning);
387	streampos := Target.Position;
388	Target.CopyFrom(Fdat_file, size);
389	Target.Seek(streampos, soFromBeginning);
390	if UnloadWhenUnused then
391	begin
392	FDatOpened := False;
393	Fdat_file.Free;
394	end
395	else
396	FDatOpened := True;
397	end;
398	end;
399
400	procedure TAccess_OniArchive.UpdateDatFilePart(FileID, Offset, Size: Integer; Src: TStream);
401	begin
402	if fileid < GetFileCount then
403	begin
404	if not FDatOpened then
405	Fdat_file := TFileStream.Create(FFileName, fmOpenReadWrite);
406	Fdat_file.Seek(Fdat_files[fileid].DatAddr + offset, soFromBeginning);
407	Fdat_file.CopyFrom(Src, Size);
408	if UnloadWhenUnused then
409	begin
410	Fdat_file.Free;
411	FDatOpened := False;
412	end
413	else
414	FDatOpened := True;
415	end;
416	end;
417
418
419
420	function TAccess_OniArchive.GetRawList(FileID: Integer): TRawDataList;
421	begin
422	Result := RawLists.GetRawList(FConnectionID, FileID);
423	end;
424
425
426	function TAccess_OniArchive.GetRawInfo(FileID, DatOffset: Integer): TRawDataInfo;
427	begin
428	Result := RawLists.GetRawInfo(FConnectionID, FileID, DatOffset);
429	end;
430
431
432
433
434	procedure TAccess_OniArchive.LoadRawOffset(LocSep: Boolean; RawAddr, Size: Integer; target: Pointer);
435	begin
436	if not LocSep then
437	begin
438	if not FRawOpened then
439	Fraw_file := TFileStream.Create(AnsiReplaceStr(FFileName, '.dat', '.raw'),
440	fmOpenReadWrite);
441	if RawAddr <= Fraw_file.Size then
442	begin
443	Fraw_file.Seek(RawAddr, soFromBeginning);
444	Fraw_file.Read(target^, size);
445	end;
446	if UnloadWhenUnused then
447	begin
448	FRawOpened := False;
449	Fraw_file.Free;
450	end
451	else
452	FRawOpened := True;
453	end
454	else
455	begin
456	if not FSepOpened then
457	Fsep_file := TFileStream.Create(AnsiReplaceStr(FFileName, '.dat', '.sep'),
458	fmOpenReadWrite);
459	if RawAddr <= Fsep_file.Size then
460	begin
461	Fsep_file.Seek(RawAddr, soFromBeginning);
462	Fsep_file.Read(target^, size);
463	end;
464	if UnloadWhenUnused then
465	begin
466	FSepOpened := False;
467	Fsep_file.Free;
468	end
469	else
470	FSepOpened := True;
471	end;
472	end;
473
474	procedure TAccess_OniArchive.LoadRawFile(FileID, DatOffset: Integer; var Target: TStream);
475	var
476	raw_info: TRawDataInfo;
477	streampos: Integer;
478	begin
479	if not Assigned(Target) then
480	Target := TMemoryStream.Create;
481	if fileid < GetFileCount then
482	begin
483	raw_info := Self.GetRawInfo(FileID, DatOffset);
484	if not raw_info.LocSep then
485	begin
486	if not FRawOpened then
487	Fraw_file := TFileStream.Create(AnsiReplaceStr(FFileName, '.dat', '.raw'),
488	fmOpenReadWrite);
489	Fraw_file.Seek(raw_info.RawAddr, soFromBeginning);
490	streampos := Target.Position;
491	Target.CopyFrom(Fraw_file, raw_info.RawSize);
492	Target.Seek(streampos, soFromBeginning);
493	if UnloadWhenUnused then
494	begin
495	FRawOpened := False;
496	Fraw_file.Free;
497	end
498	else
499	FRawOpened := True;
500	end
501	else
502	begin
503	if FUnloadWhenUnused or not FSepOpened then
504	Fsep_file := TFileStream.Create(AnsiReplaceStr(FFileName, '.dat', '.sep'),
505	fmOpenReadWrite);
506	Fsep_file.Seek(raw_info.RawAddr, soFromBeginning);
507	streampos := Target.Position;
508	Target.CopyFrom(Fsep_file, raw_info.RawSize);
509	Target.Seek(streampos, soFromBeginning);
510	if UnloadWhenUnused then
511	begin
512	FSepOpened := False;
513	Fsep_file.Free;
514	end
515	else
516	FSepOpened := True;
517	end;
518	end;
519	end;
520
521	procedure TAccess_OniArchive.UpdateRawFile(FileID, DatOffset: Integer; Src: TStream);
522	var
523	raw_info: TRawDataInfo;
524	begin
525	if fileid < GetFileCount then
526	begin
527	raw_info := GetRawInfo(FileID, DatOffset);
528	if not raw_info.LocSep then
529	begin
530	if not FRawOpened then
531	Fraw_file := TFileStream.Create(AnsiReplaceStr(FFileName, '.dat', '.raw'),
532	fmOpenReadWrite);
533	Fraw_file.Seek(raw_info.RawAddr, soFromBeginning);
534	Fraw_file.CopyFrom(Src, raw_info.RawSize);
535	if UnloadWhenUnused then
536	begin
537	FRawOpened := False;
538	Fraw_file.Free;
539	end
540	else
541	FRawOpened := True;
542	end
543	else
544	begin
545	if not FSepOpened then
546	Fsep_file := TFileStream.Create(AnsiReplaceStr(FFileName, '.dat', '.sep'),
547	fmOpenReadWrite);
548	Fsep_file.Seek(raw_info.RawAddr, soFromBeginning);
549	Fsep_file.CopyFrom(Src, raw_info.RawSize);
550	if UnloadWhenUnused then
551	begin
552	FSepOpened := False;
553	Fsep_file.Free;
554	end
555	else
556	FSepOpened := True;
557	end;
558	end;
559	end;
560
561	procedure TAccess_OniArchive.LoadRawFilePart(FileID, DatOffset, Offset, Size: Integer; var Target: TStream);
562	var
563	Data: TStream;
564	streampos: Integer;
565	begin
566	if not Assigned(Target) then
567	Target := TMemoryStream.Create;
568	if fileid < Self.GetFileCount then
569	begin
570	data := nil;
571	LoadRawFile(FileID, DatOffset, Data);
572	Data.Seek(Offset, soFromBeginning);
573	streampos := Target.Position;
574	Target.CopyFrom(Data, Size);
575	Target.Seek(streampos, soFromBeginning);
576	end;
577	end;
578
579	procedure TAccess_OniArchive.UpdateRawFilePart(FileID, DatOffset, Offset, Size: Integer; Src: TStream);
580	var
581	raw_info: TRawDataInfo;
582	begin
583	if fileid < GetFileCount then
584	begin
585	raw_info := GetRawInfo(FileID, DatOffset);
586	if not raw_info.LocSep then
587	begin
588	if not FRawOpened then
589	Fraw_file := TFileStream.Create(AnsiReplaceStr(FFileName, '.dat', '.raw'),
590	fmOpenReadWrite);
591	Fraw_file.Seek(raw_info.RawAddr + Offset, soFromBeginning);
592	Fraw_file.CopyFrom(Src, Size);
593	if UnloadWhenUnused then
594	begin
595	FRawOpened := False;
596	Fraw_file.Free;
597	end
598	else
599	FRawOpened := True;
600	end
601	else
602	begin
603	if not FSepOpened then
604	Fsep_file := TFileStream.Create(AnsiReplaceStr(FFileName, '.dat', '.sep'),
605	fmOpenReadWrite);
606	Fsep_file.Seek(raw_info.RawAddr + Offset, soFromBeginning);
607	Fsep_file.CopyFrom(Src, Size);
608	if UnloadWhenUnused then
609	begin
610	FSepOpened := False;
611	Fsep_file.Free;
612	end
613	else
614	FSepOpened := True;
615	end;
616	end;
617	end;
618
619	function TAccess_OniArchive.AppendRawFile(LocSep: Boolean; Src: TStream): Integer;
620	begin
621	if not LocSep then
622	begin
623	if not FRawOpened then
624	Fraw_file := TFileStream.Create(AnsiReplaceStr(FFileName, '.dat', '.raw'),
625	fmOpenReadWrite);
626	Result := Fraw_file.Size;
627	Fraw_file.Seek(0, soFromEnd);
628	Fraw_file.CopyFrom(Src, Src.Size);
629	if UnloadWhenUnused then
630	begin
631	FRawOpened := False;
632	Fraw_file.Free;
633	end
634	else
635	FRawOpened := True;
636	end
637	else
638	begin
639	if not FSepOpened then
640	Fsep_file := TFileStream.Create(AnsiReplaceStr(FFileName, '.dat', '.sep'),
641	fmOpenReadWrite);
642	Result := Fsep_file.Size;
643	Fsep_file.Seek(0, soFromEnd);
644	Fsep_file.CopyFrom(Src, Src.Size);
645	if UnloadWhenUnused then
646	begin
647	FSepOpened := False;
648	Fsep_file.Free;
649	end
650	else
651	FSepOpened := True;
652	end;
653	end;
654
655	end.