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

Last change on this file since 94 was 93, checked in by alloc, 18 years ago
File size: 17.2 KB
RevLine 
[93]1unit Access_OUP_ADB;
2interface
3
4uses DataAccess;
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(OLDBFilename: String; var Result: Boolean); override;
16 procedure Close; override;
17
18 procedure UpdateListCache;
19 // function GetDatLinks(srcid:LongWord):TDatLinks;
20 function GetFileInfo(fileid: Integer): TFileInfo; override;
21 function GetFilesList(ext: String; pattern: String;
22 NoEmptyFiles: Boolean; sort: TSortType): TStringArray; override;
23 function GetFilesCount: LongWord; override;
24 function GetExtensionsList: TStringArray; override;
25 function GetExtendedExtensionsList: TExtensionsMap; override;
26 function GetNamedFilesMap: TNamedFilesMap;
27
28 function LoadDatFile(fileid: LongWord): Tdata; override;
29 procedure UpdateDatFile(fileid: LongWord; Data: Tdata); override;
30 procedure LoadDatFilePart(fileid, offset, size: LongWord; target: Pointer); override;
31 procedure UpdateDatFilePart(fileid, offset, size: LongWord; target: Pointer); override;
32
33 function GetRawList(fileid: LongWord): TRawList; override;
34 procedure LoadRawFile(fileid, dat_offset: LongWord; target: Pointer); override;
35 procedure UpdateRawFile(fileid, dat_offset: LongWord; size: LongWord;
36 target: Pointer); override;
37 procedure LoadRawFilePart(fileid, dat_offset: LongWord;
38 offset, size: LongWord; target: Pointer); override;
39 procedure UpdateRawFilePart(fileid, dat_offset: LongWord;
40 offset, size: LongWord; target: Pointer); override;
41 published
42} end;
43
44
45implementation
46
47
48(*
49================================================================================
50 Implementation of TOniDataADB
51*)
52
53{
54constructor TOniDataADB.Create(OLDBFilename: String; var Result: Boolean);
55var
56 i, j: Byte;
57 temps: String;
58begin
59 if not FileExists(OLDBFilename) then
60 begin
61 ShowMessage('File doesn''t exist!!!');
62 Result := False;
63 Exit;
64 end;
65 FFileName := OLDBFilename;
66 FDatabase := TABSDatabase.Create(nil);
67 FDatabase.DatabaseName := 'OLDBcon';
68 FDatabase.DatabaseFileName := OLDBFilename;
69 FDatabase.Open;
70 FQuery := TABSQuery.Create(FDatabase);
71 FQuery.DatabaseName := 'OLDBcon';
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 ShowMessage('Database-file ' + #13 + #10 +
81 '"' + OLDBFilename + '"' + #13 + #10 +
82 'has wrong version. (Required: ' + DBversion + '; found: ' +
83 FQuery.FieldByName('value').AsString + ')');
84 FQuery.Close;
85 Result := False;
86 Exit;
87 end;
88 end;
89 if FQuery.FieldByName('name').AsString = 'lvl' then
90 begin
91 FLevelInfo.LevelNumber := StrToInt(FQuery.FieldByName('value').AsString);
92 end;
93 if FQuery.FieldByName('name').AsString = 'ident' then
94 begin
95 temps := FQuery.FieldByName('value').AsString;
96 for i := 0 to High(FLevelInfo.Ident) do
97 begin
98 j := i * 2 + 1;
99 case temps[j] of
100 '0'..'9':
101 FLevelInfo.Ident[i] := Ord(temps[j]) - 48;
102 'A'..'F':
103 FLevelInfo.Ident[i] := Ord(temps[j]) - 55;
104 end;
105 FLevelInfo.Ident[i] := FLevelInfo.Ident[i] * 16;
106 case temps[j + 1] of
107 '0'..'9':
108 FLevelInfo.Ident[i] := FLevelInfo.Ident[i] + Ord(temps[j + 1]) - 48;
109 'A'..'F':
110 FLevelInfo.Ident[i] := FLevelInfo.Ident[i] + Ord(temps[j + 1]) - 55;
111 end;
112 end;
113 end;
114 if FQuery.FieldByName('name').AsString = 'ident' then
115 begin
116 temps := FQuery.FieldByName('value').AsString;
117 Fos_mac := temps = 'MAC';
118 end;
119 FQuery.Next;
120 until FQuery.EOF;
121 FQuery.Close;
122
123 UpdateListCache;
124
125 Result := True;
126 FBackend := ODB_ADB;
127end;
128
129
130
131
132procedure TOniDataADB.Close;
133begin
134 FDatabase.Close;
135 FDatabase.Free;
136 Self.Free;
137end;
138
139
140
141procedure TOniDataADB.UpdateListCache;
142var
143 i: LongWord;
144 temps: String;
145begin
146 FQuery.SQL.Text := 'SELECT id,name,extension,[size],contenttype FROM datfiles ORDER BY id ASC;';
147 FQuery.Open;
148 if FQuery.RecordCount > 0 then
149 begin
150 FQuery.First;
151 SetLength(Fdat_files, FQuery.RecordCount);
152 i := 0;
153 repeat
154 Fdat_files[i].ID := FQuery.FieldByName('id').AsInteger;
155 Fdat_files[i].Name := FQuery.FieldByName('name').AsString;
156 Fdat_files[i].Extension := FQuery.FieldByName('extension').AsString;
157 Fdat_files[i].FileName := FormatNumber(Fdat_files[i].ID, 5, '0') + '-' +
158 Fdat_files[i].Name + '.' + Fdat_files[0].Extension;
159 Fdat_files[i].FileNameHex := IntToHex(Fdat_files[i].ID, 4) + '-' +
160 Fdat_files[i].Name + '.' + Fdat_files[0].Extension;
161 Fdat_files[i].Size := FQuery.FieldByName('size').AsInteger;
162 Fdat_files[i].FileType := HexToLong(FQuery.FieldByName('contenttype').AsString);
163 Fdat_files[i].DatAddr := 0;
164 Fdat_files[i].opened := False;
165 Inc(i);
166 FQuery.Next;
167 until FQuery.EOF;
168 end;
169 FQuery.Close;
170
171 SetLength(Fdat_extensionsmap, 0);
172 FQuery.SQL.Text :=
173 'SELECT extension,count(extension) AS x FROM datfiles GROUP BY extension ORDER BY extension ASC;';
174 FQuery.Open;
175 if FQuery.RecordCount > 0 then
176 begin
177 SetLength(Fdat_extensionsmap, FQuery.RecordCount);
178 i := 0;
179 repeat
180 temps := FQuery.FieldByName('extension').AsString[1];
181 Fdat_extensionsmap[i].Extension[3] := temps[1];
182 Fdat_extensionsmap[i].Extension[2] := temps[2];
183 Fdat_extensionsmap[i].Extension[1] := temps[3];
184 Fdat_extensionsmap[i].Extension[0] := temps[4];
185 Fdat_extensionsmap[i].ExtCount := FQuery.FieldByName('x').AsInteger;
186 Inc(i);
187 FQuery.Next;
188 until FQuery.EOF;
189 end;
190 FQuery.Close;
191end;
192
193
194function TOniDataADB.GetFileInfo(fileid: Integer): TFileInfo;
195var
196 i: Integer;
197begin
198 if fileid = -1 then
199 begin
200 Result := inherited GetFileInfo(fileid);
201 Exit;
202 end;
203 if fileid < Self.GetFilesCount then
204 begin
205 for i := 0 to High(Fdat_files) do
206 if Fdat_files[i].ID = fileid then
207 Break;
208 if i < Length(Fdat_files) then
209 Result := Fdat_files[i]
210 else
211 Result.ID := -1;
212 end
213 else
214 begin
215 Result.ID := -1;
216 end;
217end;
218
219
220
221
222function TOniDataADB.GetFilesList(ext: String; pattern: String;
223 NoEmptyFiles: Boolean; sort: TSortType): TStringArray;
224var
225 i: LongWord;
226 list: TStringList;
227 id, name, extension: String;
228 fields: TStrings;
229
230 procedure getfields;
231 begin
232 fields.CommaText := StringReplace(AnsiQuotedStr(list.Strings[i], '"'), ';', '","', [rfReplaceAll]);
233 if sort in [stIDAsc, stIDDesc] then
234 begin
235 id := fields.Strings[0];
236 name := fields.Strings[1];
237 extension := fields.Strings[2];
238 end;
239 if sort in [stNameAsc, stNameDesc] then
240 begin
241 id := fields.Strings[1];
242 name := fields.Strings[0];
243 extension := fields.Strings[2];
244 end;
245 if sort in [stExtAsc, stExtDesc] then
246 begin
247 id := fields.Strings[1];
248 name := fields.Strings[2];
249 extension := fields.Strings[0];
250 end;
251 end;
252
253begin
254 list := TStringList.Create;
255 list.Sorted := True;
256 for i := 0 to High(Fdat_files) do
257 begin
258 if ((Length(ext) = 0) or (Pos(Fdat_files[i].Extension, ext) > 0)) and
259 ((Length(pattern) = 0) or
260 (Pos(UpperCase(pattern), UpperCase(Fdat_files[i].Name)) > 0)) then
261 begin
262 if (NoEmptyFiles = False) or ((Fdat_files[i].FileType and $02) = 0) then
263 begin
264 if AppSettings.FilenumbersAsHex then
265 id := IntToHex(Fdat_files[i].ID, 4)
266 else
267 id := FormatNumber(Fdat_files[i].ID, 5, '0');
268 name := Fdat_files[i].Name;
269 extension := Fdat_files[i].Extension;
270
271 case sort of
272 stIDAsc, stIDDesc: list.Add(id + ';' + name + ';' + extension);
273 stNameAsc, stNameDesc: list.Add(name + ';' + id + ';' + extension);
274 stExtAsc, stExtDesc: list.Add(extension + ';' + id + ';' + name);
275 end;
276 end;
277 end;
278 end;
279 SetLength(Result, list.Count);
280 fields := TStringList.Create;
281 if sort in [stIDAsc, stNameAsc, stExtAsc] then
282 for i := 0 to list.Count - 1 do
283 begin
284 getfields;
285 Result[i] := id + '-' + name + '.' + extension;
286 end
287 else
288 for i := list.Count - 1 downto 0 do
289 begin
290 getfields;
291 Result[list.Count - i - 1] := id + '-' + name + '.' + extension;
292 end;
293 list.Free;
294 fields.Free;
295end;
296
297
298
299
300function TOniDataADB.GetFilesCount: LongWord;
301begin
302 Result := Length(Fdat_files);
303end;
304
305
306
307
308function TOniDataADB.GetExtensionsList: TStringArray;
309var
310 i: LongWord;
311begin
312 SetLength(Result, Length(Fdat_extensionsmap));
313 for i := 0 to High(Result) do
314 begin
315 with Fdat_extensionsmap[i] do
316 begin
317 Result[i] := Extension[3] + Extension[2] + Extension[1] + Extension[0] +
318 ' (' + IntToStr(ExtCount) + ')';
319 end;
320 end;
321end;
322
323
324
325
326function TOniDataADB.GetExtendedExtensionsList: TExtensionsMap;
327var
328 i, j: LongWord;
329 temps: String;
330 Data: Tdata;
331begin
332 SetLength(Result, 0);
333 FQuery.SQL.Text := 'SELECT ext,ident FROM extlist ORDER BY ext ASC;';
334 FQuery.Open;
335 if FQuery.RecordCount > 0 then
336 begin
337 SetLength(Result, FQuery.RecordCount);
338 i := 0;
339 repeat
340 temps := FQuery.FieldByName('ext').AsString;
341 for j := 0 to 3 do
342 Result[i].Extension[j] := temps[4 - j];
343 Data := DecodeHexString(FQuery.FieldByName('ident').AsString);
344 for j := 0 to 7 do
345 Result[i].Ident[j] := Data[j];
346 Inc(i);
347 FQuery.Next;
348 until FQuery.EOF;
349 end;
350 FQuery.Close;
351end;
352
353
354
355
356function TOniDataADB.GetNamedFilesMap: TNamedFilesMap;
357var
358 i: LongWord;
359 temp: Integer;
360 temps: String;
361 temparray: array of record
362 id: Integer;
363 fullname: String[50];
364 end;
365begin
366 SetLength(temparray, 0);
367 FQuery.SQL.Text :=
368 'SELECT id,(extension+name) AS xname FROM datfiles WHERE Length(name)>0 ORDER BY extension,name ASC;';
369 FQuery.Open;
370 if FQuery.RecordCount > 0 then
371 begin
372 repeat
373 temp := FQuery.FieldByName('id').AsInteger;
374 temps := FQuery.FieldByName('xname').AsString;
375
376 SetLength(temparray, Length(temparray) + 1);
377 if Length(temparray) > 1 then
378 begin
379 for i := High(temparray) - 1 downto 0 do
380 begin
381 if StringSmaller(temps, temparray[i].fullname) then
382 begin
383 temparray[i + 1] := temparray[i];
384 if i = 0 then
385 begin
386 temparray[i].id := temp;
387 temparray[i].fullname := temps;
388 end;
389 end
390 else
391 begin
392 temparray[i + 1].id := temp;
393 temparray[i + 1].fullname := temps;
394 Break;
395 end;
396 end;
397 end
398 else
399 begin
400 temparray[0].id := temp;
401 temparray[0].fullname := temps;
402 end;
403 FQuery.Next;
404 until FQuery.EOF;
405 end;
406 FQuery.Close;
407 SetLength(Result, Length(temparray));
408 for i := 0 to High(temparray) do
409 begin
410 Result[i].FileNumber := temparray[i].id;
411 Result[i].blubb := 0;
412 end;
413end;
414
415
416
417
418function TOniDataADB.LoadDatFile(fileid: LongWord): Tdata;
419var
420 mem: TStream;
421begin
422 if fileid < Self.GetFilesCount then
423 begin
424 FQuery.SQL.Text := 'SELECT data FROM datfiles WHERE id=' + IntToStr(fileid) + ';';
425 FQuery.Open;
426 if FQuery.RecordCount > 0 then
427 begin
428 mem := FQuery.CreateBlobStream(FQuery.FieldByName('data'), bmRead);
429 SetLength(Result, mem.Size);
430 mem.Seek(0, soFromBeginning);
431 mem.Read(Result[0], mem.Size);
432 mem.Free;
433 end;
434 FQuery.Close;
435 end;
436end;
437
438
439
440
441procedure TOniDataADB.UpdateDatFile(fileid: LongWord; Data: Tdata);
442var
443 MimeCoder: TStringFormat_MIME64;
444 mem: TMemoryStream;
445begin
446 if fileid < Self.GetFilesCount then
447 begin
448 mimecoder := TStringFormat_MIME64.Create;
449 mem := TMemoryStream.Create;
450 mem.Write(Data[0], Length(Data));
451 mem.Seek(0, soFromBeginning);
452 FQuery.SQL.Text := 'UPDATE datfiles SET data=MimeToBin("' +
453 MimeCoder.StrTo(mem.Memory, mem.Size) + '"), size=' + IntToStr(mem.Size) +
454 ' WHERE id=' + IntToStr(fileid) + ';';
455 FQuery.ExecSQL;
456 mem.Free;
457 mimecoder.Free;
458 end;
459 UpdateListCache;
460end;
461
462
463
464
465procedure TOniDataADB.LoadDatFilePart(fileid, offset, size: LongWord; target: Pointer);
466var
467 mem: TStream;
468begin
469 if fileid < Self.GetFilesCount then
470 begin
471 FQuery.SQL.Text := 'SELECT data FROM datfiles WHERE id=' + IntToStr(fileid) + ';';
472 FQuery.Open;
473 if FQuery.RecordCount > 0 then
474 begin
475 mem := FQuery.CreateBlobStream(FQuery.FieldByName('data'), bmRead);
476 mem.Seek(offset, soFromBeginning);
477 mem.Read(target^, size);
478 mem.Free;
479 end;
480 FQuery.Close;
481 end;
482end;
483
484
485
486
487procedure TOniDataADB.UpdateDatFilePart(fileid, offset, size: LongWord; target: Pointer);
488var
489 MimeCoder: TStringFormat_MIME64;
490 mem: TMemoryStream;
491 Data: Tdata;
492begin
493 if fileid < Self.GetFilesCount then
494 begin
495 Data := Self.LoadDatFile(fileid);
496 mimecoder := TStringFormat_MIME64.Create;
497 mem := TMemoryStream.Create;
498 mem.Write(Data[0], Length(Data));
499 mem.Seek(offset, soFromBeginning);
500 mem.Write(target^, size);
501 mem.Seek(0, soFromBeginning);
502 FQuery.SQL.Text := 'UPDATE datfiles SET data=MimeToBin("' +
503 MimeCoder.StrTo(mem.Memory, mem.Size) + '") WHERE id=' + IntToStr(fileid) + ';';
504 FQuery.ExecSQL;
505 mem.Free;
506 mimecoder.Free;
507 end;
508end;
509
510
511
512
513function TOniDataADB.GetRawList(fileid: LongWord): TRawList;
514var
515 i: LongWord;
516begin
517 SetLength(Result, 0);
518 FQuery.SQL.Text := 'SELECT [src_link_offset],[size],[sep] FROM rawmap WHERE [src_id]=' +
519 IntToStr(fileid) + ' ORDER BY src_link_offset ASC;';
520 FQuery.Open;
521 if FQuery.RecordCount > 0 then
522 begin
523 FQuery.First;
524 SetLength(Result, FQuery.RecordCount);
525 i := 0;
526 repeat
527 Result[i].src_id := fileid;
528 Result[i].src_offset := FQuery.FieldByName('src_link_offset').AsInteger;
529 Result[i].raw_addr := 0;
530 Result[i].raw_size := FQuery.FieldByName('size').AsInteger;
531 Result[i].loc_sep := FQuery.FieldByName('sep').AsBoolean;
532 Inc(i);
533 FQuery.Next;
534 until FQuery.EOF;
535 end;
536 FQuery.Close;
537end;
538
539
540
541
542procedure TOniDataADB.LoadRawFile(fileid, dat_offset: LongWord; target: Pointer);
543var
544 mem: TStream;
545begin
546 if fileid < Self.GetFilesCount then
547 begin
548 FQuery.SQL.Text := 'SELECT data FROM rawmap WHERE (src_id=' +
549 IntToStr(fileid) + ') AND (src_link_offset=' + IntToStr(dat_offset) + ');';
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 mem.Read(target^, mem.size);
556 mem.Free;
557 end;
558 FQuery.Close;
559 end;
560end;
561
562
563
564
565procedure TOniDataADB.UpdateRawFile(fileid, dat_offset: LongWord;
566 size: LongWord; target: Pointer);
567var
568 MimeCoder: TStringFormat_MIME64;
569 mem: TMemoryStream;
570begin
571 if fileid < Self.GetFilesCount then
572 begin
573 mimecoder := TStringFormat_MIME64.Create;
574 mem := TMemoryStream.Create;
575 mem.Write(target^, size);
576 mem.Seek(0, soFromBeginning);
577 FQuery.SQL.Text := 'UPDATE rawmap SET data=MimeToBin("' + MimeCoder.StrTo(
578 mem.Memory, mem.Size) + '") WHERE (src_id=' + IntToStr(fileid) +
579 ') AND (src_link_offset=' + IntToStr(dat_offset) + ');';
580 FQuery.ExecSQL;
581 mem.Free;
582 mimecoder.Free;
583 end;
584end;
585
586
587
588
589procedure TOniDataADB.LoadRawFilePart(fileid, dat_offset: LongWord;
590 offset, size: LongWord; target: Pointer);
591var
592 Data: Tdata;
593 mem: TMemoryStream;
594begin
595 if fileid < Self.GetFilesCount then
596 begin
597 SetLength(Data, Self.GetRawInfo(fileid, dat_offset).raw_size);
598 Self.LoadRawFile(fileid, dat_offset, @Data[0]);
599 mem := TMemoryStream.Create;
600 mem.Write(Data[offset], size);
601 mem.Read(target^, size);
602 mem.Free;
603 end;
604end;
605
606
607
608
609procedure TOniDataADB.UpdateRawFilePart(fileid, dat_offset: LongWord;
610 offset, size: LongWord; target: Pointer);
611var
612 MimeCoder: TStringFormat_MIME64;
613 mem: TMemoryStream;
614 Data: Tdata;
615begin
616 if fileid < Self.GetFilesCount then
617 begin
618 SetLength(Data, Self.GetRawInfo(fileid, offset).raw_size);
619 Self.LoadRawFile(fileid, offset, @Data[0]);
620 mimecoder := TStringFormat_MIME64.Create;
621 mem := TMemoryStream.Create;
622 mem.Write(Data[0], Length(Data));
623 mem.Seek(offset, soFromBeginning);
624 mem.Write(target^, size);
625 mem.Seek(0, soFromBeginning);
626 FQuery.SQL.Text := 'UPDATE rawmap SET data=MimeToBin("' + MimeCoder.StrTo(
627 mem.Memory, mem.Size) + '") WHERE (src_id=' + IntToStr(fileid) +
628 ') AND (src_link_offset=' + IntToStr(dat_offset) + ');';
629 FQuery.ExecSQL;
630 mem.Free;
631 mimecoder.Free;
632 end;
633end;
634
635}
636
637
638end.
Note: See TracBrowser for help on using the repository browser.