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

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