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
  31     function GetResource (name: AnsiString; var pData: Pointer; var Len: Integer): Boolean;
  32     function GetRootResources (): SArray;
  33
  34     property isOpen: Boolean read getIsOpen;
  35   end;
  36
  37
  38 function g_ExtractWadName (resourceStr: AnsiString): AnsiString;
  39 function g_ExtractWadNameNoPath (resourceStr: AnsiString): AnsiString;
  40 function g_ExtractFilePath (resourceStr: AnsiString): AnsiString;
  41 function g_ExtractFileName (resourceStr: AnsiString): AnsiString; // without path
  42 function g_ExtractFilePathName (resourceStr: AnsiString): AnsiString;
  43
  44 // return fixed AnsiString or empty AnsiString
  45 function findDiskWad (fname: AnsiString): AnsiString;
  46
  47
  48 implementation
  49
  50 uses
  51   SysUtils, Classes, BinEditor, e_log, g_options, utils;
  52
  53
  54 function findDiskWad (fname: AnsiString): AnsiString;
  55 begin
  56   result := '';
  57   if not findFileCI(fname) then
  58   begin
  59     //e_WriteLog(Format('findDiskWad: error looking for [%s]', [fname]), MSG_NOTIFY);
  60     if StrEquCI1251(ExtractFileExt(fname), '.wad') then
  61     begin
  62       fname := ChangeFileExt(fname, '.pk3');
  63       //e_WriteLog(Format('  looking for [%s]', [fname]), MSG_NOTIFY);
  64       if not findFileCI(fname) then
  65       begin
  66         fname := ChangeFileExt(fname, '.zip');
  67         //e_WriteLog(Format('  looking for [%s]', [fname]), MSG_NOTIFY);
  68         if not findFileCI(fname) then exit;
  69       end;
  70     end
  71     else
  72     begin
  73       exit;
  74     end;
  75   end;
  76   //e_WriteLog(Format('findDiskWad: FOUND [%s]', [fname]), MSG_NOTIFY);
  77   result := fname;
  78 end;
  79
  80
  81 function normSlashes (s: AnsiString): AnsiString;
  82 var
  83   f: Integer;
  84 begin
  85   for f := 1 to length(s) do if s[f] = '\' then s[f] := '/';
  86   result := s;
  87 end;
  88
  89 function g_ExtractWadNameNoPath (resourceStr: AnsiString): AnsiString;
  90 var
  91   f, c: Integer;
  92 begin
  93   for f := length(resourceStr) downto 1 do
  94   begin
  95     if resourceStr[f] = ':' then
  96     begin
  97       result := normSlashes(Copy(resourceStr, 1, f-1));
  98       c := length(result);
  99       while (c > 0) and (result[c] <> '/') do Dec(c);
 100       if c > 0 then result := Copy(result, c+1, length(result));
 101       exit;
 102     end;
 103   end;
 104   result := '';
 105 end;
 106
 107 function g_ExtractWadName (resourceStr: AnsiString): AnsiString;
 108 var
 109   f: Integer;
 110 begin
 111   for f := length(resourceStr) downto 1 do
 112   begin
 113     if resourceStr[f] = ':' then
 114     begin
 115       result := normSlashes(Copy(resourceStr, 1, f-1));
 116       exit;
 117     end;
 118   end;
 119   result := '';
 120 end;
 121
 122 function g_ExtractFilePath (resourceStr: AnsiString): AnsiString;
 123 var
 124   f, lastSlash: Integer;
 125 begin
 126   result := '';
 127   lastSlash := -1;
 128   for f := length(resourceStr) downto 1 do
 129   begin
 130     if (lastSlash < 0) and (resourceStr[f] = '\') or (resourceStr[f] = '/') then lastSlash := f;
 131     if resourceStr[f] = ':' then
 132     begin
 133       if lastSlash > 0 then result := normSlashes(Copy(resourceStr, f, lastSlash-f));
 134       exit;
 135     end;
 136   end;
 137   if lastSlash > 0 then result := normSlashes(Copy(resourceStr, 1, lastSlash-1));
 138 end;
 139
 140 function g_ExtractFileName (resourceStr: AnsiString): AnsiString; // without path
 141 var
 142   f, lastSlash: Integer;
 143 begin
 144   result := '';
 145   lastSlash := -1;
 146   for f := length(resourceStr) downto 1 do
 147   begin
 148     if (lastSlash < 0) and (resourceStr[f] = '\') or (resourceStr[f] = '/') then lastSlash := f;
 149     if resourceStr[f] = ':' then
 150     begin
 151       if lastSlash > 0 then result := Copy(resourceStr, lastSlash+1, length(resourceStr));
 152       exit;
 153     end;
 154   end;
 155   if lastSlash > 0 then result := Copy(resourceStr, lastSlash+1, length(resourceStr));
 156 end;
 157
 158 function g_ExtractFilePathName (resourceStr: AnsiString): AnsiString;
 159 var
 160   f: Integer;
 161 begin
 162   result := '';
 163   for f := length(resourceStr) downto 1 do
 164   begin
 165     if resourceStr[f] = ':' then
 166     begin
 167       result := normSlashes(Copy(resourceStr, f+1, length(resourceStr)));
 168       exit;
 169     end;
 170   end;
 171 end;
 172
 173
 174
 175 { TWADFile }
 176 constructor TWADFile.Create();
 177 begin
 178   fFileName := '';
 179 end;
 180
 181
 182 destructor TWADFile.Destroy();
 183 begin
 184   FreeWAD();
 185   inherited;
 186 end;
 187
 188
 189 function TWADFile.getIsOpen (): Boolean;
 190 begin
 191   result := (fFileName <> '');
 192 end;
 193
 194
 195 procedure TWADFile.FreeWAD();
 196 begin
 197   if fIter <> nil then FreeAndNil(fIter);
 198   //if fFileName <> '' then e_WriteLog(Format('TWADFile.ReadFile: [%s] closed', [fFileName]), MSG_NOTIFY);
 199   fFileName := '';
 200 end;
 201
 202
 203 function removeExt (s: AnsiString): AnsiString;
 204 var
 205   i: Integer;
 206 begin
 207   i := length(s)+1;
 208   while (i > 1) and (s[i-1] <> '.') and (s[i-1] <> '/') do Dec(i);
 209   if (i > 1) and (s[i-1] = '.') then
 210   begin
 211     //writeln('[', s, '] -> [', Copy(s, 1, i-2), ']');
 212     s := Copy(s, 1, i-2);
 213   end;
 214   result := s;
 215 end;
 216
 217 function TWADFile.GetResource (name: AnsiString; var pData: Pointer; var Len: Integer): Boolean;
 218 var
 219   f, lastSlash: Integer;
 220   fi: TSFSFileInfo;
 221   fs: TStream;
 222   fpp: Pointer;
 223   rpath, rname: AnsiString;
 224   //fn: AnsiString;
 225 begin
 226   Result := False;
 227   if not isOpen or (fIter = nil) then Exit;
 228   rname := removeExt(name);
 229   if length(rname) = 0 then Exit; // just in case
 230   lastSlash := -1;
 231   for f := 1 to length(rname) do
 232   begin
 233     if rname[f] = '\' then rname[f] := '/';
 234     if rname[f] = '/' then lastSlash := f;
 235   end;
 236   if lastSlash > 0 then
 237   begin
 238     rpath := Copy(rname, 1, lastSlash);
 239     Delete(rname, 1, lastSlash);
 240   end
 241   else
 242   begin
 243     rpath := '';
 244   end;
 245   // backwards, due to possible similar names and such
 246   for f := fIter.Count-1 downto 0 do
 247   begin
 248     fi := fIter.Files[f];
 249     if fi = nil then continue;
 250     //e_WriteLog(Format('DFWAD: searching for [%s : %s] in [%s]; current is [%s : %s]', [Section, Resource, fFileName, fi.path, fi.name]), MSG_NOTIFY);
 251     if StrEquCI1251(fi.path, rpath) and StrEquCI1251(removeExt(fi.name), rname) then
 252     begin
 253       // i found her!
 254       //fn := fFileName+'::'+fi.path+fi.name;
 255       //fs := SFSFileOpen(fn);
 256       try
 257         fs := fIter.volume.OpenFileByIndex(f);
 258       except
 259         fs := nil;
 260       end;
 261       if fs = nil then
 262       begin
 263         e_WriteLog(Format('DFWAD: can''t open file [%s] in [%s]', [name, fFileName]), MSG_WARNING);
 264         break;
 265       end;
 266       Len := Integer(fs.size);
 267       GetMem(pData, Len);
 268       fpp := pData;
 269       try
 270         fs.ReadBuffer(pData^, Len);
 271         fpp := nil;
 272       finally
 273         if fpp <> nil then
 274         begin
 275           FreeMem(fpp);
 276           pData := nil;
 277           Len := 0;
 278         end;
 279         fs.Free;
 280       end;
 281       result := true;
 282       {$IFDEF SFS_DWFAD_DEBUG}
 283       if gSFSDebug then
 284         e_WriteLog(Format('DFWAD: file [%s] FOUND in [%s]; size is %d bytes', [name, fFileName, Len]), MSG_NOTIFY);
 285       {$ENDIF}
 286       exit;
 287     end;
 288   end;
 289   e_WriteLog(Format('DFWAD: file [%s] not found in [%s]', [name, fFileName]), MSG_WARNING);
 290 end;
 291
 292
 293 function TWADFile.GetRootResources (): SArray;
 294 var
 295   f: Integer;
 296   fi: TSFSFileInfo;
 297 begin
 298   Result := nil;
 299   if not isOpen or (fIter = nil) then Exit;
 300   for f := 0 to fIter.Count-1 do
 301   begin
 302     fi := fIter.Files[f];
 303     if fi = nil then continue;
 304     if length(fi.name) = 0 then continue;
 305     if length(fi.path) = 0 then
 306     begin
 307       SetLength(result, Length(result)+1);
 308       result[high(result)] := removeExt(fi.name);
 309     end;
 310   end;
 311 end;
 312
 313
 314 function TWADFile.ReadFile (FileName: AnsiString): Boolean;
 315 var
 316   rfn: AnsiString;
 317   //f: Integer;
 318   //fi: TSFSFileInfo;
 319 begin
 320   Result := False;
 321   //e_WriteLog(Format('TWADFile.ReadFile: [%s]', [FileName]), MSG_NOTIFY);
 322   FreeWAD();
 323   rfn := findDiskWad(FileName);
 324   if length(rfn) = 0 then
 325   begin
 326     e_WriteLog(Format('TWADFile.ReadFile: error looking for [%s]', [FileName]), MSG_NOTIFY);
 327     exit;
 328   end;
 329   {$IFDEF SFS_DWFAD_DEBUG}
 330   if gSFSDebug then e_WriteLog(Format('TWADFile.ReadFile: FOUND [%s]', [rfn]), MSG_NOTIFY);
 331   {$ENDIF}
 332   // cache this wad
 333   try
 334     if gSFSFastMode then
 335     begin
 336       if not SFSAddDataFile(rfn, true) then exit;
 337     end
 338     else
 339     begin
 340       if not SFSAddDataFileTemp(rfn, true) then exit;
 341     end;
 342   except
 343     exit;
 344   end;
 345   fIter := SFSFileList(rfn);
 346   if fIter = nil then Exit;
 347   fFileName := rfn;
 348   {$IFDEF SFS_DWFAD_DEBUG}
 349   if gSFSDebug then e_WriteLog(Format('TWADFile.ReadFile: [%s] opened', [fFileName]), MSG_NOTIFY);
 350   {$ENDIF}
 351   Result := True;
 352 end;
 353
 354
 355 var
 356   uniqueCounter: Integer = 0;
 357
 358 function TWADFile.ReadMemory (Data: Pointer; Len: LongWord): Boolean;
 359 var
 360   fn: AnsiString;
 361   st: TStream = nil;
 362   //f: Integer;
 363   //fi: TSFSFileInfo;
 364 begin
 365   Result := False;
 366   FreeWAD();
 367   if (Data = nil) or (Len = 0) then
 368   begin
 369     e_WriteLog('TWADFile.ReadMemory: EMPTY SUBWAD!', MSG_WARNING);
 370     Exit;
 371   end;
 372
 373   fn := Format(' -- memwad %d -- ', [uniqueCounter]);
 374   Inc(uniqueCounter);
 375   {$IFDEF SFS_DWFAD_DEBUG}
 376     e_WriteLog(Format('TWADFile.ReadMemory: [%s]', [fn]), MSG_NOTIFY);
 377   {$ENDIF}
 378
 379   try
 380     st := TSFSMemoryStreamRO.Create(Data, Len);
 381     if not SFSAddSubDataFile(fn, st, true) then
 382     begin
 383       st.Free;
 384       Exit;
 385     end;
 386   except
 387     st.Free;
 388     Exit;
 389   end;
 390
 391   fIter := SFSFileList(fn);
 392   if fIter = nil then Exit;
 393
 394   fFileName := fn;
 395   {$IFDEF SFS_DWFAD_DEBUG}
 396     e_WriteLog(Format('TWADFile.ReadMemory: [%s] opened', [fFileName]), MSG_NOTIFY);
 397   {$ENDIF}
 398
 399   {
 400   for f := 0 to fIter.Count-1 do
 401   begin
 402     fi := fIter.Files[f];
 403     if fi = nil then continue;
 404     st := fIter.volume.OpenFileByIndex(f);
 405     if st = nil then
 406     begin
 407       e_WriteLog(Format('[%s]: [%s : %s] CAN''T OPEN', [fFileName, fi.path, fi.name]), MSG_NOTIFY);
 408     end
 409     else
 410     begin
 411       e_WriteLog(Format('[%s]: [%s : %s] %u', [fFileName, fi.path, fi.name, st.size]), MSG_NOTIFY);
 412       st.Free;
 413     end;
 414   end;
 415   //fIter.volume.OpenFileByIndex(0);
 416   }
 417
 418   Result := True;
 419 end;
 420
 421
 422 begin
 423   sfsDiskDirs := '<exedir>/data'; //FIXME
 424 end.