X-Git-Url: https://deadsoftware.ru/gitweb?a=blobdiff_plain;f=src%2Fshared%2Fwadreader.pas;h=b8f14db952daaa900e0a6e85ce8d669519ad3c7f;hb=997a94053b44d7b4c6e149cd3e50463386ef730c;hp=3cce5df6c0053f1b7f0c5445799feaa78a06c97b;hpb=844441154d1220d6c83f75043300c2851ec87109;p=d2df-sdl.git diff --git a/src/shared/wadreader.pas b/src/shared/wadreader.pas index 3cce5df..b8f14db 100644 --- a/src/shared/wadreader.pas +++ b/src/shared/wadreader.pas @@ -1,6 +1,8 @@ +{$MODE DELPHI} unit wadreader; {$DEFINE SFS_DWFAD_DEBUG} +{$DEFINE SFS_MAPDETECT_FX} interface @@ -13,10 +15,13 @@ type TWADFile = class(TObject) private - fFileName: string; // empty: not opened + fFileName: AnsiString; // empty: not opened fIter: TSFSFileList; function getIsOpen (): Boolean; + function isMapResource (idx: Integer): Boolean; + + function GetResourceEx (name: AnsiString; wantMap: Boolean; var pData: Pointer; var Len: Integer): Boolean; public constructor Create(); @@ -24,42 +29,47 @@ type procedure FreeWAD(); - function ReadFile (FileName: string): Boolean; + function ReadFile (FileName: AnsiString): Boolean; function ReadMemory (Data: Pointer; Len: LongWord): Boolean; - function GetResource (Section, Resource: string; var pData: Pointer; var Len: Integer): Boolean; - function GetResourcesList (Section: string): SArray; + + function GetResource (name: AnsiString; var pData: Pointer; var Len: Integer): Boolean; + function GetMapResource (name: AnsiString; var pData: Pointer; var Len: Integer): Boolean; + function GetMapResources (): SArray; property isOpen: Boolean read getIsOpen; end; -procedure g_ProcessResourceStr (ResourceStr: String; var FileName, SectionName, ResourceName: String); overload; -procedure g_ProcessResourceStr (ResourceStr: String; FileName, SectionName, ResourceName: PString); overload; +function g_ExtractWadName (resourceStr: AnsiString): AnsiString; +function g_ExtractWadNameNoPath (resourceStr: AnsiString): AnsiString; +function g_ExtractFilePath (resourceStr: AnsiString): AnsiString; +function g_ExtractFileName (resourceStr: AnsiString): AnsiString; // without path +function g_ExtractFilePathName (resourceStr: AnsiString): AnsiString; -// return fixed string or empty string -function findDiskWad (fname: string): string; +// return fixed AnsiString or empty AnsiString +function findDiskWad (fname: AnsiString): AnsiString; implementation uses - SysUtils, Classes, BinEditor, e_log, g_options, utils; + SysUtils, Classes, BinEditor, e_log, g_options, utils, MAPSTRUCT; -function findDiskWad (fname: string): string; +function findDiskWad (fname: AnsiString): AnsiString; begin result := ''; if not findFileCI(fname) then begin - //e_WriteLog(Format('TWADFile.ReadFile: error looking for [%s] [%s]', [path, ExtractFileName(fname)]), MSG_NOTIFY); + //e_WriteLog(Format('findDiskWad: error looking for [%s]', [fname]), MSG_NOTIFY); if StrEquCI1251(ExtractFileExt(fname), '.wad') then begin - fname := ChangeFileExt(ExtractFileName(fname), '.pk3'); - //e_WriteLog(Format(' looking for [%s] [%s]', [path, rfn]), MSG_NOTIFY); + fname := ChangeFileExt(fname, '.pk3'); + //e_WriteLog(Format(' looking for [%s]', [fname]), MSG_NOTIFY); if not findFileCI(fname) then begin - //e_WriteLog(Format(' looking for [%s] [%s]', [path, rfn]), MSG_NOTIFY); - fname := ChangeFileExt(ExtractFileName(fname), '.zip'); + fname := ChangeFileExt(fname, '.zip'); + //e_WriteLog(Format(' looking for [%s]', [fname]), MSG_NOTIFY); if not findFileCI(fname) then exit; end; end @@ -67,69 +77,106 @@ begin begin exit; end; - //e_WriteLog(Format('TWADFile.ReadFile: FOUND [%s]', [rfn]), MSG_NOTIFY); - end - else - begin - //if rfn <> ExtractFileName(FileName) then e_WriteLog(Format('TWADFile.ReadFile: FOUND [%s]', [rfn]), MSG_NOTIFY); end; + //e_WriteLog(Format('findDiskWad: FOUND [%s]', [fname]), MSG_NOTIFY); result := fname; end; -procedure g_ProcessResourceStr (ResourceStr: String; var FileName, SectionName, ResourceName: String); +function normSlashes (s: AnsiString): AnsiString; var - a, i: Integer; + f: Integer; begin - //e_WriteLog(Format('g_ProcessResourceStr0: [%s]', [ResourceStr]), MSG_NOTIFY); - for i := Length(ResourceStr) downto 1 do - if ResourceStr[i] = ':' then - Break; - - FileName := Copy(ResourceStr, 1, i-1); - - for a := i+1 to Length(ResourceStr) do - if (ResourceStr[a] = '\') or (ResourceStr[a] = '/') then Break; - - ResourceName := Copy(ResourceStr, a+1, Length(ResourceStr)-Abs(a)); - SectionName := Copy(ResourceStr, i+1, Length(ResourceStr)-Length(ResourceName)-Length(FileName)-2); + for f := 1 to length(s) do if s[f] = '\' then s[f] := '/'; + result := s; end; - -procedure g_ProcessResourceStr (ResourceStr: AnsiString; FileName, SectionName, ResourceName: PAnsiString); +function g_ExtractWadNameNoPath (resourceStr: AnsiString): AnsiString; var - a, i, l1, l2: Integer; - + f, c: Integer; begin - //e_WriteLog(Format('g_ProcessResourceStr1: [%s]', [ResourceStr]), MSG_NOTIFY); - for i := Length(ResourceStr) downto 1 do - if ResourceStr[i] = ':' then - Break; + for f := length(resourceStr) downto 1 do + begin + if resourceStr[f] = ':' then + begin + result := normSlashes(Copy(resourceStr, 1, f-1)); + c := length(result); + while (c > 0) and (result[c] <> '/') do Dec(c); + if c > 0 then result := Copy(result, c+1, length(result)); + exit; + end; + end; + result := ''; +end; - if FileName <> nil then +function g_ExtractWadName (resourceStr: AnsiString): AnsiString; +var + f: Integer; +begin + for f := length(resourceStr) downto 1 do + begin + if resourceStr[f] = ':' then begin - FileName^ := Copy(ResourceStr, 1, i-1); - l1 := Length(FileName^); - end - else - l1 := 0; + result := normSlashes(Copy(resourceStr, 1, f-1)); + exit; + end; + end; + result := ''; +end; - for a := i+1 to Length(ResourceStr) do - if (ResourceStr[a] = '\') or (ResourceStr[a] = '/') then Break; +function g_ExtractFilePath (resourceStr: AnsiString): AnsiString; +var + f, lastSlash: Integer; +begin + result := ''; + lastSlash := -1; + for f := length(resourceStr) downto 1 do + begin + if (lastSlash < 0) and (resourceStr[f] = '\') or (resourceStr[f] = '/') then lastSlash := f; + if resourceStr[f] = ':' then + begin + if lastSlash > 0 then result := normSlashes(Copy(resourceStr, f, lastSlash-f)); + exit; + end; + end; + if lastSlash > 0 then result := normSlashes(Copy(resourceStr, 1, lastSlash-1)); +end; - if ResourceName <> nil then +function g_ExtractFileName (resourceStr: AnsiString): AnsiString; // without path +var + f, lastSlash: Integer; +begin + result := ''; + lastSlash := -1; + for f := length(resourceStr) downto 1 do + begin + if (lastSlash < 0) and (resourceStr[f] = '\') or (resourceStr[f] = '/') then lastSlash := f; + if resourceStr[f] = ':' then begin - ResourceName^ := Copy(ResourceStr, a+1, Length(ResourceStr)-Abs(a)); - l2 := Length(ResourceName^); - end - else - l2 := 0; + if lastSlash > 0 then result := Copy(resourceStr, lastSlash+1, length(resourceStr)); + exit; + end; + end; + if lastSlash > 0 then result := Copy(resourceStr, lastSlash+1, length(resourceStr)); +end; - if SectionName <> nil then - SectionName^ := Copy(ResourceStr, i+1, Length(ResourceStr)-l2-l1-2); +function g_ExtractFilePathName (resourceStr: AnsiString): AnsiString; +var + f: Integer; +begin + result := ''; + for f := length(resourceStr) downto 1 do + begin + if resourceStr[f] = ':' then + begin + result := normSlashes(Copy(resourceStr, f+1, length(resourceStr))); + exit; + end; + end; end; + { TWADFile } constructor TWADFile.Create(); begin @@ -157,8 +204,27 @@ begin fFileName := ''; end; +function TWADFile.isMapResource (idx: Integer): Boolean; +var + sign: packed array [0..2] of Char; + fs: TStream; +begin + result := false; + if not isOpen or (fIter = nil) then exit; + if (idx < 0) or (idx >= fIter.Count) then exit; + fs := nil; + try + fs := fIter.volume.OpenFileByIndex(idx); + fs.readBuffer(sign, 3); + result := (sign = MAP_SIGNATURE); + except + if fs <> nil then fs.Free(); + exit; + end; + fs.Free(); +end; -function removeExt (s: string): string; +function removeExt (s: AnsiString): AnsiString; var i: Integer; begin @@ -172,29 +238,56 @@ begin result := s; end; -function TWADFile.GetResource (Section, Resource: string; var pData: Pointer; var Len: Integer): Boolean; +function TWADFile.GetResourceEx (name: AnsiString; wantMap: Boolean; var pData: Pointer; var Len: Integer): Boolean; var - f: Integer; + f, lastSlash: Integer; fi: TSFSFileInfo; fs: TStream; fpp: Pointer; - //fn: string; + rpath, rname: AnsiString; + sign: array [0..2] of Char; + goodMap: Boolean; begin Result := False; if not isOpen or (fIter = nil) then Exit; - if length(Resource) = 0 then Exit; // just in case - if (length(Section) <> 0) and (Section[length(Section)] <> '/') then Section := Section+'/'; + rname := removeExt(name); + if length(rname) = 0 then Exit; // just in case + lastSlash := -1; + for f := 1 to length(rname) do + begin + if rname[f] = '\' then rname[f] := '/'; + if rname[f] = '/' then lastSlash := f; + end; + if lastSlash > 0 then + begin + rpath := Copy(rname, 1, lastSlash); + Delete(rname, 1, lastSlash); + end + else + begin + rpath := ''; + end; // backwards, due to possible similar names and such for f := fIter.Count-1 downto 0 do begin fi := fIter.Files[f]; if fi = nil then continue; - //e_WriteLog(Format('DFWAD: searching for [%s : %s] in [%s]; current is [%s : %s]', [Section, Resource, fFileName, fi.path, fi.name]), MSG_NOTIFY); - if StrEquCI1251(fi.path, Section) and StrEquCI1251(removeExt(fi.name), Resource) then + if StrEquCI1251(removeExt(fi.name), rname) then begin - // i found her! - //fn := fFileName+'::'+fi.path+fi.name; - //fs := SFSFileOpen(fn); + // i found her (maybe) + if not wantMap then + begin + if length(fi.path) < length(rpath) then continue; // alas + if length(fi.path) = length(rpath) then + begin + if not StrEquCI1251(fi.path, rpath) then continue; // alas + end + else + begin + if fi.path[length(fi.path)-length(rpath)] <> '/' then continue; // alas + if not StrEquCI1251(Copy(fi.path, length(fi.path)+1-length(rpath), length(fi.path)), rpath) then continue; // alas + end; + end; try fs := fIter.volume.OpenFileByIndex(f); except @@ -202,9 +295,36 @@ begin end; if fs = nil then begin - e_WriteLog(Format('DFWAD: can''t open file [%s%s] in [%s]', [Section, Resource, fFileName]), MSG_WARNING); + if wantMap then continue; + e_WriteLog(Format('DFWAD: can''t open file [%s] in [%s]', [name, fFileName]), MSG_WARNING); break; end; + // if we want only maps, check if this is map +{$IFDEF SFS_MAPDETECT_FX} + if wantMap then + begin + goodMap := false; + //e_WriteLog(Format('DFWAD: checking for good map in wad [%s], file [%s] (#%d)', [fFileName, fi.fname, f]), MSG_NOTIFY); + try + fs.readBuffer(sign, 3); + goodMap := (sign = MAP_SIGNATURE); + { + if goodMap then + e_WriteLog(Format(' GOOD map in wad [%s], file [%s] (#%d)', [fFileName, fi.fname, f]), MSG_NOTIFY) + else + e_WriteLog(Format(' BAD map in wad [%s], file [%s] (#%d)', [fFileName, fi.fname, f]), MSG_NOTIFY); + } + except + end; + if not goodMap then + begin + //e_WriteLog(Format(' not a map in wad [%s], file [%s] (#%d)', [fFileName, fi.fname, f]), MSG_NOTIFY); + fs.Free(); + continue; + end; + fs.position := 0; + end; +{$ENDIF} Len := Integer(fs.size); GetMem(pData, Len); fpp := pData; @@ -220,43 +340,82 @@ begin end; fs.Free; end; +{$IFNDEF SFS_MAPDETECT_FX} + if wantMap then + begin + goodMap := false; + if Len >= 3 then + begin + Move(pData^, sign, 3); + goodMap := (sign = MAP_SIGNATURE); + end; + if not goodMap then + begin + //e_WriteLog(Format(' not a map in wad [%s], file [%s] (#%d)', [fFileName, fi.fname, f]), MSG_NOTIFY); + FreeMem(pData); + pData := nil; + Len := 0; + continue; + end; + end; +{$ENDIF} result := true; {$IFDEF SFS_DWFAD_DEBUG} if gSFSDebug then - e_WriteLog(Format('DFWAD: file [%s%s] FOUND in [%s]; size is %d bytes', [Section, Resource, fFileName, Len]), MSG_NOTIFY); + e_WriteLog(Format('DFWAD: file [%s] FOUND in [%s]; size is %d bytes', [name, fFileName, Len]), MSG_NOTIFY); {$ENDIF} exit; end; end; - e_WriteLog(Format('DFWAD: file [%s%s] not found in [%s]', [Section, Resource, fFileName]), MSG_WARNING); + e_WriteLog(Format('DFWAD: file [%s] not found in [%s]', [name, fFileName]), MSG_WARNING); end; +function TWADFile.GetResource (name: AnsiString; var pData: Pointer; var Len: Integer): Boolean; +begin + result := GetResourceEx(name, false, pData, Len); +end; -function TWADFile.GetResourcesList (Section: string): SArray; +function TWADFile.GetMapResource (name: AnsiString; var pData: Pointer; var Len: Integer): Boolean; +begin + result := GetResourceEx(name, true, pData, Len); +end; + +function TWADFile.GetMapResources (): SArray; var - f: Integer; + f, c: Integer; fi: TSFSFileInfo; + s: AnsiString; begin Result := nil; if not isOpen or (fIter = nil) then Exit; - if (length(Section) <> 0) and (Section[length(Section)] <> '/') then Section := Section+'/'; - for f := 0 to fIter.Count-1 do + for f := fIter.Count-1 downto 0 do begin fi := fIter.Files[f]; if fi = nil then continue; if length(fi.name) = 0 then continue; - if StrEquCI1251(fi.path, Section) then + //e_WriteLog(Format('DFWAD: checking for map in wad [%s], file [%s] (#%d)', [fFileName, fi.fname, f]), MSG_NOTIFY); + if isMapResource(f) then begin - SetLength(result, Length(result)+1); - result[high(result)] := removeExt(fi.name); + s := removeExt(fi.name); + c := High(result); + while c >= 0 do + begin + if StrEquCI1251(result[c], s) then break; + Dec(c); + end; + if c < 0 then + begin + SetLength(result, Length(result)+1); + result[high(result)] := removeExt(fi.name); + end; end; end; end; -function TWADFile.ReadFile (FileName: string): Boolean; +function TWADFile.ReadFile (FileName: AnsiString): Boolean; var - rfn: string; + rfn: AnsiString; //f: Integer; //fi: TSFSFileInfo; begin @@ -300,7 +459,7 @@ var function TWADFile.ReadMemory (Data: Pointer; Len: LongWord): Boolean; var - fn: string; + fn: AnsiString; st: TStream = nil; //f: Integer; //fi: TSFSFileInfo;