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