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

Last change on this file since 159 was 159, checked in by alloc, 14 years ago
File size: 18.1 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    s1, s2: String;
219  begin
220    s1 := MidStr(List[I1], 1, PosEx(';', List[I1], 6) - 1);
221    s2 := MidStr(List[I2], 1, PosEx(';', List[I2], 6) - 1);
222    Result := CompareStr(s1, s2);
223  end;
224
225function TAccess_OUP_ADB.GetFilesList(ext: String; pattern: String;
226  NoEmptyFiles: Boolean; SortType: TSortType): TStrings;
227var
228  i:      Integer;
229  list:   TStringList;
230  id, name, extension: String;
231  fields: TStrings;
232
233  procedure getfields;
234  begin
235    fields.CommaText := StringReplace(AnsiQuotedStr(list.Strings[i], '"'), ';', '","', [rfReplaceAll]);
236    if SortType in [ST_IDAsc, ST_IDDesc] then
237    begin
238      id := fields.Strings[0];
239      name := fields.Strings[1];
240      extension := fields.Strings[2];
241    end;
242    if SortType in [ST_NameAsc, ST_NameDesc] then
243    begin
244      id := fields.Strings[1];
245      name := fields.Strings[0];
246      extension := fields.Strings[2];
247    end;
248    if SortType in [ST_ExtAsc, ST_ExtDesc] then
249    begin
250      id := fields.Strings[1];
251      name := fields.Strings[2];
252      extension := fields.Strings[0];
253    end;
254    if SortType in [ST_ExtNameAsc, ST_ExtNameDesc] then
255    begin
256      id := fields.Strings[2];
257      name := fields.Strings[1];
258      extension := fields.Strings[0];
259    end;
260  end;
261
262begin
263  list := TStringList.Create;
264  if SortType in [ST_ExtNameAsc, ST_ExtNameDesc] then
265    list.Sorted := False
266  else
267    list.Sorted := True;
268  for i := 0 to GetFileCount - 1 do
269  begin
270    if ((Length(ext) = 0) or (Pos(Fdat_files[i].Extension, ext) > 0)) and
271      ((Length(pattern) = 0) or
272      (Pos(UpperCase(pattern), UpperCase(Fdat_files[i].Name)) > 0)) then
273    begin
274      if (NoEmptyFiles = False) or ((Fdat_files[i].FileType and $02) = 0) then
275      begin
276        id := FormatNumber(Fdat_files[i].ID, 5, '0');
277        name := Fdat_files[i].Name;
278        extension := Fdat_files[i].Extension;
279
280        case SortType of
281          ST_IDAsc, ST_IDDesc:     list.Add(id + ';' + name + ';' + extension);
282          ST_NameAsc, ST_NameDesc: list.Add(name + ';' + id + ';' + extension);
283          ST_ExtAsc, ST_ExtDesc:   list.Add(extension + ';' + id + ';' + name);
284          ST_ExtNameAsc, ST_ExtNameDesc: list.Add(extension + ';' + name + ';' + id);
285        end;
286      end;
287    end;
288  end;
289  if SortType in [ST_ExtNameAsc, ST_ExtNameDesc] then
290    list.CustomSort(CompareItems);
291  if not Assigned(Result) then
292    Result := TStringList.Create;
293  if list.Count > 0 then
294  begin
295    fields := TStringList.Create;
296    if SortType in [ST_IDAsc, ST_NameAsc, ST_ExtAsc, ST_ExtNameAsc] then
297      for i := 0 to list.Count - 1 do
298      begin
299        getfields;
300        Result.Add(id + '-' + name + '.' + extension);
301      end
302    else
303      for i := list.Count - 1 downto 0 do
304      begin
305        getfields;
306        Result.Add(id + '-' + name + '.' + extension);
307      end;
308    fields.Free;
309  end;
310  list.Free;
311end;
312
313
314
315
316function TAccess_OUP_ADB.GetFileCount: Integer;
317begin
318  Result := Length(Fdat_files);
319end;
320
321
322function TAccess_OUP_ADB.GetExtensionsList(ExtListFormat: TExtensionFormat): TStrings;
323var
324  i: Integer;
325begin
326  if not Assigned(Result) then
327    Result := TStringList.Create;
328  if Result is TStringList then
329    TStringList(Result).Sorted := True;
330  for i := 0 to Length(Fdat_extensionsmap) - 1 do
331  begin
332    with Fdat_extensionsmap[i] do
333    begin
334      case ExtListFormat of
335        EF_ExtOnly:
336          Result.Add(Extension[3] + Extension[2] + Extension[1] + Extension[0]);
337        EF_ExtCount:
338          Result.Add(Extension[3] + Extension[2] + Extension[1] + Extension[0] +
339                ' (' + IntToStr(ExtCount) + ')');
340      end;
341    end;
342  end;
343end;
344
345
346procedure TAccess_OUP_ADB.LoadDatFile(FileID: Integer; var Target: TStream);
347var
348  mem: TStream;
349  streampos: Integer;
350begin
351  if fileid < GetFileCount then
352  begin
353    if not Assigned(Target) then
354      Target := TMemoryStream.Create;
355
356    streampos := Target.Position;
357
358    FQuery.SQL.Text := 'SELECT data FROM datfiles WHERE id=' + IntToStr(fileid) + ';';
359    FQuery.Open;
360    if FQuery.RecordCount > 0 then
361    begin
362      mem := FQuery.CreateBlobStream(FQuery.FieldByName('data'), bmRead);
363      mem.Seek(0, soFromBeginning);
364      Target.CopyFrom(mem, mem.Size);
365      mem.Free;
366    end;
367    FQuery.Close;
368
369    Target.Seek(streampos, soFromBeginning);
370  end;
371end;
372
373procedure TAccess_OUP_ADB.UpdateDatFile(FileID: Integer; Src: TStream);
374var
375  MimeCoder: TStringFormat_MIME64;
376  mem: TMemoryStream;
377begin
378  if fileid < GetFileCount then
379  begin
380    mimecoder := TStringFormat_MIME64.Create;
381    mem := TMemoryStream.Create;
382    mem.CopyFrom(Src, Src.Size); 
383    FQuery.SQL.Text := 'UPDATE datfiles SET data=MimeToBin("' +
384      MimeCoder.StrTo(mem.Memory, mem.Size) + '"), size=' + IntToStr(mem.Size) +
385      ' WHERE id=' + IntToStr(fileid) + ';';
386    FQuery.ExecSQL;
387    mem.Free;
388    mimecoder.Free;
389  end;
390end;
391
392
393
394procedure TAccess_OUP_ADB.LoadDatFilePart(FileID, Offset, Size: Integer; var Target: TStream);
395var
396  streampos: Integer;
397  mem: TStream;
398begin
399  if fileid < GetFileCount then
400  begin
401    if not Assigned(Target) then
402      Target := TMemoryStream.Create;
403    streampos := Target.Position;
404
405    FQuery.SQL.Text := 'SELECT data FROM datfiles WHERE id=' + IntToStr(fileid) + ';';
406    FQuery.Open;
407    if FQuery.RecordCount > 0 then
408    begin
409      mem := FQuery.CreateBlobStream(FQuery.FieldByName('data'), bmRead);
410      mem.Seek(offset, soFromBeginning);
411      Target.CopyFrom(mem, size);
412      mem.Free;
413    end;
414    FQuery.Close;
415    Target.Seek(streampos, soFromBeginning);
416  end;
417end;
418
419
420
421procedure TAccess_OUP_ADB.UpdateDatFilePart(FileID, Offset, Size: Integer; Src: TStream);
422var
423  MimeCoder: TStringFormat_MIME64;
424  mem:  TMemoryStream;
425begin
426  if fileid < GetFileCount then
427  begin
428    mem := nil;
429    LoadDatFile(fileid, TStream(mem));
430    mem.Seek(Offset, soFromBeginning);
431    mem.CopyFrom(Src, Size);
432    mem.Seek(0, soFromBeginning);
433    mimecoder := TStringFormat_MIME64.Create;
434    FQuery.SQL.Text := 'UPDATE datfiles SET data=MimeToBin("' +
435      MimeCoder.StrTo(mem.Memory, mem.Size) + '") WHERE id=' + IntToStr(fileid) + ';';
436    FQuery.ExecSQL;
437    mem.Free;
438    mimecoder.Free;
439  end;
440end;
441
442
443
444function TAccess_OUP_ADB.GetDatLink(FileID, DatOffset: Integer): TDatLink;
445begin
446  Result := DatLinksManager.GetDatLink(FConnectionID, FileID, DatOffset);
447  FQuery.SQL.Text := 'SELECT target_id FROM linkmap WHERE src_id = ' + IntToStr(FileID) + ' and src_link_offset = ' + IntToStr(DatOffset) + ';';
448  FQuery.Open;
449  if FQuery.RecordCount > 0 then
450    Result.DestID := FQuery.FieldByName('target_id').AsInteger;
451  FQuery.Close;
452end;
453
454
455function TAccess_OUP_ADB.GetDatLinks(FileID: Integer): TDatLinkList;
456var
457  i: Integer;
458  SrcOffset, DestID: Integer;
459begin
460  Result := DatLinksManager.GetDatLinks(FConnectionID, FileID);
461  if Length(Result) > 0 then
462  begin
463    FQuery.SQL.Text := 'SELECT src_link_offset, target_id FROM linkmap WHERE src_id = ' + IntToStr(FileID) + ' ORDER BY src_link_offset ASC;';
464    FQuery.Open;
465    if FQuery.RecordCount > 0 then
466    begin
467      repeat
468        SrcOffset := FQuery.FieldByName('src_link_offset').AsInteger;
469        DestID := FQuery.FieldByName('target_id').AsInteger;
470        for i := 0 to High(Result) do
471          if Result[i].SrcOffset = SrcOffset then
472            Break;
473        if i < Length(Result) then
474          Result[i].DestID := DestID
475        else
476          Result[i].DestID := -1;
477        FQuery.Next;
478      until FQuery.EOF;
479    end;
480    FQuery.Close;
481  end;
482end;
483
484
485function TAccess_OUP_ADB.GetRawList(FileID: Integer): TRawDataList;
486var
487  i: Integer;
488begin
489  SetLength(Result, 0);
490  FQuery.SQL.Text := 'SELECT [src_link_offset],[size],[sep] FROM rawmap WHERE [src_id]=' +
491    IntToStr(fileid) + ' ORDER BY src_link_offset ASC;';
492  FQuery.Open;
493  if FQuery.RecordCount > 0 then
494  begin
495    FQuery.First;
496    SetLength(Result, FQuery.RecordCount);
497    i := 0;
498    repeat
499      Result[i].SrcID     := fileid;
500      Result[i].SrcOffset := FQuery.FieldByName('src_link_offset').AsInteger;
501      Result[i].RawAddr   := 0;
502      Result[i].RawSize   := FQuery.FieldByName('size').AsInteger;
503      Result[i].LocSep    := FQuery.FieldByName('sep').AsBoolean;
504      Inc(i);
505      FQuery.Next;
506    until FQuery.EOF;
507  end;
508  FQuery.Close;
509end;
510
511
512function TAccess_OUP_ADB.GetRawInfo(FileID, DatOffset: Integer): TRawDataInfo;
513var
514  i: Integer;
515  rawlist: TRawDataList;
516begin
517  rawlist := GetRawList(FileID);
518  if Length(rawlist) > 0 then
519  begin
520    for i := 0 to High(rawlist) do
521      if rawlist[i].SrcOffset = DatOffset then
522        Break;
523    if i < Length(rawlist) then
524      Result := rawlist[i]
525    else begin
526      Result.SrcID     := -1;
527      Result.SrcOffset := -1;
528      Result.RawAddr   := -1;
529      Result.RawSize   := -1;
530    end;
531  end;
532end;
533
534
535
536procedure TAccess_OUP_ADB.LoadRawFile(FileID, DatOffset: Integer; var Target: TStream);
537var
538  mem: TStream;
539  streampos: Integer;
540begin
541  if fileid < GetFileCount then
542  begin
543    if not Assigned(Target) then
544      Target := TMemoryStream.Create;
545    streampos := Target.Position;
546    FQuery.SQL.Text := 'SELECT data FROM rawmap WHERE (src_id=' +
547      IntToStr(FileID) + ') AND (src_link_offset=' + IntToStr(DatOffset) + ');';
548    FQuery.Open;
549    if FQuery.RecordCount > 0 then
550    begin
551      mem := FQuery.CreateBlobStream(FQuery.FieldByName('data'), bmRead);
552      mem.Seek(0, soFromBeginning);
553      Target.CopyFrom(mem, mem.Size);
554      mem.Free;
555    end;
556    FQuery.Close;
557    Target.Seek(streampos, soFromBeginning);
558  end;
559end;
560
561
562procedure TAccess_OUP_ADB.UpdateRawFile(FileID, DatOffset: Integer; Src: TStream);
563var
564  MimeCoder: TStringFormat_MIME64;
565  mem: TMemoryStream;
566begin
567  if fileid < GetFileCount then
568  begin
569    mimecoder := TStringFormat_MIME64.Create;
570    mem := TMemoryStream.Create;
571    mem.CopyFrom(Src, Src.Size);
572    mem.Seek(0, soFromBeginning);
573    FQuery.SQL.Text := 'UPDATE rawmap SET data=MimeToBin("' + MimeCoder.StrTo(
574      mem.Memory, mem.Size) + '") WHERE (src_id=' + IntToStr(FileID) +
575      ') AND (src_link_offset=' + IntToStr(DatOffset) + ');';
576    FQuery.ExecSQL;
577    mem.Free;
578    mimecoder.Free;
579  end;
580end;
581
582
583
584
585procedure TAccess_OUP_ADB.LoadRawFilePart(FileID, DatOffset, Offset, Size: Integer; var Target: TStream);
586var
587  mem:  TMemoryStream;
588  streampos: Integer;
589begin
590  if fileid < GetFileCount then
591  begin
592    if not Assigned(Target) then
593      Target := TMemoryStream.Create;
594    streampos := Target.Position;
595    mem := nil;
596    LoadRawFile(FileID, DatOffset, TStream(mem));
597    mem.Seek(Offset, soFromBeginning);
598    Target.CopyFrom(mem, Size);
599    mem.Free;
600    Target.Seek(streampos, soFromBeginning);
601  end;
602end;
603
604
605
606
607procedure TAccess_OUP_ADB.UpdateRawFilePart(FileID, DatOffset, Offset, Size: Integer; Src: TStream);
608var
609  MimeCoder: TStringFormat_MIME64;
610  mem:  TMemoryStream;
611begin
612  if fileid < GetFileCount then
613  begin
614    mem := nil;
615    LoadRawFile(fileid, offset, TStream(mem));
616    mem.Seek(offset, soFromBeginning);
617    mem.CopyFrom(Src, Size);
618    mem.Seek(0, soFromBeginning);
619    mimecoder := TStringFormat_MIME64.Create;
620    FQuery.SQL.Text := 'UPDATE rawmap SET data=MimeToBin("' + MimeCoder.StrTo(
621      mem.Memory, mem.Size) + '") WHERE (src_id=' + IntToStr(fileid) +
622      ') AND (src_link_offset=' + IntToStr(DatOffset) + ');';
623    FQuery.ExecSQL;
624    mem.Free;
625    mimecoder.Free;
626  end;
627end;
628
629
630
631
632end.
Note: See TracBrowser for help on using the repository browser.