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;

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