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

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