src/shared/wadreader.pas

   1 {$MODE DELPHI}
   2 unit wadreader;
   3
   4 {$DEFINE SFS_DWFAD_DEBUG}
   5
   6 interface
   7
   8 uses
   9   sfs, xstreams;
  10
  11
  12 type
  13   SArray = array of ShortString;
  14
  15   TWADFile = class(TObject)
  16   private
  17     fFileName: AnsiString; // empty: not opened
  18     fIter: TSFSFileList;
  19
  20     function getIsOpen (): Boolean;
  21
  22    public
  23     constructor Create();
  24     destructor Destroy(); override;
  25
  26     procedure FreeWAD();
  27
  28     function ReadFile (FileName: AnsiString): Boolean;
  29     function ReadMemory (Data: Pointer; Len: LongWord): Boolean;
  30     function GetResource (Section, Resource: AnsiString; var pData: Pointer; var Len: Integer): Boolean;
  31     function GetResourcesList (Section: AnsiString): SArray;
  32
  33     property isOpen: Boolean read getIsOpen;
  34   end;
  35
  36
  37 procedure g_ProcessResourceStr (ResourceStr: AnsiString; var FileName, SectionName, ResourceName: AnsiString); overload;
  38 procedure g_ProcessResourceStr (ResourceStr: AnsiString; FileName, SectionName, ResourceName: PString); overload;
  39
  40 // return fixed AnsiString or empty AnsiString
  41 function findDiskWad (fname: AnsiString): AnsiString;
  42
  43
  44 implementation
  45
  46 uses
  47   SysUtils, Classes, BinEditor, e_log, g_options, utils;
  48
  49
  50 function findDiskWad (fname: AnsiString): AnsiString;
  51 begin
  52   result := '';
  53   if not findFileCI(fname) then
  54   begin
  55     //e_WriteLog(Format('findDiskWad: error looking for [%s]', [fname]), MSG_NOTIFY);
  56     if StrEquCI1251(ExtractFileExt(fname), '.wad') then
  57     begin
  58       fname := ChangeFileExt(fname, '.pk3');
  59       //e_WriteLog(Format('  looking for [%s]', [fname]), MSG_NOTIFY);
  60       if not findFileCI(fname) then
  61       begin
  62         fname := ChangeFileExt(fname, '.zip');
  63         //e_WriteLog(Format('  looking for [%s]', [fname]), MSG_NOTIFY);
  64         if not findFileCI(fname) then exit;
  65       end;
  66     end
  67     else
  68     begin
  69       exit;
  70     end;
  71   end;
  72   //e_WriteLog(Format('findDiskWad: FOUND [%s]', [fname]), MSG_NOTIFY);
  73   result := fname;
  74 end;
  75
  76
  77 procedure g_ProcessResourceStr (ResourceStr: AnsiString; var FileName, SectionName, ResourceName: AnsiString);
  78 var
  79   a, i: Integer;
  80 begin
  81   //e_WriteLog(Format('g_ProcessResourceStr0: [%s]', [ResourceStr]), MSG_NOTIFY);
  82   for i := Length(ResourceStr) downto 1 do if ResourceStr[i] = ':' then break;
  83   FileName := Copy(ResourceStr, 1, i-1);
  84   for a := i+1 to Length(ResourceStr) do if (ResourceStr[a] = '\') or (ResourceStr[a] = '/') then Break;
  85   ResourceName := Copy(ResourceStr, a+1, Length(ResourceStr)-Abs(a));
  86   SectionName := Copy(ResourceStr, i+1, Length(ResourceStr)-Length(ResourceName)-Length(FileName)-2);
  87 end;
  88
  89
  90 procedure g_ProcessResourceStr (ResourceStr: AnsiString; FileName, SectionName, ResourceName: PAnsiString);
  91 var
  92   a, i, l1, l2: Integer;
  93 begin
  94   //e_WriteLog(Format('g_ProcessResourceStr1: [%s]', [ResourceStr]), MSG_NOTIFY);
  95   for i := Length(ResourceStr) downto 1 do if ResourceStr[i] = ':' then break;
  96   if FileName <> nil then
  97   begin
  98     FileName^ := Copy(ResourceStr, 1, i-1);
  99     l1 := Length(FileName^);
 100   end
 101   else
 102   begin
 103     l1 := 0;
 104   end;
 105   for a := i+1 to Length(ResourceStr) do if (ResourceStr[a] = '\') or (ResourceStr[a] = '/') then break;
 106   if ResourceName <> nil then
 107   begin
 108     ResourceName^ := Copy(ResourceStr, a+1, Length(ResourceStr)-Abs(a));
 109     l2 := Length(ResourceName^);
 110   end
 111   else
 112   begin
 113     l2 := 0;
 114   end;
 115   if SectionName <> nil then SectionName^ := Copy(ResourceStr, i+1, Length(ResourceStr)-l2-l1-2);
 116 end;
 117
 118
 119 { TWADFile }
 120 constructor TWADFile.Create();
 121 begin
 122   fFileName := '';
 123 end;
 124
 125
 126 destructor TWADFile.Destroy();
 127 begin
 128   FreeWAD();
 129   inherited;
 130 end;
 131
 132
 133 function TWADFile.getIsOpen (): Boolean;
 134 begin
 135   result := (fFileName <> '');
 136 end;
 137
 138
 139 procedure TWADFile.FreeWAD();
 140 begin
 141   if fIter <> nil then FreeAndNil(fIter);
 142   //if fFileName <> '' then e_WriteLog(Format('TWADFile.ReadFile: [%s] closed', [fFileName]), MSG_NOTIFY);
 143   fFileName := '';
 144 end;
 145
 146
 147 function removeExt (s: AnsiString): AnsiString;
 148 var
 149   i: Integer;
 150 begin
 151   i := length(s)+1;
 152   while (i > 1) and (s[i-1] <> '.') and (s[i-1] <> '/') do Dec(i);
 153   if (i > 1) and (s[i-1] = '.') then
 154   begin
 155     //writeln('[', s, '] -> [', Copy(s, 1, i-2), ']');
 156     s := Copy(s, 1, i-2);
 157   end;
 158   result := s;
 159 end;
 160
 161 function TWADFile.GetResource (Section, Resource: AnsiString; var pData: Pointer; var Len: Integer): Boolean;
 162 var
 163   f: Integer;
 164   fi: TSFSFileInfo;
 165   fs: TStream;
 166   fpp: Pointer;
 167   //fn: AnsiString;
 168 begin
 169   Result := False;
 170   if not isOpen or (fIter = nil) then Exit;
 171   if length(Resource) = 0 then Exit; // just in case
 172   if (length(Section) <> 0) and (Section[length(Section)] <> '/') then Section := Section+'/';
 173   // backwards, due to possible similar names and such
 174   for f := fIter.Count-1 downto 0 do
 175   begin
 176     fi := fIter.Files[f];
 177     if fi = nil then continue;
 178     //e_WriteLog(Format('DFWAD: searching for [%s : %s] in [%s]; current is [%s : %s]', [Section, Resource, fFileName, fi.path, fi.name]), MSG_NOTIFY);
 179     if StrEquCI1251(fi.path, Section) and StrEquCI1251(removeExt(fi.name), Resource) then
 180     begin
 181       // i found her!
 182       //fn := fFileName+'::'+fi.path+fi.name;
 183       //fs := SFSFileOpen(fn);
 184       try
 185         fs := fIter.volume.OpenFileByIndex(f);
 186       except
 187         fs := nil;
 188       end;
 189       if fs = nil then
 190       begin
 191         e_WriteLog(Format('DFWAD: can''t open file [%s%s] in [%s]', [Section, Resource, fFileName]), MSG_WARNING);
 192         break;
 193       end;
 194       Len := Integer(fs.size);
 195       GetMem(pData, Len);
 196       fpp := pData;
 197       try
 198         fs.ReadBuffer(pData^, Len);
 199         fpp := nil;
 200       finally
 201         if fpp <> nil then
 202         begin
 203           FreeMem(fpp);
 204           pData := nil;
 205           Len := 0;
 206         end;
 207         fs.Free;
 208       end;
 209       result := true;
 210       {$IFDEF SFS_DWFAD_DEBUG}
 211       if gSFSDebug then
 212         e_WriteLog(Format('DFWAD: file [%s%s] FOUND in [%s]; size is %d bytes', [Section, Resource, fFileName, Len]), MSG_NOTIFY);
 213       {$ENDIF}
 214       exit;
 215     end;
 216   end;
 217   e_WriteLog(Format('DFWAD: file [%s%s] not found in [%s]', [Section, Resource, fFileName]), MSG_WARNING);
 218 end;
 219
 220
 221 function TWADFile.GetResourcesList (Section: AnsiString): SArray;
 222 var
 223   f: Integer;
 224   fi: TSFSFileInfo;
 225 begin
 226   Result := nil;
 227   if not isOpen or (fIter = nil) then Exit;
 228   if (length(Section) <> 0) and (Section[length(Section)] <> '/') then Section := Section+'/';
 229   for f := 0 to fIter.Count-1 do
 230   begin
 231     fi := fIter.Files[f];
 232     if fi = nil then continue;
 233     if length(fi.name) = 0 then continue;
 234     if StrEquCI1251(fi.path, Section) then
 235     begin
 236       SetLength(result, Length(result)+1);
 237       result[high(result)] := removeExt(fi.name);
 238     end;
 239   end;
 240 end;
 241
 242
 243 function TWADFile.ReadFile (FileName: AnsiString): Boolean;
 244 var
 245   rfn: AnsiString;
 246   //f: Integer;
 247   //fi: TSFSFileInfo;
 248 begin
 249   Result := False;
 250   //e_WriteLog(Format('TWADFile.ReadFile: [%s]', [FileName]), MSG_NOTIFY);
 251   FreeWAD();
 252   rfn := findDiskWad(FileName);
 253   if length(rfn) = 0 then
 254   begin
 255     e_WriteLog(Format('TWADFile.ReadFile: error looking for [%s]', [FileName]), MSG_NOTIFY);
 256     exit;
 257   end;
 258   {$IFDEF SFS_DWFAD_DEBUG}
 259   if gSFSDebug then e_WriteLog(Format('TWADFile.ReadFile: FOUND [%s]', [rfn]), MSG_NOTIFY);
 260   {$ENDIF}
 261   // cache this wad
 262   try
 263     if gSFSFastMode then
 264     begin
 265       if not SFSAddDataFile(rfn, true) then exit;
 266     end
 267     else
 268     begin
 269       if not SFSAddDataFileTemp(rfn, true) then exit;
 270     end;
 271   except
 272     exit;
 273   end;
 274   fIter := SFSFileList(rfn);
 275   if fIter = nil then Exit;
 276   fFileName := rfn;
 277   {$IFDEF SFS_DWFAD_DEBUG}
 278   if gSFSDebug then e_WriteLog(Format('TWADFile.ReadFile: [%s] opened', [fFileName]), MSG_NOTIFY);
 279   {$ENDIF}
 280   Result := True;
 281 end;
 282
 283
 284 var
 285   uniqueCounter: Integer = 0;
 286
 287 function TWADFile.ReadMemory (Data: Pointer; Len: LongWord): Boolean;
 288 var
 289   fn: AnsiString;
 290   st: TStream = nil;
 291   //f: Integer;
 292   //fi: TSFSFileInfo;
 293 begin
 294   Result := False;
 295   FreeWAD();
 296   if (Data = nil) or (Len = 0) then
 297   begin
 298     e_WriteLog('TWADFile.ReadMemory: EMPTY SUBWAD!', MSG_WARNING);
 299     Exit;
 300   end;
 301
 302   fn := Format(' -- memwad %d -- ', [uniqueCounter]);
 303   Inc(uniqueCounter);
 304   {$IFDEF SFS_DWFAD_DEBUG}
 305     e_WriteLog(Format('TWADFile.ReadMemory: [%s]', [fn]), MSG_NOTIFY);
 306   {$ENDIF}
 307
 308   try
 309     st := TSFSMemoryStreamRO.Create(Data, Len);
 310     if not SFSAddSubDataFile(fn, st, true) then
 311     begin
 312       st.Free;
 313       Exit;
 314     end;
 315   except
 316     st.Free;
 317     Exit;
 318   end;
 319
 320   fIter := SFSFileList(fn);
 321   if fIter = nil then Exit;
 322
 323   fFileName := fn;
 324   {$IFDEF SFS_DWFAD_DEBUG}
 325     e_WriteLog(Format('TWADFile.ReadMemory: [%s] opened', [fFileName]), MSG_NOTIFY);
 326   {$ENDIF}
 327
 328   {
 329   for f := 0 to fIter.Count-1 do
 330   begin
 331     fi := fIter.Files[f];
 332     if fi = nil then continue;
 333     st := fIter.volume.OpenFileByIndex(f);
 334     if st = nil then
 335     begin
 336       e_WriteLog(Format('[%s]: [%s : %s] CAN''T OPEN', [fFileName, fi.path, fi.name]), MSG_NOTIFY);
 337     end
 338     else
 339     begin
 340       e_WriteLog(Format('[%s]: [%s : %s] %u', [fFileName, fi.path, fi.name, st.size]), MSG_NOTIFY);
 341       st.Free;
 342     end;
 343   end;
 344   //fIter.volume.OpenFileByIndex(0);
 345   }
 346
 347   Result := True;
 348 end;
 349
 350
 351 begin
 352   sfsDiskDirs := '<exedir>/data'; //FIXME
 353 end.