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

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