X-Git-Url: https://deadsoftware.ru/gitweb?a=blobdiff_plain;f=src%2Fshared%2Fwadreader.pas;h=ade53adcf7f9343c6ed882a20c7df2b626b0ac7e;hb=af3c404e11867c6794975f1d45dd98932d804ede;hp=3cce5df6c0053f1b7f0c5445799feaa78a06c97b;hpb=844441154d1220d6c83f75043300c2851ec87109;p=d2df-sdl.git diff --git a/src/shared/wadreader.pas b/src/shared/wadreader.pas index 3cce5df..ade53ad 100644 --- a/src/shared/wadreader.pas +++ b/src/shared/wadreader.pas @@ -1,3 +1,4 @@ +{$MODE DELPHI} unit wadreader; {$DEFINE SFS_DWFAD_DEBUG} @@ -13,7 +14,7 @@ type TWADFile = class(TObject) private - fFileName: string; // empty: not opened + fFileName: AnsiString; // empty: not opened fIter: TSFSFileList; function getIsOpen (): Boolean; @@ -24,20 +25,24 @@ 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 GetRootResources (): 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 @@ -46,20 +51,20 @@ uses SysUtils, Classes, BinEditor, e_log, g_options, utils; -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 +72,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 @@ -158,7 +200,7 @@ begin end; -function removeExt (s: string): string; +function removeExt (s: AnsiString): AnsiString; var i: Integer; begin @@ -172,25 +214,41 @@ begin result := s; end; -function TWADFile.GetResource (Section, Resource: string; var pData: Pointer; var Len: Integer): Boolean; +function TWADFile.GetResource (name: AnsiString; var pData: Pointer; var Len: Integer): Boolean; var - f: Integer; + f, lastSlash: Integer; fi: TSFSFileInfo; fs: TStream; fpp: Pointer; - //fn: string; + rpath, rname: AnsiString; + //fn: AnsiString; 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(fi.path, rpath) and StrEquCI1251(removeExt(fi.name), rname) then begin // i found her! //fn := fFileName+'::'+fi.path+fi.name; @@ -202,7 +260,7 @@ begin end; if fs = nil then begin - e_WriteLog(Format('DFWAD: can''t open file [%s%s] in [%s]', [Section, Resource, fFileName]), MSG_WARNING); + e_WriteLog(Format('DFWAD: can''t open file [%s] in [%s]', [name, fFileName]), MSG_WARNING); break; end; Len := Integer(fs.size); @@ -223,29 +281,28 @@ begin 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.GetResourcesList (Section: string): SArray; +function TWADFile.GetRootResources (): SArray; var f: Integer; fi: TSFSFileInfo; 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 begin fi := fIter.Files[f]; if fi = nil then continue; if length(fi.name) = 0 then continue; - if StrEquCI1251(fi.path, Section) then + if length(fi.path) = 0 then begin SetLength(result, Length(result)+1); result[high(result)] := removeExt(fi.name); @@ -254,9 +311,9 @@ begin 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 +357,7 @@ var function TWADFile.ReadMemory (Data: Pointer; Len: LongWord): Boolean; var - fn: string; + fn: AnsiString; st: TStream = nil; //f: Integer; //fi: TSFSFileInfo;