source: oup/current/DataAccess/Access_OniArchive.pas@ 112

Last change on this file since 112 was 112, checked in by alloc, 19 years ago
File size: 18.6 KB
Line 
1unit Access_OniArchive;
2interface
3
4uses DataAccess, Classes, TypeDefs;
5
6type
7 TAccess_OniArchive = class(TDataAccess)
8 private
9 Fdat_file: TFileStream;
10 Fraw_file: TFileStream;
11 Fsep_file: TFileStream;
12 Fdat_files: TFiles;
13 Fdat_extensionsmap: TExtensionsMap;
14 FUnloadWhenUnused: Boolean;
15 FDatOpened: Boolean;
16 FRawOpened: Boolean;
17 FSepOpened: Boolean;
18 protected
19 public
20 property UnloadWhenUnused: Boolean Read FUnloadWhenUnused Write FUnloadWhenUnused;
21
22 constructor Create(DatFilename: String; ConnectionID: Integer; var Msg: TStatusMessages); override;
23 procedure Close; override;
24
25 function GetFileInfo(FileID: Integer): TFileInfo; override;
26 function GetFilesList(Ext: String; Pattern: String;
27 NoEmptyFiles: Boolean; SortType: TSortType): TStrings; override;
28 function GetFileCount: Integer; override;
29 function GetExtensionsList(ExtListFormat: TExtensionFormat): TStrings; override;
30
31 procedure LoadDatFile(FileID: Integer; var Target: TStream); overload; override;
32 procedure UpdateDatFile(FileID: Integer; Src: TStream); overload; override;
33 procedure LoadDatFilePart(FileID, Offset, Size: Integer; var Target: TStream); overload; override;
34 procedure UpdateDatFilePart(FileID, Offset, Size: Integer; Src: TStream); overload; override;
35
36 function GetRawList(FileID: Integer): TRawDataList; override;
37 function GetRawInfo(FileID, DatOffset: Integer): TRawDataInfo; override;
38
39 procedure LoadRawOffset(LocSep: Boolean; RawAddr, Size: Integer; target: Pointer);
40 procedure LoadRawFile(FileID, DatOffset: Integer; var Target: TStream); overload; override;
41 procedure UpdateRawFile(FileID, DatOffset: Integer; Src: TStream); overload; override;
42 procedure LoadRawFilePart(FileID, DatOffset, Offset, Size: Integer; var Target: TStream); overload; override;
43 procedure UpdateRawFilePart(FileID, DatOffset, Offset, Size: Integer; Src: TStream); overload; override;
44
45 function AppendRawFile(LocSep: Boolean; Src: TStream): Integer; overload; override;
46 published
47 end;
48
49implementation
50
51uses
52 SysUtils, StrUtils, Data, Functions, RawList;
53
54
55(*
56================================================================================
57 Implementation of TOniDataDat
58*)
59
60
61constructor TAccess_OniArchive.Create(DatFilename: String; ConnectionID: Integer; var Msg: TStatusMessages);
62const
63 header_ident1_pc: array[0..$13] of Byte =
64 ($1F, $27, $DC, $33, $DF, $BC, $03, $00, $31, $33, $52, $56, $40, $00,
65 $14, $00, $10, $00, $08, $00);
66 header_ident1_mac: array[0..$13] of Byte =
67 ($61, $30, $C1, $23, $DF, $BC, $03, $00, $31, $33, $52, $56, $40, $00,
68 $14, $00, $10, $00, $08, $00);
69 header_ident1_macbeta: array[0..$13] of Byte =
70 ($81, $11, $8D, $23, $DF, $BC, $03, $00, $31, $33, $52, $56, $40, $00,
71 $14, $00, $10, $00, $08, $00);
72 header_ident2: array[0..$F] of Byte =
73 ($99, $CF, $40, $00, $90, $4F, $63, $00, $F4, $55, $5F, $00, $90, $4F, $63, $00);
74var
75 i: Integer;
76 header_pc, header_mac, header_macbeta: Boolean;
77 Fdat_header: THeader;
78 Fdat_filesmap: TFilesMap;
79 Fdat_namedfilesmap: TNamedFilesMap;
80begin
81 FUnloadWhenUnused := True;
82 FDatOpened := False;
83 FRawOpened := False;
84 Msg := SM_UnknownError;
85 if not FileExists(DatFilename) then
86 begin
87 Msg := SM_FileNotFound;
88 Exit;
89 end;
90 FFileName := DatFilename;
91 Fdat_file := TFileStream.Create(FFileName, fmOpenRead);
92 Fdat_file.Read(Fdat_header, SizeOf(Fdat_header));
93 header_pc := True;
94 header_mac := True;
95 header_macbeta := True;
96 for i := 0 to High(Fdat_header.Ident) do
97 begin
98// FLevelInfo.Ident[i] := Fdat_header.Ident[i];
99 if Fdat_header.Ident[i] <> header_ident1_pc[i] then
100 header_pc := False;
101 if Fdat_header.Ident[i] <> header_ident1_mac[i] then
102 header_mac := False;
103 if Fdat_header.Ident[i] <> header_ident1_macbeta[i] then
104 header_macbeta := False;
105 end;
106 if not (header_pc xor header_mac xor header_macbeta) then
107 begin
108 Msg := SM_IncompatibleFile;
109 Exit;
110 end
111 else
112 begin
113 if (header_pc and not header_mac and not header_macbeta) then
114 FDataOS := DOS_WIN
115 else if (not header_pc and header_mac and not header_macbeta) then
116 FDataOS := DOS_MAC
117 else if (not header_pc and not header_mac and header_macbeta) then
118 FDataOS := DOS_MACBETA;
119 end;
120 SetLength(Fdat_filesmap, Fdat_header.Files);
121 SetLength(Fdat_files, Fdat_header.Files);
122 for i := 0 to Fdat_header.Files - 1 do
123 Fdat_file.Read(Fdat_filesmap[i], SizeOf(Fdat_filesmap[i]));
124 for i := 0 to Fdat_header.Files - 1 do
125 begin
126 Fdat_files[i].ID := i;
127 Fdat_files[i].Extension := Fdat_filesmap[i].Extension;
128 Fdat_files[i].Extension := ReverseString(Fdat_files[i].Extension);
129 Fdat_files[i].Size := Fdat_filesmap[i].FileSize;
130 Fdat_files[i].FileType := Fdat_filesmap[i].FileType;
131 Fdat_files[i].DatAddr := Fdat_filesmap[i].DataAddr - 8 + Fdat_header.DataAddr;
132 if (Fdat_filesmap[i].FileType and $01) = 0 then
133 begin
134 Fdat_file.Seek(Fdat_filesmap[i].NameAddr + Fdat_header.NamesAddr, soFromBeginning);
135 SetLength(Fdat_files[i].Name, 100);
136 Fdat_file.Read(Fdat_files[i].Name[1], 100);
137 Fdat_files[i].Name := MidStr(Fdat_files[i].Name, 1 + 4, Pos(
138 #0, Fdat_files[i].Name) - 1 - 4);
139 end
140 else
141 begin
142 Fdat_files[i].Name := '';
143 end;
144 end;
145 Fdat_file.Seek($40 + Fdat_header.Files * $14, soFromBeginning);
146 SetLength(Fdat_namedfilesmap, Fdat_header.NamedFiles);
147 for i := 0 to Fdat_header.NamedFiles - 1 do
148 Fdat_file.Read(Fdat_namedfilesmap[i], SizeOf(Fdat_namedfilesmap[i]));
149
150 Fdat_file.Seek($40 + Fdat_header.Files * $14 + Fdat_header.NamedFiles * $8, soFromBeginning);
151 SetLength(Fdat_extensionsmap, Fdat_header.Extensions);
152 for i := 0 to Fdat_header.Extensions - 1 do
153 Fdat_file.Read(Fdat_extensionsmap[i], SizeOf(Fdat_extensionsmap[i]));
154
155 Fdat_file.Seek(Fdat_files[0].DatAddr + 7, soFromBeginning);
156 Fdat_file.Read(FLevelNumber, 1);
157 FLevelNumber := FLevelNumber div 2;
158
159 Fdat_file.Free;
160
161 Msg := SM_OK;
162 FBackend := DB_ONI;
163 FConnectionID := ConnectionID;
164 FChangeRights := [CR_EditDat, CR_EditRaw, CR_AppendRaw];
165end;
166
167
168
169
170procedure TAccess_OniArchive.Close;
171begin
172 if FDatOpened then
173 Fdat_file.Free;
174 if FRawOpened then
175 Fraw_file.Free;
176 if FSepOpened then
177 Fsep_file.Free;
178 Self.Free;
179end;
180
181
182
183
184function TAccess_OniArchive.GetFileInfo(fileid: Integer): TFileInfo;
185begin
186 if fileid = -1 then
187 begin
188 Result := inherited GetFileInfo(fileid);
189 Exit;
190 end;
191 if fileid < Self.GetFileCount then
192 Result := Fdat_files[fileid]
193 else
194 Result.ID := -1;
195end;
196
197
198
199
200function TAccess_OniArchive.GetFilesList(ext: String; pattern: String;
201 NoEmptyFiles: Boolean; SortType: TSortType): TStrings;
202var
203 i: Integer;
204 list: TStringList;
205 id, name, extension: String;
206 fields: TStrings;
207
208 procedure getfields;
209 begin
210 fields.CommaText := StringReplace(AnsiQuotedStr(list.Strings[i], '"'), ';', '","', [rfReplaceAll]);
211 if SortType in [ST_IDAsc, ST_IDDesc] then
212 begin
213 id := fields.Strings[0];
214 name := fields.Strings[1];
215 extension := fields.Strings[2];
216 end;
217 if SortType in [ST_NameAsc, ST_NameDesc] then
218 begin
219 id := fields.Strings[1];
220 name := fields.Strings[0];
221 extension := fields.Strings[2];
222 end;
223 if SortType in [ST_ExtAsc, ST_ExtDesc] then
224 begin
225 id := fields.Strings[1];
226 name := fields.Strings[2];
227 extension := fields.Strings[0];
228 end;
229 if SortType in [ST_ExtNameAsc, ST_ExtNameDesc] then
230 begin
231 id := fields.Strings[2];
232 name := fields.Strings[1];
233 extension := fields.Strings[0];
234 end;
235 end;
236
237begin
238 list := TStringList.Create;
239 list.Sorted := True;
240 for i := 0 to GetFileCount - 1 do
241 begin
242 if ((Length(ext) = 0) or (Pos(Fdat_files[i].Extension, ext) > 0)) and
243 ((Length(pattern) = 0) or
244 (Pos(UpperCase(pattern), UpperCase(Fdat_files[i].Name)) > 0)) then
245 begin
246 if (NoEmptyFiles = False) or ((Fdat_files[i].FileType and $02) = 0) then
247 begin
248 id := FormatNumber(Fdat_files[i].ID, 5, '0');
249 name := Fdat_files[i].Name;
250 extension := Fdat_files[i].Extension;
251
252 case SortType of
253 ST_IDAsc, ST_IDDesc: list.Add(id + ';' + name + ';' + extension);
254 ST_NameAsc, ST_NameDesc: list.Add(name + ';' + id + ';' + extension);
255 ST_ExtAsc, ST_ExtDesc: list.Add(extension + ';' + id + ';' + name);
256 ST_ExtNameAsc, ST_ExtNameDesc: list.Add(name + ';' + extension + ';' + id);
257 end;
258 end;
259 end;
260 end;
261 Result := TStringList.Create;
262 if list.Count > 0 then
263 begin
264 fields := TStringList.Create;
265 if SortType in [ST_IDAsc, ST_NameAsc, ST_ExtAsc, ST_ExtNameAsc] then
266 for i := 0 to list.Count - 1 do
267 begin
268 getfields;
269 Result.Add(id + '-' + name + '.' + extension);
270 end
271 else
272 for i := list.Count - 1 downto 0 do
273 begin
274 getfields;
275 Result.Add(id + '-' + name + '.' + extension);
276 end;
277 fields.Free;
278 end;
279 list.Free;
280end;
281
282
283
284
285function TAccess_OniArchive.GetFileCount: Integer;
286begin
287 Result := Length(Fdat_files);
288end;
289
290
291
292
293function TAccess_OniArchive.GetExtensionsList(ExtListFormat: TExtensionFormat): TStrings;
294var
295 i: Integer;
296begin
297 Result := TStringList.Create;
298 for i := 0 to Length(Fdat_extensionsmap) - 1 do
299 begin
300 with Fdat_extensionsmap[i] do
301 begin
302 case ExtListFormat of
303 EF_ExtOnly:
304 Result.Add(Extension[3] + Extension[2] + Extension[1] + Extension[0]);
305 EF_ExtCount:
306 Result.Add(Extension[3] + Extension[2] + Extension[1] + Extension[0] +
307 ' (' + IntToStr(ExtCount) + ')');
308 end;
309 end;
310 end;
311end;
312
313
314
315procedure TAccess_OniArchive.LoadDatFile(FileID: Integer; var Target: TStream);
316var
317 streampos: Integer;
318begin
319 if fileid < GetFileCount then
320 begin
321 if not Assigned(Target) then
322 Target := TMemoryStream.Create;
323 if not FDatOpened then
324 Fdat_file := TFileStream.Create(FFileName, fmOpenReadWrite);
325 Fdat_file.Seek(Fdat_files[fileid].DatAddr, soFromBeginning);
326 streampos := Target.Position;
327 Target.CopyFrom(Fdat_file, Fdat_files[fileid].Size);
328 Target.Seek(streampos, soFromBeginning);
329 if UnloadWhenUnused then
330 begin
331 Fdat_file.Free;
332 FDatOpened := False;
333 end
334 else
335 FDatOpened := True;
336 end;
337end;
338
339procedure TAccess_OniArchive.UpdateDatFile(FileID: Integer; Src: TStream);
340begin
341 if fileid < GetFileCount then
342 begin
343 if not FDatOpened then
344 Fdat_file := TFileStream.Create(FFileName, fmOpenReadWrite);
345 Fdat_file.Seek(Fdat_files[fileid].DatAddr, soFromBeginning);
346 Fdat_file.CopyFrom(Src, Fdat_files[fileid].Size);
347 if UnloadWhenUnused then
348 begin
349 Fdat_file.Free;
350 FDatOpened := False;
351 end
352 else
353 FDatOpened := True;
354 end;
355end;
356
357procedure TAccess_OniArchive.LoadDatFilePart(FileID, Offset, Size: Integer; var Target: TStream);
358var
359 streampos: Integer;
360begin
361 if fileid < GetFileCount then
362 begin
363 if not Assigned(Target) then
364 Target := TMemoryStream.Create;
365 if not FDatOpened then
366 Fdat_file := TFileStream.Create(FFileName, fmOpenReadWrite);
367 Fdat_file.Seek(Fdat_files[fileid].DatAddr + offset, soFromBeginning);
368 streampos := Target.Position;
369 Target.CopyFrom(Fdat_file, size);
370 Target.Seek(streampos, soFromBeginning);
371 if UnloadWhenUnused then
372 begin
373 FDatOpened := False;
374 Fdat_file.Free;
375 end
376 else
377 FDatOpened := True;
378 end;
379end;
380
381procedure TAccess_OniArchive.UpdateDatFilePart(FileID, Offset, Size: Integer; Src: TStream);
382begin
383 if fileid < GetFileCount then
384 begin
385 if not FDatOpened then
386 Fdat_file := TFileStream.Create(FFileName, fmOpenReadWrite);
387 Fdat_file.Seek(Fdat_files[fileid].DatAddr + offset, soFromBeginning);
388 Fdat_file.CopyFrom(Src, Size);
389 if UnloadWhenUnused then
390 begin
391 Fdat_file.Free;
392 FDatOpened := False;
393 end
394 else
395 FDatOpened := True;
396 end;
397end;
398
399
400
401function TAccess_OniArchive.GetRawList(FileID: Integer): TRawDataList;
402begin
403 Result := RawLists.GetRawList(FConnectionID, FileID);
404end;
405
406
407function TAccess_OniArchive.GetRawInfo(FileID, DatOffset: Integer): TRawDataInfo;
408begin
409 Result := RawLists.GetRawInfo(FConnectionID, FileID, DatOffset);
410end;
411
412
413
414
415procedure TAccess_OniArchive.LoadRawOffset(LocSep: Boolean; RawAddr, Size: Integer; target: Pointer);
416begin
417 if not LocSep then
418 begin
419 if not FRawOpened then
420 Fraw_file := TFileStream.Create(AnsiReplaceStr(FFileName, '.dat', '.raw'),
421 fmOpenReadWrite);
422 if RawAddr <= Fraw_file.Size then
423 begin
424 Fraw_file.Seek(RawAddr, soFromBeginning);
425 Fraw_file.Read(target^, size);
426 end;
427 if UnloadWhenUnused then
428 begin
429 FRawOpened := False;
430 Fraw_file.Free;
431 end
432 else
433 FRawOpened := True;
434 end
435 else
436 begin
437 if not FSepOpened then
438 Fsep_file := TFileStream.Create(AnsiReplaceStr(FFileName, '.dat', '.sep'),
439 fmOpenReadWrite);
440 if RawAddr <= Fsep_file.Size then
441 begin
442 Fsep_file.Seek(RawAddr, soFromBeginning);
443 Fsep_file.Read(target^, size);
444 end;
445 if UnloadWhenUnused then
446 begin
447 FSepOpened := False;
448 Fsep_file.Free;
449 end
450 else
451 FSepOpened := True;
452 end;
453end;
454
455procedure TAccess_OniArchive.LoadRawFile(FileID, DatOffset: Integer; var Target: TStream);
456var
457 raw_info: TRawDataInfo;
458 streampos: Integer;
459begin
460 if not Assigned(Target) then
461 Target := TMemoryStream.Create;
462 if fileid < GetFileCount then
463 begin
464 raw_info := Self.GetRawInfo(FileID, DatOffset);
465 if not raw_info.LocSep then
466 begin
467 if not FRawOpened then
468 Fraw_file := TFileStream.Create(AnsiReplaceStr(FFileName, '.dat', '.raw'),
469 fmOpenReadWrite);
470 Fraw_file.Seek(raw_info.RawAddr, soFromBeginning);
471 streampos := Target.Position;
472 Target.CopyFrom(Fraw_file, raw_info.RawSize);
473 Target.Seek(streampos, soFromBeginning);
474 if UnloadWhenUnused then
475 begin
476 FRawOpened := False;
477 Fraw_file.Free;
478 end
479 else
480 FRawOpened := True;
481 end
482 else
483 begin
484 if FUnloadWhenUnused or not FSepOpened then
485 Fsep_file := TFileStream.Create(AnsiReplaceStr(FFileName, '.dat', '.sep'),
486 fmOpenReadWrite);
487 Fsep_file.Seek(raw_info.RawAddr, soFromBeginning);
488 streampos := Target.Position;
489 Target.CopyFrom(Fsep_file, raw_info.RawSize);
490 Target.Seek(streampos, soFromBeginning);
491 if UnloadWhenUnused then
492 begin
493 FSepOpened := False;
494 Fsep_file.Free;
495 end
496 else
497 FSepOpened := True;
498 end;
499 end;
500end;
501
502procedure TAccess_OniArchive.UpdateRawFile(FileID, DatOffset: Integer; Src: TStream);
503var
504 raw_info: TRawDataInfo;
505begin
506 if fileid < GetFileCount then
507 begin
508 raw_info := GetRawInfo(FileID, DatOffset);
509 if not raw_info.LocSep then
510 begin
511 if not FRawOpened then
512 Fraw_file := TFileStream.Create(AnsiReplaceStr(FFileName, '.dat', '.raw'),
513 fmOpenReadWrite);
514 Fraw_file.Seek(raw_info.RawAddr, soFromBeginning);
515 Fraw_file.CopyFrom(Src, raw_info.RawSize);
516 if UnloadWhenUnused then
517 begin
518 FRawOpened := False;
519 Fraw_file.Free;
520 end
521 else
522 FRawOpened := True;
523 end
524 else
525 begin
526 if not FSepOpened then
527 Fsep_file := TFileStream.Create(AnsiReplaceStr(FFileName, '.dat', '.sep'),
528 fmOpenReadWrite);
529 Fsep_file.Seek(raw_info.RawAddr, soFromBeginning);
530 Fsep_file.CopyFrom(Src, raw_info.RawSize);
531 if UnloadWhenUnused then
532 begin
533 FSepOpened := False;
534 Fsep_file.Free;
535 end
536 else
537 FSepOpened := True;
538 end;
539 end;
540end;
541
542procedure TAccess_OniArchive.LoadRawFilePart(FileID, DatOffset, Offset, Size: Integer; var Target: TStream);
543var
544 Data: TStream;
545 streampos: Integer;
546begin
547 if not Assigned(Target) then
548 Target := TMemoryStream.Create;
549 if fileid < Self.GetFileCount then
550 begin
551 data := nil;
552 LoadRawFile(FileID, DatOffset, Data);
553 Data.Seek(Offset, soFromBeginning);
554 streampos := Target.Position;
555 Target.CopyFrom(Data, Size);
556 Target.Seek(streampos, soFromBeginning);
557 end;
558end;
559
560procedure TAccess_OniArchive.UpdateRawFilePart(FileID, DatOffset, Offset, Size: Integer; Src: TStream);
561var
562 raw_info: TRawDataInfo;
563begin
564 if fileid < GetFileCount then
565 begin
566 raw_info := GetRawInfo(FileID, DatOffset);
567 if not raw_info.LocSep then
568 begin
569 if not FRawOpened then
570 Fraw_file := TFileStream.Create(AnsiReplaceStr(FFileName, '.dat', '.raw'),
571 fmOpenReadWrite);
572 Fraw_file.Seek(raw_info.RawAddr + Offset, soFromBeginning);
573 Fraw_file.CopyFrom(Src, Size);
574 if UnloadWhenUnused then
575 begin
576 FRawOpened := False;
577 Fraw_file.Free;
578 end
579 else
580 FRawOpened := True;
581 end
582 else
583 begin
584 if not FSepOpened then
585 Fsep_file := TFileStream.Create(AnsiReplaceStr(FFileName, '.dat', '.sep'),
586 fmOpenReadWrite);
587 Fsep_file.Seek(raw_info.RawAddr + Offset, soFromBeginning);
588 Fsep_file.CopyFrom(Src, Size);
589 if UnloadWhenUnused then
590 begin
591 FSepOpened := False;
592 Fsep_file.Free;
593 end
594 else
595 FSepOpened := True;
596 end;
597 end;
598end;
599
600function TAccess_OniArchive.AppendRawFile(LocSep: Boolean; Src: TStream): Integer;
601begin
602 if not LocSep then
603 begin
604 if not FRawOpened then
605 Fraw_file := TFileStream.Create(AnsiReplaceStr(FFileName, '.dat', '.raw'),
606 fmOpenReadWrite);
607 Result := Fraw_file.Size;
608 Fraw_file.Seek(0, soFromEnd);
609 Fraw_file.CopyFrom(Src, Src.Size);
610 if UnloadWhenUnused then
611 begin
612 FRawOpened := False;
613 Fraw_file.Free;
614 end
615 else
616 FRawOpened := True;
617 end
618 else
619 begin
620 if not FSepOpened then
621 Fsep_file := TFileStream.Create(AnsiReplaceStr(FFileName, '.dat', '.sep'),
622 fmOpenReadWrite);
623 Result := Fsep_file.Size;
624 Fsep_file.Seek(0, soFromEnd);
625 Fsep_file.CopyFrom(Src, Src.Size);
626 if UnloadWhenUnused then
627 begin
628 FSepOpened := False;
629 Fsep_file.Free;
630 end
631 else
632 FSepOpened := True;
633 end;
634end;
635
636end.
Note: See TracBrowser for help on using the repository browser.