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

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