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

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