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

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