current/DataAccess/Access_OUP_ADB.pas

unit Access_OUP_ADB;
interface

uses DataAccess, ABSMain, TypeDefs, Classes;

type
  TAccess_OUP_ADB = class(TDataAccess)
  private
    FDatabase:          TABSDatabase;
    FQuery:             TABSQuery;
    Fdat_files:         TFiles;
    Fdat_extensionsmap: TExtensionsMap;
  protected
  public
    constructor Create(DBFilename: String; ConnectionID: Integer; var Msg: TStatusMessages); override;
    procedure Close; override;

    procedure UpdateListCache;

    function GetLinksToFile(FileID: Integer): TLinks;

    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 GetDatLinks(FileID: Integer): TDatLinkList; override;
    function GetDatLink(FileID, DatOffset: Integer): TDatLink; override;
    function GetRawList(FileID: Integer): TRawDataList; override;
    function GetRawInfo(FileID, DatOffset: Integer): TRawDataInfo; override;
    function GetRawsForType(RawType: String): TRawDataList; override;

    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;
  published
  end;


implementation

uses
  SysUtils, Data, Functions, ABSDecUtil, DB, DatLinks, StrUtils;


(*
================================================================================
                     Implementation of  TOniDataADB
*)


constructor TAccess_OUP_ADB.Create(DBFilename: String; ConnectionID: Integer; var Msg: TStatusMessages);
begin
  Msg := SM_UnknownError;
  if not FileExists(DBFilename) then
  begin
    Msg := SM_FileNotFound;
    Exit;
  end;
  FFileName := DBFilename;

  FDatabase := TABSDatabase.Create(nil);
  FDatabase.Exclusive := True;
  FDatabase.MultiUser := False;
  FDatabase.DatabaseName := 'OLDBcon' + IntToStr(ConnectionID);
  FDatabase.DatabaseFileName := DBFilename;
  FDatabase.Open;
  FQuery := TABSQuery.Create(FDatabase);
  FQuery.DisableControls;
  FQuery.RequestLive := False;
  FQuery.DatabaseName := 'OLDBcon' + IntToStr(ConnectionID);
  FQuery.SQL.Text := 'SELECT [name],[value] FROM globals ORDER BY [name] ASC';
  FQuery.Open;
  FQuery.First;
  repeat
    if FQuery.FieldByName('name').AsString = 'dbversion' then
    begin
      if FQuery.FieldByName('value').AsString <> DBversion then
      begin
        Msg := SM_IncompatibleDBVersion;
        FQuery.Close;
        Exit;
      end;
    end;
    if FQuery.FieldByName('name').AsString = 'lvl' then
      FLevelNumber := StrToInt(FQuery.FieldByName('value').AsString);
    if FQuery.FieldByName('name').AsString = 'os' then
    begin
      if FQuery.FieldByName('value').AsString = 'WIN' then
        FDataOS := DOS_WIN
      else if FQuery.FieldByName('value').AsString = 'WINDEMO' then
        FDataOS := DOS_WINDEMO
      else if FQuery.FieldByName('value').AsString = 'MAC' then
        FDataOS := DOS_MAC
      else if FQuery.FieldByName('value').AsString = 'MACBETA' then
        FDataOS := DOS_MACBETA;
    end;
    FQuery.Next;
  until FQuery.EOF;
  FQuery.Close;

  Msg := SM_OK;
  FBackend := DB_ADB;

  FConnectionID := ConnectionID;
  FChangeRights := [CR_EditDat, CR_EditRaw, CR_ResizeDat, CR_ResizeRaw];

  UpdateListCache;

  inherited;
end;


procedure TAccess_OUP_ADB.Close;
begin
  FQuery.Free;
  FDatabase.Close;
  FDatabase.Free;
  Self.Free;
end;


procedure TAccess_OUP_ADB.UpdateListCache;
var
  i:     Integer;
  temps: String;
begin
  FQuery.SQL.Text := 'SELECT id,name,extension,[size],contenttype FROM datfiles ORDER BY id ASC;';
  FQuery.Open;
  SetLength(Fdat_files, FQuery.RecordCount);
  if FQuery.RecordCount > 0 then
  begin
    FQuery.First;
    i := 0;
    repeat
      Fdat_files[i].ID := FQuery.FieldByName('id').AsInteger;
      Fdat_files[i].Name := FQuery.FieldByName('name').AsString;
      Fdat_files[i].Extension := FQuery.FieldByName('extension').AsString;
      Fdat_files[i].Size := FQuery.FieldByName('size').AsInteger;
      Fdat_files[i].FileType := StrToInt('$'+FQuery.FieldByName('contenttype').AsString);
      Fdat_files[i].DatAddr := 0;
      Inc(i);
      FQuery.Next;
    until FQuery.EOF;
  end;
  FQuery.Close;

  FQuery.SQL.Text :=
    'SELECT extension,count(extension) AS x FROM datfiles GROUP BY extension ORDER BY extension ASC;';
  FQuery.Open;
  SetLength(Fdat_extensionsmap, FQuery.RecordCount);
  if FQuery.RecordCount > 0 then
  begin
    i := 0;
    repeat
      temps := FQuery.FieldByName('extension').AsString;
      Fdat_extensionsmap[i].Extension[3] := temps[1];
      Fdat_extensionsmap[i].Extension[2] := temps[2];
      Fdat_extensionsmap[i].Extension[1] := temps[3];
      Fdat_extensionsmap[i].Extension[0] := temps[4];
      Fdat_extensionsmap[i].ExtCount := FQuery.FieldByName('x').AsInteger;
      Inc(i);
      FQuery.Next;
    until FQuery.EOF;
  end;
  FQuery.Close;
end;


function TAccess_OUP_ADB.GetLinksToFile(FileID: Integer): TLinks;
var
  i: Integer;
begin
  SetLength(Result.ByName, 0);
  FQuery.SQL.Text := 'SELECT src_link_offset, src_id FROM linkmap WHERE target_id = ' + IntToStr(FileID) + ' ORDER BY src_id ASC;';
  FQuery.Open;
  SetLength(Result.ByID, FQuery.RecordCount);
  if FQuery.RecordCount > 0 then
  begin
    i := 0;
    repeat
      Result.ByID[i].SrcOffset := FQuery.FieldByName('src_link_offset').AsInteger;
      Result.ByID[i].Destination := FQuery.FieldByName('src_id').AsInteger;
      Inc(i);
      FQuery.Next;
    until FQuery.EOF;
  end;
  FQuery.Close;
end;


function TAccess_OUP_ADB.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 CompareItems(List: TStringList; I1, I2: Integer): Integer;
  var
    s1, s2: String;
  begin
    s1 := MidStr(List[I1], 1, PosEx(';', List[I1], 6) - 1);
    s2 := MidStr(List[I2], 1, PosEx(';', List[I2], 6) - 1);
    Result := CompareStr(s1, s2);
  end;

function TAccess_OUP_ADB.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;
  if SortType in [ST_ExtNameAsc, ST_ExtNameDesc] then
    list.Sorted := False
  else
    list.Sorted := True;
  if ext = '*' then
    ext := '';
  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(extension + ';' + name + ';' + id);
        end;
      end;
    end;
  end;
  if SortType in [ST_ExtNameAsc, ST_ExtNameDesc] then
    list.CustomSort(CompareItems);
  if not Assigned(Result) then
    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_OUP_ADB.GetFileCount: Integer;
begin
  Result := Length(Fdat_files);
end;


function TAccess_OUP_ADB.GetExtensionsList(ExtListFormat: TExtensionFormat): TStrings;
var
  i: Integer;
begin
  if not Assigned(Result) then
    Result := TStringList.Create;
  if Result is TStringList then
    TStringList(Result).Sorted := True;
  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_OUP_ADB.LoadDatFile(FileID: Integer; var Target: TStream);
var
  mem: TStream;
  streampos: Integer;
begin
  if fileid < GetFileCount then
  begin
    if not Assigned(Target) then
      Target := TMemoryStream.Create;

    streampos := Target.Position;

    FQuery.SQL.Text := 'SELECT data FROM datfiles WHERE id=' + IntToStr(fileid) + ';';
    FQuery.Open;
    if FQuery.RecordCount > 0 then
    begin
      mem := FQuery.CreateBlobStream(FQuery.FieldByName('data'), bmRead);
      mem.Seek(0, soFromBeginning);
      Target.CopyFrom(mem, mem.Size);
      mem.Free;
    end;
    FQuery.Close;

    Target.Seek(streampos, soFromBeginning);
  end;
end;

procedure TAccess_OUP_ADB.UpdateDatFile(FileID: Integer; Src: TStream);
var
  MimeCoder: TStringFormat_MIME64;
  mem: TMemoryStream;
begin
  if fileid < GetFileCount then
  begin
    mimecoder := TStringFormat_MIME64.Create;
    mem := TMemoryStream.Create;
    mem.CopyFrom(Src, Src.Size); 
    FQuery.SQL.Text := 'UPDATE datfiles SET data=MimeToBin("' +
      MimeCoder.StrTo(mem.Memory, mem.Size) + '"), size=' + IntToStr(mem.Size) +
      ' WHERE id=' + IntToStr(fileid) + ';';
    FQuery.ExecSQL;
    mem.Free;
    mimecoder.Free;
  end;
end;


procedure TAccess_OUP_ADB.LoadDatFilePart(FileID, Offset, Size: Integer; var Target: TStream);
var
  streampos: Integer;
  mem: TStream;
begin
  if fileid < GetFileCount then
  begin
    if not Assigned(Target) then
      Target := TMemoryStream.Create;
    streampos := Target.Position;

    FQuery.SQL.Text := 'SELECT data FROM datfiles WHERE id=' + IntToStr(fileid) + ';';
    FQuery.Open;
    if FQuery.RecordCount > 0 then
    begin
      mem := FQuery.CreateBlobStream(FQuery.FieldByName('data'), bmRead);
      mem.Seek(offset, soFromBeginning);
      Target.CopyFrom(mem, size);
      mem.Free;
    end;
    FQuery.Close;
    Target.Seek(streampos, soFromBeginning);
  end;
end;


procedure TAccess_OUP_ADB.UpdateDatFilePart(FileID, Offset, Size: Integer; Src: TStream);
var
  MimeCoder: TStringFormat_MIME64;
  mem:  TMemoryStream;
begin
  if fileid < GetFileCount then
  begin
    mem := nil;
    LoadDatFile(fileid, TStream(mem));
    mem.Seek(Offset, soFromBeginning);
    mem.CopyFrom(Src, Size);
    mem.Seek(0, soFromBeginning);
    mimecoder := TStringFormat_MIME64.Create;
    FQuery.SQL.Text := 'UPDATE datfiles SET data=MimeToBin("' +
      MimeCoder.StrTo(mem.Memory, mem.Size) + '") WHERE id=' + IntToStr(fileid) + ';';
    FQuery.ExecSQL;
    mem.Free;
    mimecoder.Free;
  end;
end;


function TAccess_OUP_ADB.GetDatLink(FileID, DatOffset: Integer): TDatLink;
begin
  Result := DatLinksManager.GetDatLink(FConnectionID, FileID, DatOffset);
  FQuery.SQL.Text := 'SELECT target_id FROM linkmap WHERE src_id = ' + IntToStr(FileID) + ' and src_link_offset = ' + IntToStr(DatOffset) + ';';
  FQuery.Open;
  if FQuery.RecordCount > 0 then
    Result.DestID := FQuery.FieldByName('target_id').AsInteger;
  FQuery.Close;
end;


function TAccess_OUP_ADB.GetDatLinks(FileID: Integer): TDatLinkList;
var
  i: Integer;
  SrcOffset, DestID: Integer;
begin
  Result := DatLinksManager.GetDatLinks(FConnectionID, FileID);
  if Length(Result) > 0 then
  begin
    FQuery.SQL.Text := 'SELECT src_link_offset, target_id FROM linkmap WHERE src_id = ' + IntToStr(FileID) + ' ORDER BY src_link_offset ASC;';
    FQuery.Open;
    if FQuery.RecordCount > 0 then
    begin
      repeat
        SrcOffset := FQuery.FieldByName('src_link_offset').AsInteger;
        DestID := FQuery.FieldByName('target_id').AsInteger;
        for i := 0 to High(Result) do
          if Result[i].SrcOffset = SrcOffset then
            Break;
        if i < Length(Result) then
          Result[i].DestID := DestID
        else
          Result[i].DestID := -1;
        FQuery.Next;
      until FQuery.EOF;
    end;
    FQuery.Close;
  end;
end;


function TAccess_OUP_ADB.GetRawList(FileID: Integer): TRawDataList;
var
  i: Integer;
begin
  SetLength(Result, 0);
  FQuery.SQL.Text := 'SELECT [src_link_offset],[name],[size],[sep],[type] FROM rawmap WHERE [src_id]=' +
    IntToStr(fileid) + ' ORDER BY src_link_offset ASC;';
  FQuery.Open;
  if FQuery.RecordCount > 0 then
  begin
    FQuery.First;
    SetLength(Result, FQuery.RecordCount);
    i := 0;
    repeat
      Result[i].Name      := FQuery.FieldByName('name').AsString;
      Result[i].SrcID     := fileid;
      Result[i].SrcOffset := FQuery.FieldByName('src_link_offset').AsInteger;
      Result[i].RawAddr   := 0;
      Result[i].RawSize   := FQuery.FieldByName('size').AsInteger;
      Result[i].LocSep    := FQuery.FieldByName('sep').AsBoolean;
      Result[i].RawType   := FQuery.FieldByName('type').AsString;
      Inc(i);
      FQuery.Next;
    until FQuery.EOF;
  end;
  FQuery.Close;
end;


function TAccess_OUP_ADB.GetRawInfo(FileID, DatOffset: Integer): TRawDataInfo;
var
  i: Integer;
  rawlist: TRawDataList;
begin
  rawlist := GetRawList(FileID);
  if Length(rawlist) > 0 then
  begin
    for i := 0 to High(rawlist) do
      if rawlist[i].SrcOffset = DatOffset then
        Break;
    if i < Length(rawlist) then
      Result := rawlist[i]
    else begin
      Result.Name      := '';
      Result.SrcID     := -1;
      Result.SrcOffset := -1;
      Result.RawAddr   := -1;
      Result.RawSize   := -1;
      Result.RawType   := '';
    end;
  end;
end;


function TAccess_OUP_ADB.GetRawsForType(RawType: String): TRawDataList;
var
  i: Integer;
  rawlist: TRawDataList;
begin
  SetLength(Result, 0);
  FQuery.SQL.Text := 'SELECT [src_id],[src_link_offset],[name],[size],[sep] FROM rawmap ' +
    'WHERE [type]="' + RawType + '" ORDER BY src_id ASC, src_link_offset ASC;';
  FQuery.Open;
  if FQuery.RecordCount > 0 then
  begin
    FQuery.First;
    SetLength(Result, FQuery.RecordCount);
    i := 0;
    repeat
      Result[i].Name      := FQuery.FieldByName('name').AsString;
      Result[i].SrcID     := FQuery.FieldByName('src_id').AsInteger;
      Result[i].SrcOffset := FQuery.FieldByName('src_link_offset').AsInteger;
      Result[i].RawAddr   := 0;
      Result[i].RawSize   := FQuery.FieldByName('size').AsInteger;
      Result[i].LocSep    := FQuery.FieldByName('sep').AsBoolean;
      Result[i].RawType   := RawType;
      Inc(i);
      FQuery.Next;
    until FQuery.EOF;
  end;
  FQuery.Close;
end;


procedure TAccess_OUP_ADB.LoadRawFile(FileID, DatOffset: Integer; var Target: TStream);
var
  mem: TStream;
  streampos: Integer;
begin
  if fileid < GetFileCount then
  begin
    if not Assigned(Target) then
      Target := TMemoryStream.Create;
    streampos := Target.Position;
    FQuery.SQL.Text := 'SELECT data FROM rawmap WHERE (src_id=' +
      IntToStr(FileID) + ') AND (src_link_offset=' + IntToStr(DatOffset) + ');';
    FQuery.Open;
    if FQuery.RecordCount > 0 then
    begin
      mem := FQuery.CreateBlobStream(FQuery.FieldByName('data'), bmRead);
      mem.Seek(0, soFromBeginning);
      Target.CopyFrom(mem, mem.Size);
      mem.Free;
    end;
    FQuery.Close;
    Target.Seek(streampos, soFromBeginning);
  end;
end;


procedure TAccess_OUP_ADB.UpdateRawFile(FileID, DatOffset: Integer; Src: TStream);
var
  MimeCoder: TStringFormat_MIME64;
  mem: TMemoryStream;
begin
  if fileid < GetFileCount then
  begin
    mimecoder := TStringFormat_MIME64.Create;
    mem := TMemoryStream.Create;
    mem.CopyFrom(Src, Src.Size);
    mem.Seek(0, soFromBeginning);
    FQuery.SQL.Text := 'UPDATE rawmap SET data=MimeToBin("' + MimeCoder.StrTo(
      mem.Memory, mem.Size) + '") WHERE (src_id=' + IntToStr(FileID) +
      ') AND (src_link_offset=' + IntToStr(DatOffset) + ');';
    FQuery.ExecSQL;
    mem.Free;
    mimecoder.Free;
  end;
end;


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


procedure TAccess_OUP_ADB.UpdateRawFilePart(FileID, DatOffset, Offset, Size: Integer; Src: TStream);
var
  MimeCoder: TStringFormat_MIME64;
  mem:  TMemoryStream;
begin
  if fileid < GetFileCount then
  begin
    mem := nil;
    LoadRawFile(fileid, offset, TStream(mem));
    mem.Seek(offset, soFromBeginning);
    mem.CopyFrom(Src, Size);
    mem.Seek(0, soFromBeginning);
    mimecoder := TStringFormat_MIME64.Create;
    FQuery.SQL.Text := 'UPDATE rawmap SET data=MimeToBin("' + MimeCoder.StrTo(
      mem.Memory, mem.Size) + '") WHERE (src_id=' + IntToStr(fileid) +
      ') AND (src_link_offset=' + IntToStr(DatOffset) + ');';
    FQuery.ExecSQL;
    mem.Free;
    mimecoder.Free;
  end;
end;


end.
Revision:	241
Committed:	Tue Jul 17 22:27:16 2007 UTC (18 years, 2 months ago) by alloc
Content type:	text/x-pascal
File size:	19834 byte(s)
Log Message:
#	Content
1	unit Access_OUP_ADB;
2	interface
3
4	uses DataAccess, ABSMain, TypeDefs, Classes;
5
6	type
7	TAccess_OUP_ADB = class(TDataAccess)
8	private
9	FDatabase: TABSDatabase;
10	FQuery: TABSQuery;
11	Fdat_files: TFiles;
12	Fdat_extensionsmap: TExtensionsMap;
13	protected
14	public
15	constructor Create(DBFilename: String; ConnectionID: Integer; var Msg: TStatusMessages); override;
16	procedure Close; override;
17
18	procedure UpdateListCache;
19
20	function GetLinksToFile(FileID: Integer): TLinks;
21
22	function GetFileInfo(FileID: Integer): TFileInfo; override;
23	function GetFilesList(Ext: String; Pattern: String;
24	NoEmptyFiles: Boolean; SortType: TSortType): TStrings; override;
25	function GetFileCount: Integer; override;
26	function GetExtensionsList(ExtListFormat: TExtensionFormat): TStrings; override;
27
28	procedure LoadDatFile(FileID: Integer; var Target: TStream); overload; override;
29	procedure UpdateDatFile(FileID: Integer; Src: TStream); overload; override;
30	procedure LoadDatFilePart(FileID, Offset, Size: Integer; var Target: TStream); overload; override;
31	procedure UpdateDatFilePart(FileID, Offset, Size: Integer; Src: TStream); overload; override;
32
33	function GetDatLinks(FileID: Integer): TDatLinkList; override;
34	function GetDatLink(FileID, DatOffset: Integer): TDatLink; override;
35	function GetRawList(FileID: Integer): TRawDataList; override;
36	function GetRawInfo(FileID, DatOffset: Integer): TRawDataInfo; override;
37	function GetRawsForType(RawType: String): TRawDataList; override;
38
39	procedure LoadRawFile(FileID, DatOffset: Integer; var Target: TStream); overload; override;
40	procedure UpdateRawFile(FileID, DatOffset: Integer; Src: TStream); overload; override;
41	procedure LoadRawFilePart(FileID, DatOffset, Offset, Size: Integer; var Target: TStream); overload; override;
42	procedure UpdateRawFilePart(FileID, DatOffset, Offset, Size: Integer; Src: TStream); overload; override;
43	published
44	end;
45
46
47	implementation
48
49	uses
50	SysUtils, Data, Functions, ABSDecUtil, DB, DatLinks, StrUtils;
51
52
53	(*
54	================================================================================
55	Implementation of TOniDataADB
56	*)
57
58
59	constructor TAccess_OUP_ADB.Create(DBFilename: String; ConnectionID: Integer; var Msg: TStatusMessages);
60	begin
61	Msg := SM_UnknownError;
62	if not FileExists(DBFilename) then
63	begin
64	Msg := SM_FileNotFound;
65	Exit;
66	end;
67	FFileName := DBFilename;
68
69	FDatabase := TABSDatabase.Create(nil);
70	FDatabase.Exclusive := True;
71	FDatabase.MultiUser := False;
72	FDatabase.DatabaseName := 'OLDBcon' + IntToStr(ConnectionID);
73	FDatabase.DatabaseFileName := DBFilename;
74	FDatabase.Open;
75	FQuery := TABSQuery.Create(FDatabase);
76	FQuery.DisableControls;
77	FQuery.RequestLive := False;
78	FQuery.DatabaseName := 'OLDBcon' + IntToStr(ConnectionID);
79	FQuery.SQL.Text := 'SELECT [name],[value] FROM globals ORDER BY [name] ASC';
80	FQuery.Open;
81	FQuery.First;
82	repeat
83	if FQuery.FieldByName('name').AsString = 'dbversion' then
84	begin
85	if FQuery.FieldByName('value').AsString <> DBversion then
86	begin
87	Msg := SM_IncompatibleDBVersion;
88	FQuery.Close;
89	Exit;
90	end;
91	end;
92	if FQuery.FieldByName('name').AsString = 'lvl' then
93	FLevelNumber := StrToInt(FQuery.FieldByName('value').AsString);
94	if FQuery.FieldByName('name').AsString = 'os' then
95	begin
96	if FQuery.FieldByName('value').AsString = 'WIN' then
97	FDataOS := DOS_WIN
98	else if FQuery.FieldByName('value').AsString = 'WINDEMO' then
99	FDataOS := DOS_WINDEMO
100	else if FQuery.FieldByName('value').AsString = 'MAC' then
101	FDataOS := DOS_MAC
102	else if FQuery.FieldByName('value').AsString = 'MACBETA' then
103	FDataOS := DOS_MACBETA;
104	end;
105	FQuery.Next;
106	until FQuery.EOF;
107	FQuery.Close;
108
109	Msg := SM_OK;
110	FBackend := DB_ADB;
111
112	FConnectionID := ConnectionID;
113	FChangeRights := [CR_EditDat, CR_EditRaw, CR_ResizeDat, CR_ResizeRaw];
114
115	UpdateListCache;
116
117	inherited;
118	end;
119
120
121
122
123	procedure TAccess_OUP_ADB.Close;
124	begin
125	FQuery.Free;
126	FDatabase.Close;
127	FDatabase.Free;
128	Self.Free;
129	end;
130
131
132
133	procedure TAccess_OUP_ADB.UpdateListCache;
134	var
135	i: Integer;
136	temps: String;
137	begin
138	FQuery.SQL.Text := 'SELECT id,name,extension,[size],contenttype FROM datfiles ORDER BY id ASC;';
139	FQuery.Open;
140	SetLength(Fdat_files, FQuery.RecordCount);
141	if FQuery.RecordCount > 0 then
142	begin
143	FQuery.First;
144	i := 0;
145	repeat
146	Fdat_files[i].ID := FQuery.FieldByName('id').AsInteger;
147	Fdat_files[i].Name := FQuery.FieldByName('name').AsString;
148	Fdat_files[i].Extension := FQuery.FieldByName('extension').AsString;
149	Fdat_files[i].Size := FQuery.FieldByName('size').AsInteger;
150	Fdat_files[i].FileType := StrToInt('$'+FQuery.FieldByName('contenttype').AsString);
151	Fdat_files[i].DatAddr := 0;
152	Inc(i);
153	FQuery.Next;
154	until FQuery.EOF;
155	end;
156	FQuery.Close;
157
158	FQuery.SQL.Text :=
159	'SELECT extension,count(extension) AS x FROM datfiles GROUP BY extension ORDER BY extension ASC;';
160	FQuery.Open;
161	SetLength(Fdat_extensionsmap, FQuery.RecordCount);
162	if FQuery.RecordCount > 0 then
163	begin
164	i := 0;
165	repeat
166	temps := FQuery.FieldByName('extension').AsString;
167	Fdat_extensionsmap[i].Extension[3] := temps[1];
168	Fdat_extensionsmap[i].Extension[2] := temps[2];
169	Fdat_extensionsmap[i].Extension[1] := temps[3];
170	Fdat_extensionsmap[i].Extension[0] := temps[4];
171	Fdat_extensionsmap[i].ExtCount := FQuery.FieldByName('x').AsInteger;
172	Inc(i);
173	FQuery.Next;
174	until FQuery.EOF;
175	end;
176	FQuery.Close;
177	end;
178
179
180
181	function TAccess_OUP_ADB.GetLinksToFile(FileID: Integer): TLinks;
182	var
183	i: Integer;
184	begin
185	SetLength(Result.ByName, 0);
186	FQuery.SQL.Text := 'SELECT src_link_offset, src_id FROM linkmap WHERE target_id = ' + IntToStr(FileID) + ' ORDER BY src_id ASC;';
187	FQuery.Open;
188	SetLength(Result.ByID, FQuery.RecordCount);
189	if FQuery.RecordCount > 0 then
190	begin
191	i := 0;
192	repeat
193	Result.ByID[i].SrcOffset := FQuery.FieldByName('src_link_offset').AsInteger;
194	Result.ByID[i].Destination := FQuery.FieldByName('src_id').AsInteger;
195	Inc(i);
196	FQuery.Next;
197	until FQuery.EOF;
198	end;
199	FQuery.Close;
200	end;
201
202
203
204	function TAccess_OUP_ADB.GetFileInfo(fileid: Integer): TFileInfo;
205	begin
206	if fileid = -1 then
207	begin
208	Result := inherited GetFileInfo(fileid);
209	Exit;
210	end;
211	if fileid < Self.GetFileCount then
212	Result := Fdat_files[fileid]
213	else
214	Result.ID := -1;
215	end;
216
217
218
219	function CompareItems(List: TStringList; I1, I2: Integer): Integer;
220	var
221	s1, s2: String;
222	begin
223	s1 := MidStr(List[I1], 1, PosEx(';', List[I1], 6) - 1);
224	s2 := MidStr(List[I2], 1, PosEx(';', List[I2], 6) - 1);
225	Result := CompareStr(s1, s2);
226	end;
227
228	function TAccess_OUP_ADB.GetFilesList(ext: String; pattern: String;
229	NoEmptyFiles: Boolean; SortType: TSortType): TStrings;
230	var
231	i: Integer;
232	list: TStringList;
233	id, name, extension: String;
234	fields: TStrings;
235
236	procedure getfields;
237	begin
238	fields.CommaText := StringReplace(AnsiQuotedStr(list.Strings[i], '"'), ';', '","', [rfReplaceAll]);
239	if SortType in [ST_IDAsc, ST_IDDesc] then
240	begin
241	id := fields.Strings[0];
242	name := fields.Strings[1];
243	extension := fields.Strings[2];
244	end;
245	if SortType in [ST_NameAsc, ST_NameDesc] then
246	begin
247	id := fields.Strings[1];
248	name := fields.Strings[0];
249	extension := fields.Strings[2];
250	end;
251	if SortType in [ST_ExtAsc, ST_ExtDesc] then
252	begin
253	id := fields.Strings[1];
254	name := fields.Strings[2];
255	extension := fields.Strings[0];
256	end;
257	if SortType in [ST_ExtNameAsc, ST_ExtNameDesc] then
258	begin
259	id := fields.Strings[2];
260	name := fields.Strings[1];
261	extension := fields.Strings[0];
262	end;
263	end;
264
265	begin
266	list := TStringList.Create;
267	if SortType in [ST_ExtNameAsc, ST_ExtNameDesc] then
268	list.Sorted := False
269	else
270	list.Sorted := True;
271	if ext = '*' then
272	ext := '';
273	for i := 0 to GetFileCount - 1 do
274	begin
275	if ((Length(ext) = 0) or (Pos(Fdat_files[i].Extension, ext) > 0)) and
276	((Length(pattern) = 0) or
277	(Pos(UpperCase(pattern), UpperCase(Fdat_files[i].Name)) > 0)) then
278	begin
279	if (NoEmptyFiles = False) or ((Fdat_files[i].FileType and $02) = 0) then
280	begin
281	id := FormatNumber(Fdat_files[i].ID, 5, '0');
282	name := Fdat_files[i].Name;
283	extension := Fdat_files[i].Extension;
284
285	case SortType of
286	ST_IDAsc, ST_IDDesc: list.Add(id + ';' + name + ';' + extension);
287	ST_NameAsc, ST_NameDesc: list.Add(name + ';' + id + ';' + extension);
288	ST_ExtAsc, ST_ExtDesc: list.Add(extension + ';' + id + ';' + name);
289	ST_ExtNameAsc, ST_ExtNameDesc: list.Add(extension + ';' + name + ';' + id);
290	end;
291	end;
292	end;
293	end;
294	if SortType in [ST_ExtNameAsc, ST_ExtNameDesc] then
295	list.CustomSort(CompareItems);
296	if not Assigned(Result) then
297	Result := TStringList.Create;
298	if list.Count > 0 then
299	begin
300	fields := TStringList.Create;
301	if SortType in [ST_IDAsc, ST_NameAsc, ST_ExtAsc, ST_ExtNameAsc] then
302	for i := 0 to list.Count - 1 do
303	begin
304	getfields;
305	Result.Add(id + '-' + name + '.' + extension);
306	end
307	else
308	for i := list.Count - 1 downto 0 do
309	begin
310	getfields;
311	Result.Add(id + '-' + name + '.' + extension);
312	end;
313	fields.Free;
314	end;
315	list.Free;
316	end;
317
318
319
320
321	function TAccess_OUP_ADB.GetFileCount: Integer;
322	begin
323	Result := Length(Fdat_files);
324	end;
325
326
327	function TAccess_OUP_ADB.GetExtensionsList(ExtListFormat: TExtensionFormat): TStrings;
328	var
329	i: Integer;
330	begin
331	if not Assigned(Result) then
332	Result := TStringList.Create;
333	if Result is TStringList then
334	TStringList(Result).Sorted := True;
335	for i := 0 to Length(Fdat_extensionsmap) - 1 do
336	begin
337	with Fdat_extensionsmap[i] do
338	begin
339	case ExtListFormat of
340	EF_ExtOnly:
341	Result.Add(Extension[3] + Extension[2] + Extension[1] + Extension[0]);
342	EF_ExtCount:
343	Result.Add(Extension[3] + Extension[2] + Extension[1] + Extension[0] +
344	' (' + IntToStr(ExtCount) + ')');
345	end;
346	end;
347	end;
348	end;
349
350
351	procedure TAccess_OUP_ADB.LoadDatFile(FileID: Integer; var Target: TStream);
352	var
353	mem: TStream;
354	streampos: Integer;
355	begin
356	if fileid < GetFileCount then
357	begin
358	if not Assigned(Target) then
359	Target := TMemoryStream.Create;
360
361	streampos := Target.Position;
362
363	FQuery.SQL.Text := 'SELECT data FROM datfiles WHERE id=' + IntToStr(fileid) + ';';
364	FQuery.Open;
365	if FQuery.RecordCount > 0 then
366	begin
367	mem := FQuery.CreateBlobStream(FQuery.FieldByName('data'), bmRead);
368	mem.Seek(0, soFromBeginning);
369	Target.CopyFrom(mem, mem.Size);
370	mem.Free;
371	end;
372	FQuery.Close;
373
374	Target.Seek(streampos, soFromBeginning);
375	end;
376	end;
377
378	procedure TAccess_OUP_ADB.UpdateDatFile(FileID: Integer; Src: TStream);
379	var
380	MimeCoder: TStringFormat_MIME64;
381	mem: TMemoryStream;
382	begin
383	if fileid < GetFileCount then
384	begin
385	mimecoder := TStringFormat_MIME64.Create;
386	mem := TMemoryStream.Create;
387	mem.CopyFrom(Src, Src.Size);
388	FQuery.SQL.Text := 'UPDATE datfiles SET data=MimeToBin("' +
389	MimeCoder.StrTo(mem.Memory, mem.Size) + '"), size=' + IntToStr(mem.Size) +
390	' WHERE id=' + IntToStr(fileid) + ';';
391	FQuery.ExecSQL;
392	mem.Free;
393	mimecoder.Free;
394	end;
395	end;
396
397
398
399	procedure TAccess_OUP_ADB.LoadDatFilePart(FileID, Offset, Size: Integer; var Target: TStream);
400	var
401	streampos: Integer;
402	mem: TStream;
403	begin
404	if fileid < GetFileCount then
405	begin
406	if not Assigned(Target) then
407	Target := TMemoryStream.Create;
408	streampos := Target.Position;
409
410	FQuery.SQL.Text := 'SELECT data FROM datfiles WHERE id=' + IntToStr(fileid) + ';';
411	FQuery.Open;
412	if FQuery.RecordCount > 0 then
413	begin
414	mem := FQuery.CreateBlobStream(FQuery.FieldByName('data'), bmRead);
415	mem.Seek(offset, soFromBeginning);
416	Target.CopyFrom(mem, size);
417	mem.Free;
418	end;
419	FQuery.Close;
420	Target.Seek(streampos, soFromBeginning);
421	end;
422	end;
423
424
425
426	procedure TAccess_OUP_ADB.UpdateDatFilePart(FileID, Offset, Size: Integer; Src: TStream);
427	var
428	MimeCoder: TStringFormat_MIME64;
429	mem: TMemoryStream;
430	begin
431	if fileid < GetFileCount then
432	begin
433	mem := nil;
434	LoadDatFile(fileid, TStream(mem));
435	mem.Seek(Offset, soFromBeginning);
436	mem.CopyFrom(Src, Size);
437	mem.Seek(0, soFromBeginning);
438	mimecoder := TStringFormat_MIME64.Create;
439	FQuery.SQL.Text := 'UPDATE datfiles SET data=MimeToBin("' +
440	MimeCoder.StrTo(mem.Memory, mem.Size) + '") WHERE id=' + IntToStr(fileid) + ';';
441	FQuery.ExecSQL;
442	mem.Free;
443	mimecoder.Free;
444	end;
445	end;
446
447
448
449	function TAccess_OUP_ADB.GetDatLink(FileID, DatOffset: Integer): TDatLink;
450	begin
451	Result := DatLinksManager.GetDatLink(FConnectionID, FileID, DatOffset);
452	FQuery.SQL.Text := 'SELECT target_id FROM linkmap WHERE src_id = ' + IntToStr(FileID) + ' and src_link_offset = ' + IntToStr(DatOffset) + ';';
453	FQuery.Open;
454	if FQuery.RecordCount > 0 then
455	Result.DestID := FQuery.FieldByName('target_id').AsInteger;
456	FQuery.Close;
457	end;
458
459
460	function TAccess_OUP_ADB.GetDatLinks(FileID: Integer): TDatLinkList;
461	var
462	i: Integer;
463	SrcOffset, DestID: Integer;
464	begin
465	Result := DatLinksManager.GetDatLinks(FConnectionID, FileID);
466	if Length(Result) > 0 then
467	begin
468	FQuery.SQL.Text := 'SELECT src_link_offset, target_id FROM linkmap WHERE src_id = ' + IntToStr(FileID) + ' ORDER BY src_link_offset ASC;';
469	FQuery.Open;
470	if FQuery.RecordCount > 0 then
471	begin
472	repeat
473	SrcOffset := FQuery.FieldByName('src_link_offset').AsInteger;
474	DestID := FQuery.FieldByName('target_id').AsInteger;
475	for i := 0 to High(Result) do
476	if Result[i].SrcOffset = SrcOffset then
477	Break;
478	if i < Length(Result) then
479	Result[i].DestID := DestID
480	else
481	Result[i].DestID := -1;
482	FQuery.Next;
483	until FQuery.EOF;
484	end;
485	FQuery.Close;
486	end;
487	end;
488
489
490	function TAccess_OUP_ADB.GetRawList(FileID: Integer): TRawDataList;
491	var
492	i: Integer;
493	begin
494	SetLength(Result, 0);
495	FQuery.SQL.Text := 'SELECT [src_link_offset],[name],[size],[sep],[type] FROM rawmap WHERE [src_id]=' +
496	IntToStr(fileid) + ' ORDER BY src_link_offset ASC;';
497	FQuery.Open;
498	if FQuery.RecordCount > 0 then
499	begin
500	FQuery.First;
501	SetLength(Result, FQuery.RecordCount);
502	i := 0;
503	repeat
504	Result[i].Name := FQuery.FieldByName('name').AsString;
505	Result[i].SrcID := fileid;
506	Result[i].SrcOffset := FQuery.FieldByName('src_link_offset').AsInteger;
507	Result[i].RawAddr := 0;
508	Result[i].RawSize := FQuery.FieldByName('size').AsInteger;
509	Result[i].LocSep := FQuery.FieldByName('sep').AsBoolean;
510	Result[i].RawType := FQuery.FieldByName('type').AsString;
511	Inc(i);
512	FQuery.Next;
513	until FQuery.EOF;
514	end;
515	FQuery.Close;
516	end;
517
518
519	function TAccess_OUP_ADB.GetRawInfo(FileID, DatOffset: Integer): TRawDataInfo;
520	var
521	i: Integer;
522	rawlist: TRawDataList;
523	begin
524	rawlist := GetRawList(FileID);
525	if Length(rawlist) > 0 then
526	begin
527	for i := 0 to High(rawlist) do
528	if rawlist[i].SrcOffset = DatOffset then
529	Break;
530	if i < Length(rawlist) then
531	Result := rawlist[i]
532	else begin
533	Result.Name := '';
534	Result.SrcID := -1;
535	Result.SrcOffset := -1;
536	Result.RawAddr := -1;
537	Result.RawSize := -1;
538	Result.RawType := '';
539	end;
540	end;
541	end;
542
543
544	function TAccess_OUP_ADB.GetRawsForType(RawType: String): TRawDataList;
545	var
546	i: Integer;
547	rawlist: TRawDataList;
548	begin
549	SetLength(Result, 0);
550	FQuery.SQL.Text := 'SELECT [src_id],[src_link_offset],[name],[size],[sep] FROM rawmap ' +
551	'WHERE [type]="' + RawType + '" ORDER BY src_id ASC, src_link_offset ASC;';
552	FQuery.Open;
553	if FQuery.RecordCount > 0 then
554	begin
555	FQuery.First;
556	SetLength(Result, FQuery.RecordCount);
557	i := 0;
558	repeat
559	Result[i].Name := FQuery.FieldByName('name').AsString;
560	Result[i].SrcID := FQuery.FieldByName('src_id').AsInteger;
561	Result[i].SrcOffset := FQuery.FieldByName('src_link_offset').AsInteger;
562	Result[i].RawAddr := 0;
563	Result[i].RawSize := FQuery.FieldByName('size').AsInteger;
564	Result[i].LocSep := FQuery.FieldByName('sep').AsBoolean;
565	Result[i].RawType := RawType;
566	Inc(i);
567	FQuery.Next;
568	until FQuery.EOF;
569	end;
570	FQuery.Close;
571	end;
572
573
574
575
576	procedure TAccess_OUP_ADB.LoadRawFile(FileID, DatOffset: Integer; var Target: TStream);
577	var
578	mem: TStream;
579	streampos: Integer;
580	begin
581	if fileid < GetFileCount then
582	begin
583	if not Assigned(Target) then
584	Target := TMemoryStream.Create;
585	streampos := Target.Position;
586	FQuery.SQL.Text := 'SELECT data FROM rawmap WHERE (src_id=' +
587	IntToStr(FileID) + ') AND (src_link_offset=' + IntToStr(DatOffset) + ');';
588	FQuery.Open;
589	if FQuery.RecordCount > 0 then
590	begin
591	mem := FQuery.CreateBlobStream(FQuery.FieldByName('data'), bmRead);
592	mem.Seek(0, soFromBeginning);
593	Target.CopyFrom(mem, mem.Size);
594	mem.Free;
595	end;
596	FQuery.Close;
597	Target.Seek(streampos, soFromBeginning);
598	end;
599	end;
600
601
602	procedure TAccess_OUP_ADB.UpdateRawFile(FileID, DatOffset: Integer; Src: TStream);
603	var
604	MimeCoder: TStringFormat_MIME64;
605	mem: TMemoryStream;
606	begin
607	if fileid < GetFileCount then
608	begin
609	mimecoder := TStringFormat_MIME64.Create;
610	mem := TMemoryStream.Create;
611	mem.CopyFrom(Src, Src.Size);
612	mem.Seek(0, soFromBeginning);
613	FQuery.SQL.Text := 'UPDATE rawmap SET data=MimeToBin("' + MimeCoder.StrTo(
614	mem.Memory, mem.Size) + '") WHERE (src_id=' + IntToStr(FileID) +
615	') AND (src_link_offset=' + IntToStr(DatOffset) + ');';
616	FQuery.ExecSQL;
617	mem.Free;
618	mimecoder.Free;
619	end;
620	end;
621
622
623
624
625	procedure TAccess_OUP_ADB.LoadRawFilePart(FileID, DatOffset, Offset, Size: Integer; var Target: TStream);
626	var
627	mem: TMemoryStream;
628	streampos: Integer;
629	begin
630	if fileid < GetFileCount then
631	begin
632	if not Assigned(Target) then
633	Target := TMemoryStream.Create;
634	streampos := Target.Position;
635	mem := nil;
636	LoadRawFile(FileID, DatOffset, TStream(mem));
637	mem.Seek(Offset, soFromBeginning);
638	Target.CopyFrom(mem, Size);
639	mem.Free;
640	Target.Seek(streampos, soFromBeginning);
641	end;
642	end;
643
644
645
646
647	procedure TAccess_OUP_ADB.UpdateRawFilePart(FileID, DatOffset, Offset, Size: Integer; Src: TStream);
648	var
649	MimeCoder: TStringFormat_MIME64;
650	mem: TMemoryStream;
651	begin
652	if fileid < GetFileCount then
653	begin
654	mem := nil;
655	LoadRawFile(fileid, offset, TStream(mem));
656	mem.Seek(offset, soFromBeginning);
657	mem.CopyFrom(Src, Size);
658	mem.Seek(0, soFromBeginning);
659	mimecoder := TStringFormat_MIME64.Create;
660	FQuery.SQL.Text := 'UPDATE rawmap SET data=MimeToBin("' + MimeCoder.StrTo(
661	mem.Memory, mem.Size) + '") WHERE (src_id=' + IntToStr(fileid) +
662	') AND (src_link_offset=' + IntToStr(DatOffset) + ');';
663	FQuery.ExecSQL;
664	mem.Free;
665	mimecoder.Free;
666	end;
667	end;
668
669
670
671
672	end.