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

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