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

Last change on this file since 112 was 112, checked in by alloc, 18 years ago
File size: 16.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 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 GetRawList(FileID: Integer): TRawDataList; override;
35 function GetRawInfo(FileID, DatOffset: Integer): TRawDataInfo; override;
36
37 procedure LoadRawFile(FileID, DatOffset: Integer; var Target: TStream); overload; override;
38 procedure UpdateRawFile(FileID, DatOffset: Integer; Src: TStream); overload; override;
39 procedure LoadRawFilePart(FileID, DatOffset, Offset, Size: Integer; var Target: TStream); overload; override;
40 procedure UpdateRawFilePart(FileID, DatOffset, Offset, Size: Integer; Src: TStream); overload; override;
41 published
42 end;
43
44
45implementation
46
47uses
48 SysUtils, Data, Functions, ABSDecUtil, DB;
49
50
51(*
52================================================================================
53 Implementation of TOniDataADB
54*)
55
56
57constructor TAccess_OUP_ADB.Create(DBFilename: String; ConnectionID: Integer; var Msg: TStatusMessages);
58var
59 i: Integer;
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 := HexToLong(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 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 Result := TStringList.Create;
331 for i := 0 to Length(Fdat_extensionsmap) - 1 do
332 begin
333 with Fdat_extensionsmap[i] do
334 begin
335 case ExtListFormat of
336 EF_ExtOnly:
337 Result.Add(Extension[3] + Extension[2] + Extension[1] + Extension[0]);
338 EF_ExtCount:
339 Result.Add(Extension[3] + Extension[2] + Extension[1] + Extension[0] +
340 ' (' + IntToStr(ExtCount) + ')');
341 end;
342 end;
343 end;
344end;
345
346
347procedure TAccess_OUP_ADB.LoadDatFile(FileID: Integer; var Target: TStream);
348var
349 mem: TStream;
350 streampos: Integer;
351begin
352 if fileid < GetFileCount then
353 begin
354 if not Assigned(Target) then
355 Target := TMemoryStream.Create;
356
357 streampos := Target.Position;
358
359 FQuery.SQL.Text := 'SELECT data FROM datfiles WHERE id=' + IntToStr(fileid) + ';';
360 FQuery.Open;
361 if FQuery.RecordCount > 0 then
362 begin
363 mem := FQuery.CreateBlobStream(FQuery.FieldByName('data'), bmRead);
364 mem.Seek(0, soFromBeginning);
365 Target.CopyFrom(mem, mem.Size);
366 mem.Free;
367 end;
368 FQuery.Close;
369
370 Target.Seek(streampos, soFromBeginning);
371 end;
372end;
373
374procedure TAccess_OUP_ADB.UpdateDatFile(FileID: Integer; Src: TStream);
375var
376 MimeCoder: TStringFormat_MIME64;
377 mem: TMemoryStream;
378begin
379 if fileid < GetFileCount then
380 begin
381 mimecoder := TStringFormat_MIME64.Create;
382 mem := TMemoryStream.Create;
383 mem.CopyFrom(Src, Src.Size);
384 FQuery.SQL.Text := 'UPDATE datfiles SET data=MimeToBin("' +
385 MimeCoder.StrTo(mem.Memory, mem.Size) + '"), size=' + IntToStr(mem.Size) +
386 ' WHERE id=' + IntToStr(fileid) + ';';
387 FQuery.ExecSQL;
388 mem.Free;
389 mimecoder.Free;
390 end;
391end;
392
393
394
395procedure TAccess_OUP_ADB.LoadDatFilePart(FileID, Offset, Size: Integer; var Target: TStream);
396var
397 streampos: Integer;
398 mem: TStream;
399begin
400 if fileid < GetFileCount then
401 begin
402 if not Assigned(Target) then
403 Target := TMemoryStream.Create;
404 streampos := Target.Position;
405
406 FQuery.SQL.Text := 'SELECT data FROM datfiles WHERE id=' + IntToStr(fileid) + ';';
407 FQuery.Open;
408 if FQuery.RecordCount > 0 then
409 begin
410 mem := FQuery.CreateBlobStream(FQuery.FieldByName('data'), bmRead);
411 mem.Seek(offset, soFromBeginning);
412 Target.CopyFrom(mem, size);
413 mem.Free;
414 end;
415 FQuery.Close;
416 Target.Seek(streampos, soFromBeginning);
417 end;
418end;
419
420
421
422procedure TAccess_OUP_ADB.UpdateDatFilePart(FileID, Offset, Size: Integer; Src: TStream);
423var
424 MimeCoder: TStringFormat_MIME64;
425 mem: TMemoryStream;
426begin
427 if fileid < GetFileCount then
428 begin
429 mem := nil;
430 LoadDatFile(fileid, TStream(mem));
431 mem.Seek(Offset, soFromBeginning);
432 mem.CopyFrom(Src, Size);
433 mem.Seek(0, soFromBeginning);
434 mimecoder := TStringFormat_MIME64.Create;
435 FQuery.SQL.Text := 'UPDATE datfiles SET data=MimeToBin("' +
436 MimeCoder.StrTo(mem.Memory, mem.Size) + '") WHERE id=' + IntToStr(fileid) + ';';
437 FQuery.ExecSQL;
438 mem.Free;
439 mimecoder.Free;
440 end;
441end;
442
443
444function TAccess_OUP_ADB.GetRawList(FileID: Integer): TRawDataList;
445var
446 i: Integer;
447begin
448 SetLength(Result, 0);
449 FQuery.SQL.Text := 'SELECT [src_link_offset],[size],[sep] FROM rawmap WHERE [src_id]=' +
450 IntToStr(fileid) + ' ORDER BY src_link_offset ASC;';
451 FQuery.Open;
452 if FQuery.RecordCount > 0 then
453 begin
454 FQuery.First;
455 SetLength(Result, FQuery.RecordCount);
456 i := 0;
457 repeat
458 Result[i].SrcID := fileid;
459 Result[i].SrcOffset := FQuery.FieldByName('src_link_offset').AsInteger;
460 Result[i].RawAddr := 0;
461 Result[i].RawSize := FQuery.FieldByName('size').AsInteger;
462 Result[i].LocSep := FQuery.FieldByName('sep').AsBoolean;
463 Inc(i);
464 FQuery.Next;
465 until FQuery.EOF;
466 end;
467 FQuery.Close;
468end;
469
470
471function TAccess_OUP_ADB.GetRawInfo(FileID, DatOffset: Integer): TRawDataInfo;
472var
473 i: Integer;
474 rawlist: TRawDataList;
475begin
476 rawlist := GetRawList(FileID);
477 if Length(rawlist) > 0 then
478 begin
479 for i := 0 to High(rawlist) do
480 if rawlist[i].SrcOffset = DatOffset then
481 Break;
482 if i < Length(rawlist) then
483 Result := rawlist[i]
484 else begin
485 Result.SrcID := -1;
486 Result.SrcOffset := -1;
487 Result.RawAddr := -1;
488 Result.RawSize := -1;
489 end;
490 end;
491end;
492
493
494
495procedure TAccess_OUP_ADB.LoadRawFile(FileID, DatOffset: Integer; var Target: TStream);
496var
497 mem: TStream;
498 streampos: Integer;
499begin
500 if fileid < GetFileCount then
501 begin
502 if not Assigned(Target) then
503 Target := TMemoryStream.Create;
504 streampos := Target.Position;
505 FQuery.SQL.Text := 'SELECT data FROM rawmap WHERE (src_id=' +
506 IntToStr(FileID) + ') AND (src_link_offset=' + IntToStr(DatOffset) + ');';
507 FQuery.Open;
508 if FQuery.RecordCount > 0 then
509 begin
510 mem := FQuery.CreateBlobStream(FQuery.FieldByName('data'), bmRead);
511 mem.Seek(0, soFromBeginning);
512 Target.CopyFrom(mem, mem.Size);
513 mem.Free;
514 end;
515 FQuery.Close;
516 Target.Seek(streampos, soFromBeginning);
517 end;
518end;
519
520
521procedure TAccess_OUP_ADB.UpdateRawFile(FileID, DatOffset: Integer; Src: TStream);
522var
523 MimeCoder: TStringFormat_MIME64;
524 mem: TMemoryStream;
525begin
526 if fileid < GetFileCount then
527 begin
528 mimecoder := TStringFormat_MIME64.Create;
529 mem := TMemoryStream.Create;
530 mem.CopyFrom(Src, Src.Size);
531 mem.Seek(0, soFromBeginning);
532 FQuery.SQL.Text := 'UPDATE rawmap SET data=MimeToBin("' + MimeCoder.StrTo(
533 mem.Memory, mem.Size) + '") WHERE (src_id=' + IntToStr(FileID) +
534 ') AND (src_link_offset=' + IntToStr(DatOffset) + ');';
535 FQuery.ExecSQL;
536 mem.Free;
537 mimecoder.Free;
538 end;
539end;
540
541
542
543
544procedure TAccess_OUP_ADB.LoadRawFilePart(FileID, DatOffset, Offset, Size: Integer; var Target: TStream);
545var
546 mem: TMemoryStream;
547 streampos: Integer;
548begin
549 if fileid < GetFileCount then
550 begin
551 if not Assigned(Target) then
552 Target := TMemoryStream.Create;
553 streampos := Target.Position;
554 mem := nil;
555 LoadRawFile(FileID, DatOffset, TStream(mem));
556 mem.Seek(Offset, soFromBeginning);
557 Target.CopyFrom(mem, Size);
558 mem.Free;
559 Target.Seek(streampos, soFromBeginning);
560 end;
561end;
562
563
564
565
566procedure TAccess_OUP_ADB.UpdateRawFilePart(FileID, DatOffset, Offset, Size: Integer; Src: TStream);
567var
568 MimeCoder: TStringFormat_MIME64;
569 mem: TMemoryStream;
570begin
571 if fileid < GetFileCount then
572 begin
573 mem := nil;
574 LoadRawFile(fileid, offset, TStream(mem));
575 mem.Seek(offset, soFromBeginning);
576 mem.CopyFrom(Src, Size);
577 mem.Seek(0, soFromBeginning);
578 mimecoder := TStringFormat_MIME64.Create;
579 FQuery.SQL.Text := 'UPDATE rawmap SET data=MimeToBin("' + MimeCoder.StrTo(
580 mem.Memory, mem.Size) + '") WHERE (src_id=' + IntToStr(fileid) +
581 ') AND (src_link_offset=' + IntToStr(DatOffset) + ');';
582 FQuery.ExecSQL;
583 mem.Free;
584 mimecoder.Free;
585 end;
586end;
587
588
589
590
591end.
Note: See TracBrowser for help on using the repository browser.