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;


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