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

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