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

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