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

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