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

Last change on this file since 155 was 155, checked in by alloc, 14 years ago
File size: 17.7 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.CaseSensitive := True;
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;
299end;
300
301
302
303
304function TAccess_OUP_ADB.GetFileCount: Integer;
305begin
306  Result := Length(Fdat_files);
307end;
308
309
310function TAccess_OUP_ADB.GetExtensionsList(ExtListFormat: TExtensionFormat): TStrings;
311var
312  i: Integer;
313begin
314  if not Assigned(Result) then
315    Result := TStringList.Create;
316  if Result is TStringList then
317    TStringList(Result).Sorted := True;
318  for i := 0 to Length(Fdat_extensionsmap) - 1 do
319  begin
320    with Fdat_extensionsmap[i] do
321    begin
322      case ExtListFormat of
323        EF_ExtOnly:
324          Result.Add(Extension[3] + Extension[2] + Extension[1] + Extension[0]);
325        EF_ExtCount:
326          Result.Add(Extension[3] + Extension[2] + Extension[1] + Extension[0] +
327                ' (' + IntToStr(ExtCount) + ')');
328      end;
329    end;
330  end;
331end;
332
333
334procedure TAccess_OUP_ADB.LoadDatFile(FileID: Integer; var Target: TStream);
335var
336  mem: TStream;
337  streampos: Integer;
338begin
339  if fileid < GetFileCount then
340  begin
341    if not Assigned(Target) then
342      Target := TMemoryStream.Create;
343
344    streampos := Target.Position;
345
346    FQuery.SQL.Text := 'SELECT data FROM datfiles WHERE id=' + IntToStr(fileid) + ';';
347    FQuery.Open;
348    if FQuery.RecordCount > 0 then
349    begin
350      mem := FQuery.CreateBlobStream(FQuery.FieldByName('data'), bmRead);
351      mem.Seek(0, soFromBeginning);
352      Target.CopyFrom(mem, mem.Size);
353      mem.Free;
354    end;
355    FQuery.Close;
356
357    Target.Seek(streampos, soFromBeginning);
358  end;
359end;
360
361procedure TAccess_OUP_ADB.UpdateDatFile(FileID: Integer; Src: TStream);
362var
363  MimeCoder: TStringFormat_MIME64;
364  mem: TMemoryStream;
365begin
366  if fileid < GetFileCount then
367  begin
368    mimecoder := TStringFormat_MIME64.Create;
369    mem := TMemoryStream.Create;
370    mem.CopyFrom(Src, Src.Size); 
371    FQuery.SQL.Text := 'UPDATE datfiles SET data=MimeToBin("' +
372      MimeCoder.StrTo(mem.Memory, mem.Size) + '"), size=' + IntToStr(mem.Size) +
373      ' WHERE id=' + IntToStr(fileid) + ';';
374    FQuery.ExecSQL;
375    mem.Free;
376    mimecoder.Free;
377  end;
378end;
379
380
381
382procedure TAccess_OUP_ADB.LoadDatFilePart(FileID, Offset, Size: Integer; var Target: TStream);
383var
384  streampos: Integer;
385  mem: TStream;
386begin
387  if fileid < GetFileCount then
388  begin
389    if not Assigned(Target) then
390      Target := TMemoryStream.Create;
391    streampos := Target.Position;
392
393    FQuery.SQL.Text := 'SELECT data FROM datfiles WHERE id=' + IntToStr(fileid) + ';';
394    FQuery.Open;
395    if FQuery.RecordCount > 0 then
396    begin
397      mem := FQuery.CreateBlobStream(FQuery.FieldByName('data'), bmRead);
398      mem.Seek(offset, soFromBeginning);
399      Target.CopyFrom(mem, size);
400      mem.Free;
401    end;
402    FQuery.Close;
403    Target.Seek(streampos, soFromBeginning);
404  end;
405end;
406
407
408
409procedure TAccess_OUP_ADB.UpdateDatFilePart(FileID, Offset, Size: Integer; Src: TStream);
410var
411  MimeCoder: TStringFormat_MIME64;
412  mem:  TMemoryStream;
413begin
414  if fileid < GetFileCount then
415  begin
416    mem := nil;
417    LoadDatFile(fileid, TStream(mem));
418    mem.Seek(Offset, soFromBeginning);
419    mem.CopyFrom(Src, Size);
420    mem.Seek(0, soFromBeginning);
421    mimecoder := TStringFormat_MIME64.Create;
422    FQuery.SQL.Text := 'UPDATE datfiles SET data=MimeToBin("' +
423      MimeCoder.StrTo(mem.Memory, mem.Size) + '") WHERE id=' + IntToStr(fileid) + ';';
424    FQuery.ExecSQL;
425    mem.Free;
426    mimecoder.Free;
427  end;
428end;
429
430
431
432function TAccess_OUP_ADB.GetDatLink(FileID, DatOffset: Integer): TDatLink;
433begin
434  Result := DatLinksManager.GetDatLink(FConnectionID, FileID, DatOffset);
435  FQuery.SQL.Text := 'SELECT target_id FROM linkmap WHERE src_id = ' + IntToStr(FileID) + ' and src_link_offset = ' + IntToStr(DatOffset) + ';';
436  FQuery.Open;
437  if FQuery.RecordCount > 0 then
438    Result.DestID := FQuery.FieldByName('target_id').AsInteger;
439  FQuery.Close;
440end;
441
442
443function TAccess_OUP_ADB.GetDatLinks(FileID: Integer): TDatLinkList;
444var
445  i: Integer;
446  SrcOffset, DestID: Integer;
447begin
448  Result := DatLinksManager.GetDatLinks(FConnectionID, FileID);
449  if Length(Result) > 0 then
450  begin
451    FQuery.SQL.Text := 'SELECT src_link_offset, target_id FROM linkmap WHERE src_id = ' + IntToStr(FileID) + ' ORDER BY src_link_offset ASC;';
452    FQuery.Open;
453    if FQuery.RecordCount > 0 then
454    begin
455      repeat
456        SrcOffset := FQuery.FieldByName('src_link_offset').AsInteger;
457        DestID := FQuery.FieldByName('target_id').AsInteger;
458        for i := 0 to High(Result) do
459          if Result[i].SrcOffset = SrcOffset then
460            Break;
461        if i < Length(Result) then
462          Result[i].DestID := DestID
463        else
464          Result[i].DestID := -1;
465        FQuery.Next;
466      until FQuery.EOF;
467    end;
468    FQuery.Close;
469  end;
470end;
471
472
473function TAccess_OUP_ADB.GetRawList(FileID: Integer): TRawDataList;
474var
475  i: Integer;
476begin
477  SetLength(Result, 0);
478  FQuery.SQL.Text := 'SELECT [src_link_offset],[size],[sep] FROM rawmap WHERE [src_id]=' +
479    IntToStr(fileid) + ' ORDER BY src_link_offset ASC;';
480  FQuery.Open;
481  if FQuery.RecordCount > 0 then
482  begin
483    FQuery.First;
484    SetLength(Result, FQuery.RecordCount);
485    i := 0;
486    repeat
487      Result[i].SrcID     := fileid;
488      Result[i].SrcOffset := FQuery.FieldByName('src_link_offset').AsInteger;
489      Result[i].RawAddr   := 0;
490      Result[i].RawSize   := FQuery.FieldByName('size').AsInteger;
491      Result[i].LocSep    := FQuery.FieldByName('sep').AsBoolean;
492      Inc(i);
493      FQuery.Next;
494    until FQuery.EOF;
495  end;
496  FQuery.Close;
497end;
498
499
500function TAccess_OUP_ADB.GetRawInfo(FileID, DatOffset: Integer): TRawDataInfo;
501var
502  i: Integer;
503  rawlist: TRawDataList;
504begin
505  rawlist := GetRawList(FileID);
506  if Length(rawlist) > 0 then
507  begin
508    for i := 0 to High(rawlist) do
509      if rawlist[i].SrcOffset = DatOffset then
510        Break;
511    if i < Length(rawlist) then
512      Result := rawlist[i]
513    else begin
514      Result.SrcID     := -1;
515      Result.SrcOffset := -1;
516      Result.RawAddr   := -1;
517      Result.RawSize   := -1;
518    end;
519  end;
520end;
521
522
523
524procedure TAccess_OUP_ADB.LoadRawFile(FileID, DatOffset: Integer; var Target: TStream);
525var
526  mem: TStream;
527  streampos: Integer;
528begin
529  if fileid < GetFileCount then
530  begin
531    if not Assigned(Target) then
532      Target := TMemoryStream.Create;
533    streampos := Target.Position;
534    FQuery.SQL.Text := 'SELECT data FROM rawmap WHERE (src_id=' +
535      IntToStr(FileID) + ') AND (src_link_offset=' + IntToStr(DatOffset) + ');';
536    FQuery.Open;
537    if FQuery.RecordCount > 0 then
538    begin
539      mem := FQuery.CreateBlobStream(FQuery.FieldByName('data'), bmRead);
540      mem.Seek(0, soFromBeginning);
541      Target.CopyFrom(mem, mem.Size);
542      mem.Free;
543    end;
544    FQuery.Close;
545    Target.Seek(streampos, soFromBeginning);
546  end;
547end;
548
549
550procedure TAccess_OUP_ADB.UpdateRawFile(FileID, DatOffset: Integer; Src: TStream);
551var
552  MimeCoder: TStringFormat_MIME64;
553  mem: TMemoryStream;
554begin
555  if fileid < GetFileCount then
556  begin
557    mimecoder := TStringFormat_MIME64.Create;
558    mem := TMemoryStream.Create;
559    mem.CopyFrom(Src, Src.Size);
560    mem.Seek(0, soFromBeginning);
561    FQuery.SQL.Text := 'UPDATE rawmap SET data=MimeToBin("' + MimeCoder.StrTo(
562      mem.Memory, mem.Size) + '") WHERE (src_id=' + IntToStr(FileID) +
563      ') AND (src_link_offset=' + IntToStr(DatOffset) + ');';
564    FQuery.ExecSQL;
565    mem.Free;
566    mimecoder.Free;
567  end;
568end;
569
570
571
572
573procedure TAccess_OUP_ADB.LoadRawFilePart(FileID, DatOffset, Offset, Size: Integer; var Target: TStream);
574var
575  mem:  TMemoryStream;
576  streampos: Integer;
577begin
578  if fileid < GetFileCount then
579  begin
580    if not Assigned(Target) then
581      Target := TMemoryStream.Create;
582    streampos := Target.Position;
583    mem := nil;
584    LoadRawFile(FileID, DatOffset, TStream(mem));
585    mem.Seek(Offset, soFromBeginning);
586    Target.CopyFrom(mem, Size);
587    mem.Free;
588    Target.Seek(streampos, soFromBeginning);
589  end;
590end;
591
592
593
594
595procedure TAccess_OUP_ADB.UpdateRawFilePart(FileID, DatOffset, Offset, Size: Integer; Src: TStream);
596var
597  MimeCoder: TStringFormat_MIME64;
598  mem:  TMemoryStream;
599begin
600  if fileid < GetFileCount then
601  begin
602    mem := nil;
603    LoadRawFile(fileid, offset, TStream(mem));
604    mem.Seek(offset, soFromBeginning);
605    mem.CopyFrom(Src, Size);
606    mem.Seek(0, soFromBeginning);
607    mimecoder := TStringFormat_MIME64.Create;
608    FQuery.SQL.Text := 'UPDATE rawmap SET data=MimeToBin("' + MimeCoder.StrTo(
609      mem.Memory, mem.Size) + '") WHERE (src_id=' + IntToStr(fileid) +
610      ') AND (src_link_offset=' + IntToStr(DatOffset) + ');';
611    FQuery.ExecSQL;
612    mem.Free;
613    mimecoder.Free;
614  end;
615end;
616
617
618
619
620end.
Note: See TracBrowser for help on using the repository browser.