source: oup/rewrite/DataAccess/Access_OUP_ADB.pas@ 101

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