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

Last change on this file since 157 was 157, checked in by alloc, 18 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.