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