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

Last change on this file since 112 was 112, checked in by alloc, 15 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.