source: oup/current/DataAccess/Access_OUP_ADB.pas @ 113

Last change on this file since 113 was 113, checked in by alloc, 15 years ago
File size: 16.8 KB
Line 
1unit Access_OUP_ADB;
2interface
3
4uses DataAccess, ABSMain, TypeDefs, Classes;
5
6type
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 GetDatLinks(FileID: Integer): TDatLinkList; 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
46implementation
47
48uses
49  SysUtils, Data, Functions, ABSDecUtil, DB;
50
51
52(*
53================================================================================
54                     Implementation of  TOniDataADB
55*)
56
57
58constructor TAccess_OUP_ADB.Create(DBFilename: String; ConnectionID: Integer; var Msg: TStatusMessages);
59begin
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;
111end;
112
113
114
115
116procedure TAccess_OUP_ADB.Close;
117begin
118  FQuery.Free;
119  FDatabase.Close;
120  FDatabase.Free;
121  Self.Free;
122end;
123
124
125
126procedure TAccess_OUP_ADB.UpdateListCache;
127var
128  i:     Integer;
129  temps: String;
130begin
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;
170end;
171
172
173
174function TAccess_OUP_ADB.GetLinksToFile(FileID: Integer): TLinks;
175var
176  i: Integer;
177begin
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;
193end;
194
195function TAccess_OUP_ADB.GetLinksFromFile(FileID: Integer): TLinks;
196var
197  i: Integer;
198begin
199  SetLength(Result.ByName, 0);
200  FQuery.SQL.Text := 'SELECT src_link_offset, target_id FROM linkmap WHERE src_id = ' + IntToStr(FileID) + ' ORDER BY target_id ASC;';
201  FQuery.Open;
202  SetLength(Result.ByID, FQuery.RecordCount);
203  if FQuery.RecordCount > 0 then
204  begin
205    i := 0;
206    repeat
207      Result.ByID[i].SrcOffset := FQuery.FieldByName('src_link_offset').AsInteger;
208      Result.ByID[i].Destination := FQuery.FieldByName('target_id').AsInteger;
209      Inc(i);
210      FQuery.Next;
211    until FQuery.EOF;
212  end;
213  FQuery.Close;
214end;
215
216
217
218function TAccess_OUP_ADB.GetFileInfo(fileid: Integer): TFileInfo;
219begin
220  if fileid = -1 then
221  begin
222    Result := inherited GetFileInfo(fileid);
223    Exit;
224  end;
225  if fileid < Self.GetFileCount then
226    Result    := Fdat_files[fileid]
227  else
228    Result.ID := -1;
229end;
230
231
232
233
234function TAccess_OUP_ADB.GetFilesList(ext: String; pattern: String;
235  NoEmptyFiles: Boolean; SortType: TSortType): TStrings;
236var
237  i:      Integer;
238  list:   TStringList;
239  id, name, extension: String;
240  fields: TStrings;
241
242  procedure getfields;
243  begin
244    fields.CommaText := StringReplace(AnsiQuotedStr(list.Strings[i], '"'), ';', '","', [rfReplaceAll]);
245    if SortType in [ST_IDAsc, ST_IDDesc] then
246    begin
247      id := fields.Strings[0];
248      name := fields.Strings[1];
249      extension := fields.Strings[2];
250    end;
251    if SortType in [ST_NameAsc, ST_NameDesc] then
252    begin
253      id := fields.Strings[1];
254      name := fields.Strings[0];
255      extension := fields.Strings[2];
256    end;
257    if SortType in [ST_ExtAsc, ST_ExtDesc] then
258    begin
259      id := fields.Strings[1];
260      name := fields.Strings[2];
261      extension := fields.Strings[0];
262    end;
263    if SortType in [ST_ExtNameAsc, ST_ExtNameDesc] then
264    begin
265      id := fields.Strings[2];
266      name := fields.Strings[1];
267      extension := fields.Strings[0];
268    end;
269  end;
270
271begin
272  list := TStringList.Create;
273  list.Sorted := True;
274  for i := 0 to GetFileCount - 1 do
275  begin
276    if ((Length(ext) = 0) or (Pos(Fdat_files[i].Extension, ext) > 0)) and
277      ((Length(pattern) = 0) or
278      (Pos(UpperCase(pattern), UpperCase(Fdat_files[i].Name)) > 0)) then
279    begin
280      if (NoEmptyFiles = False) or ((Fdat_files[i].FileType and $02) = 0) then
281      begin
282        id := FormatNumber(Fdat_files[i].ID, 5, '0');
283        name := Fdat_files[i].Name;
284        extension := Fdat_files[i].Extension;
285
286        case SortType of
287          ST_IDAsc, ST_IDDesc:     list.Add(id + ';' + name + ';' + extension);
288          ST_NameAsc, ST_NameDesc: list.Add(name + ';' + id + ';' + extension);
289          ST_ExtAsc, ST_ExtDesc:   list.Add(extension + ';' + id + ';' + name);
290          ST_ExtNameAsc, ST_ExtNameDesc: list.Add(name + ';' + extension + ';' + id);
291        end;
292      end;
293    end;
294  end;
295  if not Assigned(Result) then
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;
315end;
316
317
318
319
320function TAccess_OUP_ADB.GetFileCount: Integer;
321begin
322  Result := Length(Fdat_files);
323end;
324
325
326function TAccess_OUP_ADB.GetExtensionsList(ExtListFormat: TExtensionFormat): TStrings;
327var
328  i: Integer;
329begin
330  if not Assigned(Result) then
331    Result := TStringList.Create;
332  if Result is TStringList then
333    TStringList(Result).Sorted := True;
334  for i := 0 to Length(Fdat_extensionsmap) - 1 do
335  begin
336    with Fdat_extensionsmap[i] do
337    begin
338      case ExtListFormat of
339        EF_ExtOnly:
340          Result.Add(Extension[3] + Extension[2] + Extension[1] + Extension[0]);
341        EF_ExtCount:
342          Result.Add(Extension[3] + Extension[2] + Extension[1] + Extension[0] +
343                ' (' + IntToStr(ExtCount) + ')');
344      end;
345    end;
346  end;
347end;
348
349
350procedure TAccess_OUP_ADB.LoadDatFile(FileID: Integer; var Target: TStream);
351var
352  mem: TStream;
353  streampos: Integer;
354begin
355  if fileid < GetFileCount then
356  begin
357    if not Assigned(Target) then
358      Target := TMemoryStream.Create;
359
360    streampos := Target.Position;
361
362    FQuery.SQL.Text := 'SELECT data FROM datfiles WHERE id=' + IntToStr(fileid) + ';';
363    FQuery.Open;
364    if FQuery.RecordCount > 0 then
365    begin
366      mem := FQuery.CreateBlobStream(FQuery.FieldByName('data'), bmRead);
367      mem.Seek(0, soFromBeginning);
368      Target.CopyFrom(mem, mem.Size);
369      mem.Free;
370    end;
371    FQuery.Close;
372
373    Target.Seek(streampos, soFromBeginning);
374  end;
375end;
376
377procedure TAccess_OUP_ADB.UpdateDatFile(FileID: Integer; Src: TStream);
378var
379  MimeCoder: TStringFormat_MIME64;
380  mem: TMemoryStream;
381begin
382  if fileid < GetFileCount then
383  begin
384    mimecoder := TStringFormat_MIME64.Create;
385    mem := TMemoryStream.Create;
386    mem.CopyFrom(Src, Src.Size); 
387    FQuery.SQL.Text := 'UPDATE datfiles SET data=MimeToBin("' +
388      MimeCoder.StrTo(mem.Memory, mem.Size) + '"), size=' + IntToStr(mem.Size) +
389      ' WHERE id=' + IntToStr(fileid) + ';';
390    FQuery.ExecSQL;
391    mem.Free;
392    mimecoder.Free;
393  end;
394end;
395
396
397
398procedure TAccess_OUP_ADB.LoadDatFilePart(FileID, Offset, Size: Integer; var Target: TStream);
399var
400  streampos: Integer;
401  mem: TStream;
402begin
403  if fileid < GetFileCount then
404  begin
405    if not Assigned(Target) then
406      Target := TMemoryStream.Create;
407    streampos := Target.Position;
408
409    FQuery.SQL.Text := 'SELECT data FROM datfiles WHERE id=' + IntToStr(fileid) + ';';
410    FQuery.Open;
411    if FQuery.RecordCount > 0 then
412    begin
413      mem := FQuery.CreateBlobStream(FQuery.FieldByName('data'), bmRead);
414      mem.Seek(offset, soFromBeginning);
415      Target.CopyFrom(mem, size);
416      mem.Free;
417    end;
418    FQuery.Close;
419    Target.Seek(streampos, soFromBeginning);
420  end;
421end;
422
423
424
425procedure TAccess_OUP_ADB.UpdateDatFilePart(FileID, Offset, Size: Integer; Src: TStream);
426var
427  MimeCoder: TStringFormat_MIME64;
428  mem:  TMemoryStream;
429begin
430  if fileid < GetFileCount then
431  begin
432    mem := nil;
433    LoadDatFile(fileid, TStream(mem));
434    mem.Seek(Offset, soFromBeginning);
435    mem.CopyFrom(Src, Size);
436    mem.Seek(0, soFromBeginning);
437    mimecoder := TStringFormat_MIME64.Create;
438    FQuery.SQL.Text := 'UPDATE datfiles SET data=MimeToBin("' +
439      MimeCoder.StrTo(mem.Memory, mem.Size) + '") WHERE id=' + IntToStr(fileid) + ';';
440    FQuery.ExecSQL;
441    mem.Free;
442    mimecoder.Free;
443  end;
444end;
445
446
447function TAccess_OUP_ADB.GetRawList(FileID: Integer): TRawDataList;
448var
449  i: Integer;
450begin
451  SetLength(Result, 0);
452  FQuery.SQL.Text := 'SELECT [src_link_offset],[size],[sep] FROM rawmap WHERE [src_id]=' +
453    IntToStr(fileid) + ' ORDER BY src_link_offset ASC;';
454  FQuery.Open;
455  if FQuery.RecordCount > 0 then
456  begin
457    FQuery.First;
458    SetLength(Result, FQuery.RecordCount);
459    i := 0;
460    repeat
461      Result[i].SrcID     := fileid;
462      Result[i].SrcOffset := FQuery.FieldByName('src_link_offset').AsInteger;
463      Result[i].RawAddr   := 0;
464      Result[i].RawSize   := FQuery.FieldByName('size').AsInteger;
465      Result[i].LocSep    := FQuery.FieldByName('sep').AsBoolean;
466      Inc(i);
467      FQuery.Next;
468    until FQuery.EOF;
469  end;
470  FQuery.Close;
471end;
472
473
474function TAccess_OUP_ADB.GetRawInfo(FileID, DatOffset: Integer): TRawDataInfo;
475var
476  i: Integer;
477  rawlist: TRawDataList;
478begin
479  rawlist := GetRawList(FileID);
480  if Length(rawlist) > 0 then
481  begin
482    for i := 0 to High(rawlist) do
483      if rawlist[i].SrcOffset = DatOffset then
484        Break;
485    if i < Length(rawlist) then
486      Result := rawlist[i]
487    else begin
488      Result.SrcID     := -1;
489      Result.SrcOffset := -1;
490      Result.RawAddr   := -1;
491      Result.RawSize   := -1;
492    end;
493  end;
494end;
495
496
497
498procedure TAccess_OUP_ADB.LoadRawFile(FileID, DatOffset: Integer; var Target: TStream);
499var
500  mem: TStream;
501  streampos: Integer;
502begin
503  if fileid < GetFileCount then
504  begin
505    if not Assigned(Target) then
506      Target := TMemoryStream.Create;
507    streampos := Target.Position;
508    FQuery.SQL.Text := 'SELECT data FROM rawmap WHERE (src_id=' +
509      IntToStr(FileID) + ') AND (src_link_offset=' + IntToStr(DatOffset) + ');';
510    FQuery.Open;
511    if FQuery.RecordCount > 0 then
512    begin
513      mem := FQuery.CreateBlobStream(FQuery.FieldByName('data'), bmRead);
514      mem.Seek(0, soFromBeginning);
515      Target.CopyFrom(mem, mem.Size);
516      mem.Free;
517    end;
518    FQuery.Close;
519    Target.Seek(streampos, soFromBeginning);
520  end;
521end;
522
523
524procedure TAccess_OUP_ADB.UpdateRawFile(FileID, DatOffset: Integer; Src: TStream);
525var
526  MimeCoder: TStringFormat_MIME64;
527  mem: TMemoryStream;
528begin
529  if fileid < GetFileCount then
530  begin
531    mimecoder := TStringFormat_MIME64.Create;
532    mem := TMemoryStream.Create;
533    mem.CopyFrom(Src, Src.Size);
534    mem.Seek(0, soFromBeginning);
535    FQuery.SQL.Text := 'UPDATE rawmap SET data=MimeToBin("' + MimeCoder.StrTo(
536      mem.Memory, mem.Size) + '") WHERE (src_id=' + IntToStr(FileID) +
537      ') AND (src_link_offset=' + IntToStr(DatOffset) + ');';
538    FQuery.ExecSQL;
539    mem.Free;
540    mimecoder.Free;
541  end;
542end;
543
544
545
546
547procedure TAccess_OUP_ADB.LoadRawFilePart(FileID, DatOffset, Offset, Size: Integer; var Target: TStream);
548var
549  mem:  TMemoryStream;
550  streampos: Integer;
551begin
552  if fileid < GetFileCount then
553  begin
554    if not Assigned(Target) then
555      Target := TMemoryStream.Create;
556    streampos := Target.Position;
557    mem := nil;
558    LoadRawFile(FileID, DatOffset, TStream(mem));
559    mem.Seek(Offset, soFromBeginning);
560    Target.CopyFrom(mem, Size);
561    mem.Free;
562    Target.Seek(streampos, soFromBeginning);
563  end;
564end;
565
566
567
568
569procedure TAccess_OUP_ADB.UpdateRawFilePart(FileID, DatOffset, Offset, Size: Integer; Src: TStream);
570var
571  MimeCoder: TStringFormat_MIME64;
572  mem:  TMemoryStream;
573begin
574  if fileid < GetFileCount then
575  begin
576    mem := nil;
577    LoadRawFile(fileid, offset, TStream(mem));
578    mem.Seek(offset, soFromBeginning);
579    mem.CopyFrom(Src, Size);
580    mem.Seek(0, soFromBeginning);
581    mimecoder := TStringFormat_MIME64.Create;
582    FQuery.SQL.Text := 'UPDATE rawmap SET data=MimeToBin("' + MimeCoder.StrTo(
583      mem.Memory, mem.Size) + '") WHERE (src_id=' + IntToStr(fileid) +
584      ') AND (src_link_offset=' + IntToStr(DatOffset) + ');';
585    FQuery.ExecSQL;
586    mem.Free;
587    mimecoder.Free;
588  end;
589end;
590
591
592
593
594end.
Note: See TracBrowser for help on using the repository browser.