unit Access_OniArchive; interface uses DataAccess, Classes, TypeDefs; type TAccess_OniArchive = class(TDataAccess) private Fdat_file: TFileStream; Fraw_file: TFileStream; Fsep_file: TFileStream; Fdat_files: TFiles; Fdat_extensionsmap: TExtensionsMap; FUnloadWhenUnused: Boolean; FDatOpened: Boolean; FRawOpened: Boolean; FSepOpened: Boolean; protected public property UnloadWhenUnused: Boolean Read FUnloadWhenUnused Write FUnloadWhenUnused; constructor Create(DatFilename: String; ConnectionID: Integer; var Msg: TStatusMessages); override; procedure Close; override; function GetFileInfo(FileID: Integer): TFileInfo; override; function GetFilesList(Ext: String; Pattern: String; NoEmptyFiles: Boolean; SortType: TSortType): TStrings; override; function GetFileCount: Integer; override; function GetExtensionsList(ExtListFormat: TExtensionFormat): TStrings; override; procedure LoadDatFile(FileID: Integer; var Target: TStream); overload; override; procedure UpdateDatFile(FileID: Integer; Src: TStream); overload; override; procedure LoadDatFilePart(FileID, Offset, Size: Integer; var Target: TStream); overload; override; procedure UpdateDatFilePart(FileID, Offset, Size: Integer; Src: TStream); overload; override; function GetRawList(FileID: Integer): TRawDataList; override; function GetRawInfo(FileID, DatOffset: Integer): TRawDataInfo; override; procedure LoadRawOffset(LocSep: Boolean; RawAddr, Size: Integer; target: Pointer); procedure LoadRawFile(FileID, DatOffset: Integer; var Target: TStream); overload; override; procedure UpdateRawFile(FileID, DatOffset: Integer; Src: TStream); overload; override; procedure LoadRawFilePart(FileID, DatOffset, Offset, Size: Integer; var Target: TStream); overload; override; procedure UpdateRawFilePart(FileID, DatOffset, Offset, Size: Integer; Src: TStream); overload; override; function AppendRawFile(LocSep: Boolean; Src: TStream): Integer; overload; override; published end; implementation uses SysUtils, StrUtils, Data, Functions, RawList; (* ================================================================================ Implementation of TOniDataDat *) constructor TAccess_OniArchive.Create(DatFilename: String; ConnectionID: Integer; var Msg: TStatusMessages); type THeader = packed record Ident: array[0..$13] of Byte; Files: Integer; NamedFiles: Integer; Extensions: Integer; DataAddr: Integer; DataSize: Integer; NamesAddr: Integer; NamesSize: Integer; Ident2: array[0..$F] of Byte; end; TFilesMap = array of packed record Extension: array[0..$3] of Char; DataAddr: Integer; NameAddr: Integer; FileSize: Integer; FileType: LongWord; end; TNamedFilesMap = array of packed record FileNumber: Integer; blubb: Integer; end; const header_ident1_pc: array[0..$13] of Byte = ($1F, $27, $DC, $33, $DF, $BC, $03, $00, $31, $33, $52, $56, $40, $00, $14, $00, $10, $00, $08, $00); header_ident1_mac: array[0..$13] of Byte = ($61, $30, $C1, $23, $DF, $BC, $03, $00, $31, $33, $52, $56, $40, $00, $14, $00, $10, $00, $08, $00); header_ident1_macbeta: array[0..$13] of Byte = ($81, $11, $8D, $23, $DF, $BC, $03, $00, $31, $33, $52, $56, $40, $00, $14, $00, $10, $00, $08, $00); header_ident2: array[0..$F] of Byte = ($99, $CF, $40, $00, $90, $4F, $63, $00, $F4, $55, $5F, $00, $90, $4F, $63, $00); var i: Integer; header_pc, header_mac, header_macbeta: Boolean; Fdat_header: THeader; Fdat_filesmap: TFilesMap; Fdat_namedfilesmap: TNamedFilesMap; begin FUnloadWhenUnused := True; FDatOpened := False; FRawOpened := False; Msg := SM_UnknownError; if not FileExists(DatFilename) then begin Msg := SM_FileNotFound; Exit; end; FFileName := DatFilename; Fdat_file := TFileStream.Create(FFileName, fmOpenRead); Fdat_file.Read(Fdat_header, SizeOf(Fdat_header)); header_pc := True; header_mac := True; header_macbeta := True; for i := 0 to High(Fdat_header.Ident) do begin // FLevelInfo.Ident[i] := Fdat_header.Ident[i]; if Fdat_header.Ident[i] <> header_ident1_pc[i] then header_pc := False; if Fdat_header.Ident[i] <> header_ident1_mac[i] then header_mac := False; if Fdat_header.Ident[i] <> header_ident1_macbeta[i] then header_macbeta := False; end; if not (header_pc xor header_mac xor header_macbeta) then begin Msg := SM_IncompatibleFile; Exit; end else begin if (header_pc and not header_mac and not header_macbeta) then FDataOS := DOS_WIN else if (not header_pc and header_mac and not header_macbeta) then FDataOS := DOS_MAC else if (not header_pc and not header_mac and header_macbeta) then FDataOS := DOS_MACBETA; end; SetLength(Fdat_filesmap, Fdat_header.Files); SetLength(Fdat_files, Fdat_header.Files); for i := 0 to Fdat_header.Files - 1 do Fdat_file.Read(Fdat_filesmap[i], SizeOf(Fdat_filesmap[i])); for i := 0 to Fdat_header.Files - 1 do begin Fdat_files[i].ID := i; Fdat_files[i].Extension := Fdat_filesmap[i].Extension; Fdat_files[i].Extension := ReverseString(Fdat_files[i].Extension); Fdat_files[i].Size := Fdat_filesmap[i].FileSize; Fdat_files[i].FileType := Fdat_filesmap[i].FileType; Fdat_files[i].DatAddr := Fdat_filesmap[i].DataAddr - 8 + Fdat_header.DataAddr; if (Fdat_filesmap[i].FileType and $01) = 0 then begin Fdat_file.Seek(Fdat_filesmap[i].NameAddr + Fdat_header.NamesAddr, soFromBeginning); SetLength(Fdat_files[i].Name, 100); Fdat_file.Read(Fdat_files[i].Name[1], 100); Fdat_files[i].Name := MidStr(Fdat_files[i].Name, 1 + 4, Pos( #0, Fdat_files[i].Name) - 1 - 4); end else begin Fdat_files[i].Name := ''; end; end; Fdat_file.Seek($40 + Fdat_header.Files * $14, soFromBeginning); SetLength(Fdat_namedfilesmap, Fdat_header.NamedFiles); for i := 0 to Fdat_header.NamedFiles - 1 do Fdat_file.Read(Fdat_namedfilesmap[i], SizeOf(Fdat_namedfilesmap[i])); Fdat_file.Seek($40 + Fdat_header.Files * $14 + Fdat_header.NamedFiles * $8, soFromBeginning); SetLength(Fdat_extensionsmap, Fdat_header.Extensions); for i := 0 to Fdat_header.Extensions - 1 do Fdat_file.Read(Fdat_extensionsmap[i], SizeOf(Fdat_extensionsmap[i])); Fdat_file.Seek(Fdat_files[0].DatAddr + 7, soFromBeginning); Fdat_file.Read(FLevelNumber, 1); FLevelNumber := FLevelNumber div 2; Fdat_file.Free; Msg := SM_OK; FBackend := DB_ONI; FConnectionID := ConnectionID; FChangeRights := [CR_EditDat, CR_EditRaw, CR_AppendRaw]; end; procedure TAccess_OniArchive.Close; begin if FDatOpened then Fdat_file.Free; if FRawOpened then Fraw_file.Free; if FSepOpened then Fsep_file.Free; Self.Free; end; function TAccess_OniArchive.GetFileInfo(fileid: Integer): TFileInfo; begin if fileid = -1 then begin Result := inherited GetFileInfo(fileid); Exit; end; if fileid < Self.GetFileCount then Result := Fdat_files[fileid] else Result.ID := -1; end; function TAccess_OniArchive.GetFilesList(ext: String; pattern: String; NoEmptyFiles: Boolean; SortType: TSortType): TStrings; var i: Integer; list: TStringList; id, name, extension: String; fields: TStrings; procedure getfields; begin fields.CommaText := StringReplace(AnsiQuotedStr(list.Strings[i], '"'), ';', '","', [rfReplaceAll]); if SortType in [ST_IDAsc, ST_IDDesc] then begin id := fields.Strings[0]; name := fields.Strings[1]; extension := fields.Strings[2]; end; if SortType in [ST_NameAsc, ST_NameDesc] then begin id := fields.Strings[1]; name := fields.Strings[0]; extension := fields.Strings[2]; end; if SortType in [ST_ExtAsc, ST_ExtDesc] then begin id := fields.Strings[1]; name := fields.Strings[2]; extension := fields.Strings[0]; end; end; begin list := TStringList.Create; list.Sorted := True; for i := 0 to GetFileCount - 1 do begin if ((Length(ext) = 0) or (Pos(Fdat_files[i].Extension, ext) > 0)) and ((Length(pattern) = 0) or (Pos(UpperCase(pattern), UpperCase(Fdat_files[i].Name)) > 0)) then begin if (NoEmptyFiles = False) or ((Fdat_files[i].FileType and $02) = 0) then begin if AppSettings.FilenumbersAsHex then id := IntToHex(Fdat_files[i].ID, 4) else id := FormatNumber(Fdat_files[i].ID, 5, '0'); name := Fdat_files[i].Name; extension := Fdat_files[i].Extension; case SortType of ST_IDAsc, ST_IDDesc: list.Add(id + ';' + name + ';' + extension); ST_NameAsc, ST_NameDesc: list.Add(name + ';' + id + ';' + extension); ST_ExtAsc, ST_ExtDesc: list.Add(extension + ';' + id + ';' + name); end; end; end; end; Result := TStringList.Create; if list.Count > 0 then begin fields := TStringList.Create; if SortType in [ST_IDAsc, ST_NameAsc, ST_ExtAsc] then for i := 0 to list.Count - 1 do begin getfields; Result.Add(id + '-' + name + '.' + extension); end else for i := list.Count - 1 downto 0 do begin getfields; Result.Add(id + '-' + name + '.' + extension); end; fields.Free; end; list.Free; end; function TAccess_OniArchive.GetFileCount: Integer; begin Result := Length(Fdat_files); end; function TAccess_OniArchive.GetExtensionsList(ExtListFormat: TExtensionFormat): TStrings; var i: Integer; begin Result := TStringList.Create; for i := 0 to Length(Fdat_extensionsmap) - 1 do begin with Fdat_extensionsmap[i] do begin case ExtListFormat of EF_ExtOnly: Result.Add(Extension[3] + Extension[2] + Extension[1] + Extension[0]); EF_ExtCount: Result.Add(Extension[3] + Extension[2] + Extension[1] + Extension[0] + ' (' + IntToStr(ExtCount) + ')'); end; end; end; end; procedure TAccess_OniArchive.LoadDatFile(FileID: Integer; var Target: TStream); var streampos: Integer; begin if fileid < GetFileCount then begin if not Assigned(Target) then Target := TMemoryStream.Create; if not FDatOpened then Fdat_file := TFileStream.Create(FFileName, fmOpenReadWrite); Fdat_file.Seek(Fdat_files[fileid].DatAddr, soFromBeginning); streampos := Target.Position; Target.CopyFrom(Fdat_file, Fdat_files[fileid].Size); Target.Seek(streampos, soFromBeginning); if UnloadWhenUnused then begin Fdat_file.Free; FDatOpened := False; end else FDatOpened := True; end; end; procedure TAccess_OniArchive.UpdateDatFile(FileID: Integer; Src: TStream); begin if fileid < GetFileCount then begin if not FDatOpened then Fdat_file := TFileStream.Create(FFileName, fmOpenReadWrite); Fdat_file.Seek(Fdat_files[fileid].DatAddr, soFromBeginning); Fdat_file.CopyFrom(Src, Fdat_files[fileid].Size); if UnloadWhenUnused then begin Fdat_file.Free; FDatOpened := False; end else FDatOpened := True; end; end; procedure TAccess_OniArchive.LoadDatFilePart(FileID, Offset, Size: Integer; var Target: TStream); var streampos: Integer; begin if fileid < GetFileCount then begin if not Assigned(Target) then Target := TMemoryStream.Create; if not FDatOpened then Fdat_file := TFileStream.Create(FFileName, fmOpenReadWrite); Fdat_file.Seek(Fdat_files[fileid].DatAddr + offset, soFromBeginning); streampos := Target.Position; Target.CopyFrom(Fdat_file, size); Target.Seek(streampos, soFromBeginning); if UnloadWhenUnused then begin FDatOpened := False; Fdat_file.Free; end else FDatOpened := True; end; end; procedure TAccess_OniArchive.UpdateDatFilePart(FileID, Offset, Size: Integer; Src: TStream); begin if fileid < GetFileCount then begin if not FDatOpened then Fdat_file := TFileStream.Create(FFileName, fmOpenReadWrite); Fdat_file.Seek(Fdat_files[fileid].DatAddr + offset, soFromBeginning); Fdat_file.CopyFrom(Src, Size); if UnloadWhenUnused then begin Fdat_file.Free; FDatOpened := False; end else FDatOpened := True; end; end; function TAccess_OniArchive.GetRawList(FileID: Integer): TRawDataList; begin Result := RawLists.GetRawList(FConnectionID, FileID); end; function TAccess_OniArchive.GetRawInfo(FileID, DatOffset: Integer): TRawDataInfo; begin Result := RawLists.GetRawInfo(FConnectionID, FileID, DatOffset); end; procedure TAccess_OniArchive.LoadRawOffset(LocSep: Boolean; RawAddr, Size: Integer; target: Pointer); begin if not LocSep then begin if not FRawOpened then Fraw_file := TFileStream.Create(AnsiReplaceStr(FFileName, '.dat', '.raw'), fmOpenReadWrite); if RawAddr <= Fraw_file.Size then begin Fraw_file.Seek(RawAddr, soFromBeginning); Fraw_file.Read(target^, size); end; if UnloadWhenUnused then begin FRawOpened := False; Fraw_file.Free; end else FRawOpened := True; end else begin if not FSepOpened then Fsep_file := TFileStream.Create(AnsiReplaceStr(FFileName, '.dat', '.sep'), fmOpenReadWrite); if RawAddr <= Fsep_file.Size then begin Fsep_file.Seek(RawAddr, soFromBeginning); Fsep_file.Read(target^, size); end; if UnloadWhenUnused then begin FSepOpened := False; Fsep_file.Free; end else FSepOpened := True; end; end; procedure TAccess_OniArchive.LoadRawFile(FileID, DatOffset: Integer; var Target: TStream); var raw_info: TRawDataInfo; streampos: Integer; begin if not Assigned(Target) then Target := TMemoryStream.Create; if fileid < GetFileCount then begin raw_info := Self.GetRawInfo(FileID, DatOffset); if not raw_info.LocSep then begin if not FRawOpened then Fraw_file := TFileStream.Create(AnsiReplaceStr(FFileName, '.dat', '.raw'), fmOpenReadWrite); Fraw_file.Seek(raw_info.RawAddr, soFromBeginning); streampos := Target.Position; Target.CopyFrom(Fraw_file, raw_info.RawSize); Target.Seek(streampos, soFromBeginning); if UnloadWhenUnused then begin FRawOpened := False; Fraw_file.Free; end else FRawOpened := True; end else begin if FUnloadWhenUnused or not FSepOpened then Fsep_file := TFileStream.Create(AnsiReplaceStr(FFileName, '.dat', '.sep'), fmOpenReadWrite); Fsep_file.Seek(raw_info.RawAddr, soFromBeginning); streampos := Target.Position; Target.CopyFrom(Fsep_file, raw_info.RawSize); Target.Seek(streampos, soFromBeginning); if UnloadWhenUnused then begin FSepOpened := False; Fsep_file.Free; end else FSepOpened := True; end; end; end; procedure TAccess_OniArchive.UpdateRawFile(FileID, DatOffset: Integer; Src: TStream); var raw_info: TRawDataInfo; begin if fileid < GetFileCount then begin raw_info := GetRawInfo(FileID, DatOffset); if not raw_info.LocSep then begin if not FRawOpened then Fraw_file := TFileStream.Create(AnsiReplaceStr(FFileName, '.dat', '.raw'), fmOpenReadWrite); Fraw_file.Seek(raw_info.RawAddr, soFromBeginning); Fraw_file.CopyFrom(Src, raw_info.RawSize); if UnloadWhenUnused then begin FRawOpened := False; Fraw_file.Free; end else FRawOpened := True; end else begin if not FSepOpened then Fsep_file := TFileStream.Create(AnsiReplaceStr(FFileName, '.dat', '.sep'), fmOpenReadWrite); Fsep_file.Seek(raw_info.RawAddr, soFromBeginning); Fsep_file.CopyFrom(Src, raw_info.RawSize); if UnloadWhenUnused then begin FSepOpened := False; Fsep_file.Free; end else FSepOpened := True; end; end; end; procedure TAccess_OniArchive.LoadRawFilePart(FileID, DatOffset, Offset, Size: Integer; var Target: TStream); var Data: TStream; streampos: Integer; begin if not Assigned(Target) then Target := TMemoryStream.Create; if fileid < Self.GetFileCount then begin data := nil; LoadRawFile(FileID, DatOffset, Data); Data.Seek(Offset, soFromBeginning); streampos := Target.Position; Target.CopyFrom(Data, Size); Target.Seek(streampos, soFromBeginning); end; end; procedure TAccess_OniArchive.UpdateRawFilePart(FileID, DatOffset, Offset, Size: Integer; Src: TStream); var raw_info: TRawDataInfo; begin if fileid < GetFileCount then begin raw_info := GetRawInfo(FileID, DatOffset); if not raw_info.LocSep then begin if not FRawOpened then Fraw_file := TFileStream.Create(AnsiReplaceStr(FFileName, '.dat', '.raw'), fmOpenReadWrite); Fraw_file.Seek(raw_info.RawAddr + Offset, soFromBeginning); Fraw_file.CopyFrom(Src, Size); if UnloadWhenUnused then begin FRawOpened := False; Fraw_file.Free; end else FRawOpened := True; end else begin if not FSepOpened then Fsep_file := TFileStream.Create(AnsiReplaceStr(FFileName, '.dat', '.sep'), fmOpenReadWrite); Fsep_file.Seek(raw_info.RawAddr + Offset, soFromBeginning); Fsep_file.CopyFrom(Src, Size); if UnloadWhenUnused then begin FSepOpened := False; Fsep_file.Free; end else FSepOpened := True; end; end; end; function TAccess_OniArchive.AppendRawFile(LocSep: Boolean; Src: TStream): Integer; begin if not LocSep then begin if not FRawOpened then Fraw_file := TFileStream.Create(AnsiReplaceStr(FFileName, '.dat', '.raw'), fmOpenReadWrite); Result := Fraw_file.Size; Fraw_file.Seek(0, soFromEnd); Fraw_file.CopyFrom(Src, Src.Size); if UnloadWhenUnused then begin FRawOpened := False; Fraw_file.Free; end else FRawOpened := True; end else begin if not FSepOpened then Fsep_file := TFileStream.Create(AnsiReplaceStr(FFileName, '.dat', '.sep'), fmOpenReadWrite); Result := Fsep_file.Size; Fsep_file.Seek(0, soFromEnd); Fsep_file.CopyFrom(Src, Src.Size); if UnloadWhenUnused then begin FSepOpened := False; Fsep_file.Free; end else FSepOpened := True; end; end; end.