source: oup/releases/0.34a/DataAccess/Access_OUP_ADB.pas@ 203

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