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

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