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

Last change on this file since 109 was 106, checked in by alloc, 19 years ago
File size: 16.4 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 function GetLinksFromFile(FileID: Integer): TLinks;
22
23 function GetFileInfo(FileID: Integer): TFileInfo; override;
24 function GetFilesList(Ext: String; Pattern: String;
25 NoEmptyFiles: Boolean; SortType: TSortType): TStrings; override;
26 function GetFileCount: Integer; override;
27 function GetExtensionsList(ExtListFormat: TExtensionFormat): TStrings; override;
28
29 procedure LoadDatFile(FileID: Integer; var Target: TStream); overload; override;
30 procedure UpdateDatFile(FileID: Integer; Src: TStream); overload; override;
31 procedure LoadDatFilePart(FileID, Offset, Size: Integer; var Target: TStream); overload; override;
32 procedure UpdateDatFilePart(FileID, Offset, Size: Integer; Src: TStream); overload; override;
33
34 function GetRawList(FileID: Integer): TRawDataList; override;
35 function GetRawInfo(FileID, DatOffset: Integer): TRawDataInfo; override;
36
37 procedure LoadRawFile(FileID, DatOffset: Integer; var Target: TStream); overload; override;
38 procedure UpdateRawFile(FileID, DatOffset: Integer; Src: TStream); overload; override;
39 procedure LoadRawFilePart(FileID, DatOffset, Offset, Size: Integer; var Target: TStream); overload; override;
40 procedure UpdateRawFilePart(FileID, DatOffset, Offset, Size: Integer; Src: TStream); overload; override;
41 published
42 end;
43
44
45implementation
46
47uses
48 SysUtils, Data, Functions, ABSDecUtil, DB;
49
50
51(*
52================================================================================
53 Implementation of TOniDataADB
54*)
55
56
57constructor TAccess_OUP_ADB.Create(DBFilename: String; ConnectionID: Integer; var Msg: TStatusMessages);
58var
59 i: Integer;
60begin
61 Msg := SM_UnknownError;
62 if not FileExists(DBFilename) then
63 begin
64 Msg := SM_FileNotFound;
65 Exit;
66 end;
67 FFileName := DBFilename;
68
69 FDatabase := TABSDatabase.Create(nil);
70 FDatabase.DatabaseName := 'OLDBcon' + IntToStr(ConnectionID);
71 FDatabase.DatabaseFileName := DBFilename;
72 FDatabase.Open;
73 FQuery := TABSQuery.Create(FDatabase);
74 FQuery.DatabaseName := 'OLDBcon' + IntToStr(ConnectionID);
75 FQuery.SQL.Text := 'SELECT [name],[value] FROM globals ORDER BY [name] ASC';
76 FQuery.Open;
77 FQuery.First;
78 repeat
79 if FQuery.FieldByName('name').AsString = 'dbversion' then
80 begin
81 if FQuery.FieldByName('value').AsString <> DBversion then
82 begin
83 Msg := SM_IncompatibleDBVersion;
84 FQuery.Close;
85 Exit;
86 end;
87 end;
88 if FQuery.FieldByName('name').AsString = 'lvl' then
89 FLevelNumber := StrToInt(FQuery.FieldByName('value').AsString);
90 if FQuery.FieldByName('name').AsString = 'DataOS' then
91 begin
92 if FQuery.FieldByName('value').AsString = 'WIN' then
93 FDataOS := DOS_WIN
94 else if FQuery.FieldByName('value').AsString = 'WINDEMO' then
95 FDataOS := DOS_WINDEMO
96 else if FQuery.FieldByName('value').AsString = 'MAC' then
97 FDataOS := DOS_MAC
98 else if FQuery.FieldByName('value').AsString = 'MACBETA' then
99 FDataOS := DOS_MACBETA;
100 end;
101 FQuery.Next;
102 until FQuery.EOF;
103 FQuery.Close;
104
105 Msg := SM_OK;
106 FBackend := DB_ADB;
107
108 FConnectionID := ConnectionID;
109 FChangeRights := [CR_EditDat, CR_EditRaw, CR_ResizeDat, CR_ResizeRaw];
110
111 UpdateListCache;
112end;
113
114
115
116
117procedure TAccess_OUP_ADB.Close;
118begin
119 FQuery.Free;
120 FDatabase.Close;
121 FDatabase.Free;
122 Self.Free;
123end;
124
125
126
127procedure TAccess_OUP_ADB.UpdateListCache;
128var
129 i: Integer;
130 temps: String;
131begin
132 FQuery.SQL.Text := 'SELECT id,name,extension,[size],contenttype FROM datfiles ORDER BY id ASC;';
133 FQuery.Open;
134 SetLength(Fdat_files, FQuery.RecordCount);
135 if FQuery.RecordCount > 0 then
136 begin
137 FQuery.First;
138 i := 0;
139 repeat
140 Fdat_files[i].ID := FQuery.FieldByName('id').AsInteger;
141 Fdat_files[i].Name := FQuery.FieldByName('name').AsString;
142 Fdat_files[i].Extension := FQuery.FieldByName('extension').AsString;
143 Fdat_files[i].Size := FQuery.FieldByName('size').AsInteger;
144 Fdat_files[i].FileType := HexToLong(FQuery.FieldByName('contenttype').AsString);
145 Fdat_files[i].DatAddr := 0;
146 Inc(i);
147 FQuery.Next;
148 until FQuery.EOF;
149 end;
150 FQuery.Close;
151
152 FQuery.SQL.Text :=
153 'SELECT extension,count(extension) AS x FROM datfiles GROUP BY extension ORDER BY extension ASC;';
154 FQuery.Open;
155 SetLength(Fdat_extensionsmap, FQuery.RecordCount);
156 if FQuery.RecordCount > 0 then
157 begin
158 i := 0;
159 repeat
160 temps := FQuery.FieldByName('extension').AsString;
161 Fdat_extensionsmap[i].Extension[3] := temps[1];
162 Fdat_extensionsmap[i].Extension[2] := temps[2];
163 Fdat_extensionsmap[i].Extension[1] := temps[3];
164 Fdat_extensionsmap[i].Extension[0] := temps[4];
165 Fdat_extensionsmap[i].ExtCount := FQuery.FieldByName('x').AsInteger;
166 Inc(i);
167 FQuery.Next;
168 until FQuery.EOF;
169 end;
170 FQuery.Close;
171end;
172
173
174
175function TAccess_OUP_ADB.GetLinksToFile(FileID: Integer): TLinks;
176var
177 i: Integer;
178begin
179 SetLength(Result.ByName, 0);
180 FQuery.SQL.Text := 'SELECT src_link_offset, src_id FROM linkmap WHERE target_id = ' + IntToStr(FileID) + ' ORDER BY src_id ASC;';
181 FQuery.Open;
182 SetLength(Result.ByID, FQuery.RecordCount);
183 if FQuery.RecordCount > 0 then
184 begin
185 i := 0;
186 repeat
187 Result.ByID[i].SrcOffset := FQuery.FieldByName('src_link_offset').AsInteger;
188 Result.ByID[i].Destination := FQuery.FieldByName('src_id').AsInteger;
189 Inc(i);
190 FQuery.Next;
191 until FQuery.EOF;
192 end;
193 FQuery.Close;
194end;
195
196function TAccess_OUP_ADB.GetLinksFromFile(FileID: Integer): TLinks;
197var
198 i: Integer;
199begin
200 SetLength(Result.ByName, 0);
201 FQuery.SQL.Text := 'SELECT src_link_offset, target_id FROM linkmap WHERE src_id = ' + IntToStr(FileID) + ' ORDER BY target_id ASC;';
202 FQuery.Open;
203 SetLength(Result.ByID, FQuery.RecordCount);
204 if FQuery.RecordCount > 0 then
205 begin
206 i := 0;
207 repeat
208 Result.ByID[i].SrcOffset := FQuery.FieldByName('src_link_offset').AsInteger;
209 Result.ByID[i].Destination := FQuery.FieldByName('target_id').AsInteger;
210 Inc(i);
211 FQuery.Next;
212 until FQuery.EOF;
213 end;
214 FQuery.Close;
215end;
216
217
218
219function TAccess_OUP_ADB.GetFileInfo(fileid: Integer): TFileInfo;
220begin
221 if fileid = -1 then
222 begin
223 Result := inherited GetFileInfo(fileid);
224 Exit;
225 end;
226 if fileid < Self.GetFileCount then
227 Result := Fdat_files[fileid]
228 else
229 Result.ID := -1;
230end;
231
232
233
234
235function TAccess_OUP_ADB.GetFilesList(ext: String; pattern: String;
236 NoEmptyFiles: Boolean; SortType: TSortType): TStrings;
237var
238 i: Integer;
239 list: TStringList;
240 id, name, extension: String;
241 fields: TStrings;
242
243 procedure getfields;
244 begin
245 fields.CommaText := StringReplace(AnsiQuotedStr(list.Strings[i], '"'), ';', '","', [rfReplaceAll]);
246 if SortType in [ST_IDAsc, ST_IDDesc] then
247 begin
248 id := fields.Strings[0];
249 name := fields.Strings[1];
250 extension := fields.Strings[2];
251 end;
252 if SortType in [ST_NameAsc, ST_NameDesc] then
253 begin
254 id := fields.Strings[1];
255 name := fields.Strings[0];
256 extension := fields.Strings[2];
257 end;
258 if SortType in [ST_ExtAsc, ST_ExtDesc] then
259 begin
260 id := fields.Strings[1];
261 name := fields.Strings[2];
262 extension := fields.Strings[0];
263 end;
264 end;
265
266begin
267 list := TStringList.Create;
268 list.Sorted := True;
269 for i := 0 to GetFileCount - 1 do
270 begin
271 if ((Length(ext) = 0) or (Pos(Fdat_files[i].Extension, ext) > 0)) and
272 ((Length(pattern) = 0) or
273 (Pos(UpperCase(pattern), UpperCase(Fdat_files[i].Name)) > 0)) then
274 begin
275 if (NoEmptyFiles = False) or ((Fdat_files[i].FileType and $02) = 0) then
276 begin
277 if AppSettings.FilenumbersAsHex then
278 id := IntToHex(Fdat_files[i].ID, 4)
279 else
280 id := FormatNumber(Fdat_files[i].ID, 5, '0');
281 name := Fdat_files[i].Name;
282 extension := Fdat_files[i].Extension;
283
284 case SortType of
285 ST_IDAsc, ST_IDDesc: list.Add(id + ';' + name + ';' + extension);
286 ST_NameAsc, ST_NameDesc: list.Add(name + ';' + id + ';' + extension);
287 ST_ExtAsc, ST_ExtDesc: list.Add(extension + ';' + id + ';' + name);
288 end;
289 end;
290 end;
291 end;
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] 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 Result := TStringList.Create;
327 for i := 0 to Length(Fdat_extensionsmap) - 1 do
328 begin
329 with Fdat_extensionsmap[i] do
330 begin
331 case ExtListFormat of
332 EF_ExtOnly:
333 Result.Add(Extension[3] + Extension[2] + Extension[1] + Extension[0]);
334 EF_ExtCount:
335 Result.Add(Extension[3] + Extension[2] + Extension[1] + Extension[0] +
336 ' (' + IntToStr(ExtCount) + ')');
337 end;
338 end;
339 end;
340end;
341
342
343procedure TAccess_OUP_ADB.LoadDatFile(FileID: Integer; var Target: TStream);
344var
345 mem: TStream;
346 streampos: Integer;
347begin
348 if fileid < GetFileCount then
349 begin
350 if not Assigned(Target) then
351 Target := TMemoryStream.Create;
352
353 streampos := Target.Position;
354
355 FQuery.SQL.Text := 'SELECT data FROM datfiles WHERE id=' + IntToStr(fileid) + ';';
356 FQuery.Open;
357 if FQuery.RecordCount > 0 then
358 begin
359 mem := FQuery.CreateBlobStream(FQuery.FieldByName('data'), bmRead);
360 mem.Seek(0, soFromBeginning);
361 Target.CopyFrom(mem, mem.Size);
362 mem.Free;
363 end;
364 FQuery.Close;
365
366 Target.Seek(streampos, soFromBeginning);
367 end;
368end;
369
370procedure TAccess_OUP_ADB.UpdateDatFile(FileID: Integer; Src: TStream);
371var
372 MimeCoder: TStringFormat_MIME64;
373 mem: TMemoryStream;
374begin
375 if fileid < GetFileCount then
376 begin
377 mimecoder := TStringFormat_MIME64.Create;
378 mem := TMemoryStream.Create;
379 mem.CopyFrom(Src, Src.Size);
380 FQuery.SQL.Text := 'UPDATE datfiles SET data=MimeToBin("' +
381 MimeCoder.StrTo(mem.Memory, mem.Size) + '"), size=' + IntToStr(mem.Size) +
382 ' WHERE id=' + IntToStr(fileid) + ';';
383 FQuery.ExecSQL;
384 mem.Free;
385 mimecoder.Free;
386 end;
387end;
388
389
390
391procedure TAccess_OUP_ADB.LoadDatFilePart(FileID, Offset, Size: Integer; var Target: TStream);
392var
393 streampos: Integer;
394 mem: TStream;
395begin
396 if fileid < GetFileCount then
397 begin
398 if not Assigned(Target) then
399 Target := TMemoryStream.Create;
400 streampos := Target.Position;
401
402 FQuery.SQL.Text := 'SELECT data FROM datfiles WHERE id=' + IntToStr(fileid) + ';';
403 FQuery.Open;
404 if FQuery.RecordCount > 0 then
405 begin
406 mem := FQuery.CreateBlobStream(FQuery.FieldByName('data'), bmRead);
407 mem.Seek(offset, soFromBeginning);
408 Target.CopyFrom(mem, size);
409 mem.Free;
410 end;
411 FQuery.Close;
412 Target.Seek(streampos, soFromBeginning);
413 end;
414end;
415
416
417
418procedure TAccess_OUP_ADB.UpdateDatFilePart(FileID, Offset, Size: Integer; Src: TStream);
419var
420 MimeCoder: TStringFormat_MIME64;
421 mem: TMemoryStream;
422begin
423 if fileid < GetFileCount then
424 begin
425 mem := nil;
426 LoadDatFile(fileid, TStream(mem));
427 mem.Seek(Offset, soFromBeginning);
428 mem.CopyFrom(Src, Size);
429 mem.Seek(0, soFromBeginning);
430 mimecoder := TStringFormat_MIME64.Create;
431 FQuery.SQL.Text := 'UPDATE datfiles SET data=MimeToBin("' +
432 MimeCoder.StrTo(mem.Memory, mem.Size) + '") WHERE id=' + IntToStr(fileid) + ';';
433 FQuery.ExecSQL;
434 mem.Free;
435 mimecoder.Free;
436 end;
437end;
438
439
440function TAccess_OUP_ADB.GetRawList(FileID: Integer): TRawDataList;
441var
442 i: Integer;
443begin
444 SetLength(Result, 0);
445 FQuery.SQL.Text := 'SELECT [src_link_offset],[size],[sep] FROM rawmap WHERE [src_id]=' +
446 IntToStr(fileid) + ' ORDER BY src_link_offset ASC;';
447 FQuery.Open;
448 if FQuery.RecordCount > 0 then
449 begin
450 FQuery.First;
451 SetLength(Result, FQuery.RecordCount);
452 i := 0;
453 repeat
454 Result[i].SrcID := fileid;
455 Result[i].SrcOffset := FQuery.FieldByName('src_link_offset').AsInteger;
456 Result[i].RawAddr := 0;
457 Result[i].RawSize := FQuery.FieldByName('size').AsInteger;
458 Result[i].LocSep := FQuery.FieldByName('sep').AsBoolean;
459 Inc(i);
460 FQuery.Next;
461 until FQuery.EOF;
462 end;
463 FQuery.Close;
464end;
465
466
467function TAccess_OUP_ADB.GetRawInfo(FileID, DatOffset: Integer): TRawDataInfo;
468var
469 i: Integer;
470 rawlist: TRawDataList;
471begin
472 rawlist := GetRawList(FileID);
473 if Length(rawlist) > 0 then
474 begin
475 for i := 0 to High(rawlist) do
476 if rawlist[i].SrcOffset = DatOffset then
477 Break;
478 if i < Length(rawlist) then
479 Result := rawlist[i]
480 else begin
481 Result.SrcID := -1;
482 Result.SrcOffset := -1;
483 Result.RawAddr := -1;
484 Result.RawSize := -1;
485 end;
486 end;
487end;
488
489
490
491procedure TAccess_OUP_ADB.LoadRawFile(FileID, DatOffset: Integer; var Target: TStream);
492var
493 mem: TStream;
494 streampos: Integer;
495begin
496 if fileid < GetFileCount then
497 begin
498 if not Assigned(Target) then
499 Target := TMemoryStream.Create;
500 streampos := Target.Position;
501 FQuery.SQL.Text := 'SELECT data FROM rawmap WHERE (src_id=' +
502 IntToStr(FileID) + ') AND (src_link_offset=' + IntToStr(DatOffset) + ');';
503 FQuery.Open;
504 if FQuery.RecordCount > 0 then
505 begin
506 mem := FQuery.CreateBlobStream(FQuery.FieldByName('data'), bmRead);
507 mem.Seek(0, soFromBeginning);
508 Target.CopyFrom(mem, mem.Size);
509 mem.Free;
510 end;
511 FQuery.Close;
512 Target.Seek(streampos, soFromBeginning);
513 end;
514end;
515
516
517procedure TAccess_OUP_ADB.UpdateRawFile(FileID, DatOffset: Integer; Src: TStream);
518var
519 MimeCoder: TStringFormat_MIME64;
520 mem: TMemoryStream;
521begin
522 if fileid < GetFileCount then
523 begin
524 mimecoder := TStringFormat_MIME64.Create;
525 mem := TMemoryStream.Create;
526 mem.CopyFrom(Src, Src.Size);
527 mem.Seek(0, soFromBeginning);
528 FQuery.SQL.Text := 'UPDATE rawmap SET data=MimeToBin("' + MimeCoder.StrTo(
529 mem.Memory, mem.Size) + '") WHERE (src_id=' + IntToStr(FileID) +
530 ') AND (src_link_offset=' + IntToStr(DatOffset) + ');';
531 FQuery.ExecSQL;
532 mem.Free;
533 mimecoder.Free;
534 end;
535end;
536
537
538
539
540procedure TAccess_OUP_ADB.LoadRawFilePart(FileID, DatOffset, Offset, Size: Integer; var Target: TStream);
541var
542 mem: TMemoryStream;
543 streampos: Integer;
544begin
545 if fileid < GetFileCount then
546 begin
547 if not Assigned(Target) then
548 Target := TMemoryStream.Create;
549 streampos := Target.Position;
550 mem := nil;
551 LoadRawFile(FileID, DatOffset, TStream(mem));
552 mem.Seek(Offset, soFromBeginning);
553 Target.CopyFrom(mem, Size);
554 mem.Free;
555 Target.Seek(streampos, soFromBeginning);
556 end;
557end;
558
559
560
561
562procedure TAccess_OUP_ADB.UpdateRawFilePart(FileID, DatOffset, Offset, Size: Integer; Src: TStream);
563var
564 MimeCoder: TStringFormat_MIME64;
565 mem: TMemoryStream;
566begin
567 if fileid < GetFileCount then
568 begin
569 mem := nil;
570 LoadRawFile(fileid, offset, TStream(mem));
571 mem.Seek(offset, soFromBeginning);
572 mem.CopyFrom(Src, Size);
573 mem.Seek(0, soFromBeginning);
574 mimecoder := TStringFormat_MIME64.Create;
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
587end.
Note: See TracBrowser for help on using the repository browser.