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 GetFileInfo(FileID: Integer): TFileInfo; override;
    function GetFilesList(Ext: String; Pattern: String;
      NoEmptyFiles: Boolean; SortType: TSortType): TStrings; override;
    function GetFileCount: Integer; override;
    function GetExtensionsList(ExtListFormat: TExtensionFormat): TStrings; override;

    procedure LoadDatFile(FileID: Integer; var Target: TStream); overload; override;
    procedure UpdateDatFile(FileID: Integer; Src: TStream); overload; override;
    procedure LoadDatFilePart(FileID, Offset, Size: Integer; var Target: TStream); overload; override;
    procedure UpdateDatFilePart(FileID, Offset, Size: Integer; Src: TStream); overload; override;

    function GetRawList(FileID: Integer): TRawDataList; override;
    function GetRawInfo(FileID, DatOffset: Integer): TRawDataInfo; override;

    procedure 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;


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


constructor TAccess_OUP_ADB.Create(DBFilename: String; ConnectionID: Integer; var Msg: TStatusMessages);
var
  i: Integer;
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 := HexToLong(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.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;
  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
        if AppSettings.FilenumbersAsHex then
          id := IntToHex(Fdat_files[i].ID, 4)
        else
          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);
        end;
      end;
    end;
  end;
  Result := TStringList.Create;
  if list.Count > 0 then
  begin
    fields := TStringList.Create;
    if SortType in [ST_IDAsc, ST_NameAsc, ST_ExtAsc] 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
  Result := TStringList.Create;
  for i := 0 to Length(Fdat_extensionsmap) - 1 do
  begin
    with Fdat_extensionsmap[i] do
    begin
      case ExtListFormat of
        EF_ExtOnly:
          Result.Add(Extension[3] + Extension[2] + Extension[1] + Extension[0]);
        EF_ExtCount:
          Result.Add(Extension[3] + Extension[2] + Extension[1] + Extension[0] +
                ' (' + IntToStr(ExtCount) + ')');
      end;
    end;
  end;
end;


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