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