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

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