src/shared/wadreader.pas

   1 {$MODE DELPHI}
   2 unit wadreader;
   3
   4 {$DEFINE SFS_DWFAD_DEBUG}
   5 {$DEFINE SFS_MAPDETECT_FX}
   6
   7 interface
   8
   9 uses
  10   sfs, xstreams;
  11
  12
  13 type
  14   SArray = array of ShortString;
  15
  16   TWADFile = class(TObject)
  17   private
  18     fFileName: AnsiString; // empty: not opened
  19     fIter: TSFSFileList;
  20
  21     function getIsOpen (): Boolean;
  22     function isMapResource (idx: Integer): Boolean;
  23
  24     function GetResourceEx (name: AnsiString; wantMap: Boolean; var pData: Pointer; var Len: Integer): Boolean;
  25
  26    public
  27     constructor Create();
  28     destructor Destroy(); override;
  29
  30     procedure FreeWAD();
  31
  32     function ReadFile (FileName: AnsiString): Boolean;
  33     function ReadMemory (Data: Pointer; Len: LongWord): Boolean;
  34
  35     function GetResource (name: AnsiString; var pData: Pointer; var Len: Integer): Boolean;
  36     function GetMapResource (name: AnsiString; var pData: Pointer; var Len: Integer): Boolean;
  37     function GetMapResources (): SArray;
  38
  39     property isOpen: Boolean read getIsOpen;
  40   end;
  41
  42
  43 function g_ExtractWadName (resourceStr: AnsiString): AnsiString;
  44 function g_ExtractWadNameNoPath (resourceStr: AnsiString): AnsiString;
  45 function g_ExtractFilePath (resourceStr: AnsiString): AnsiString;
  46 function g_ExtractFileName (resourceStr: AnsiString): AnsiString; // without path
  47 function g_ExtractFilePathName (resourceStr: AnsiString): AnsiString;
  48
  49 // return fixed AnsiString or empty AnsiString
  50 function findDiskWad (fname: AnsiString): AnsiString;
  51
  52
  53 implementation
  54
  55 uses
  56   SysUtils, Classes, BinEditor, e_log, g_options, utils, MAPSTRUCT;
  57
  58
  59 function findDiskWad (fname: AnsiString): AnsiString;
  60 begin
  61   result := '';
  62   if not findFileCI(fname) then
  63   begin
  64     //e_WriteLog(Format('findDiskWad: error looking for [%s]', [fname]), MSG_NOTIFY);
  65     if StrEquCI1251(ExtractFileExt(fname), '.wad') then
  66     begin
  67       fname := ChangeFileExt(fname, '.pk3');
  68       //e_WriteLog(Format('  looking for [%s]', [fname]), MSG_NOTIFY);
  69       if not findFileCI(fname) then
  70       begin
  71         fname := ChangeFileExt(fname, '.zip');
  72         //e_WriteLog(Format('  looking for [%s]', [fname]), MSG_NOTIFY);
  73         if not findFileCI(fname) then exit;
  74       end;
  75     end
  76     else
  77     begin
  78       exit;
  79     end;
  80   end;
  81   //e_WriteLog(Format('findDiskWad: FOUND [%s]', [fname]), MSG_NOTIFY);
  82   result := fname;
  83 end;
  84
  85
  86 function normSlashes (s: AnsiString): AnsiString;
  87 var
  88   f: Integer;
  89 begin
  90   for f := 1 to length(s) do if s[f] = '\' then s[f] := '/';
  91   result := s;
  92 end;
  93
  94 function g_ExtractWadNameNoPath (resourceStr: AnsiString): AnsiString;
  95 var
  96   f, c: Integer;
  97 begin
  98   for f := length(resourceStr) downto 1 do
  99   begin
 100     if resourceStr[f] = ':' then
 101     begin
 102       result := normSlashes(Copy(resourceStr, 1, f-1));
 103       c := length(result);
 104       while (c > 0) and (result[c] <> '/') do Dec(c);
 105       if c > 0 then result := Copy(result, c+1, length(result));
 106       exit;
 107     end;
 108   end;
 109   result := '';
 110 end;
 111
 112 function g_ExtractWadName (resourceStr: AnsiString): AnsiString;
 113 var
 114   f: Integer;
 115 begin
 116   for f := length(resourceStr) downto 1 do
 117   begin
 118     if resourceStr[f] = ':' then
 119     begin
 120       result := normSlashes(Copy(resourceStr, 1, f-1));
 121       exit;
 122     end;
 123   end;
 124   result := '';
 125 end;
 126
 127 function g_ExtractFilePath (resourceStr: AnsiString): AnsiString;
 128 var
 129   f, lastSlash: Integer;
 130 begin
 131   result := '';
 132   lastSlash := -1;
 133   for f := length(resourceStr) downto 1 do
 134   begin
 135     if (lastSlash < 0) and (resourceStr[f] = '\') or (resourceStr[f] = '/') then lastSlash := f;
 136     if resourceStr[f] = ':' then
 137     begin
 138       if lastSlash > 0 then result := normSlashes(Copy(resourceStr, f, lastSlash-f));
 139       exit;
 140     end;
 141   end;
 142   if lastSlash > 0 then result := normSlashes(Copy(resourceStr, 1, lastSlash-1));
 143 end;
 144
 145 function g_ExtractFileName (resourceStr: AnsiString): AnsiString; // without path
 146 var
 147   f, lastSlash: Integer;
 148 begin
 149   result := '';
 150   lastSlash := -1;
 151   for f := length(resourceStr) downto 1 do
 152   begin
 153     if (lastSlash < 0) and (resourceStr[f] = '\') or (resourceStr[f] = '/') then lastSlash := f;
 154     if resourceStr[f] = ':' then
 155     begin
 156       if lastSlash > 0 then result := Copy(resourceStr, lastSlash+1, length(resourceStr));
 157       exit;
 158     end;
 159   end;
 160   if lastSlash > 0 then result := Copy(resourceStr, lastSlash+1, length(resourceStr));
 161 end;
 162
 163 function g_ExtractFilePathName (resourceStr: AnsiString): AnsiString;
 164 var
 165   f: Integer;
 166 begin
 167   result := '';
 168   for f := length(resourceStr) downto 1 do
 169   begin
 170     if resourceStr[f] = ':' then
 171     begin
 172       result := normSlashes(Copy(resourceStr, f+1, length(resourceStr)));
 173       exit;
 174     end;
 175   end;
 176 end;
 177
 178
 179
 180 { TWADFile }
 181 constructor TWADFile.Create();
 182 begin
 183   fFileName := '';
 184 end;
 185
 186
 187 destructor TWADFile.Destroy();
 188 begin
 189   FreeWAD();
 190   inherited;
 191 end;
 192
 193
 194 function TWADFile.getIsOpen (): Boolean;
 195 begin
 196   result := (fFileName <> '');
 197 end;
 198
 199
 200 procedure TWADFile.FreeWAD();
 201 begin
 202   if fIter <> nil then FreeAndNil(fIter);
 203   //if fFileName <> '' then e_WriteLog(Format('TWADFile.ReadFile: [%s] closed', [fFileName]), MSG_NOTIFY);
 204   fFileName := '';
 205 end;
 206
 207 function TWADFile.isMapResource (idx: Integer): Boolean;
 208 var
 209   sign: packed array [0..2] of Char;
 210   fs: TStream;
 211 begin
 212   result := false;
 213   if not isOpen or (fIter = nil) then exit;
 214   if (idx < 0) or (idx >= fIter.Count) then exit;
 215   fs := nil;
 216   try
 217     fs := fIter.volume.OpenFileByIndex(idx);
 218     fs.readBuffer(sign, 3);
 219     result := (sign = MAP_SIGNATURE);
 220   except
 221     if fs <> nil then fs.Free();
 222     exit;
 223   end;
 224   fs.Free();
 225 end;
 226
 227 function removeExt (s: AnsiString): AnsiString;
 228 var
 229   i: Integer;
 230 begin
 231   i := length(s)+1;
 232   while (i > 1) and (s[i-1] <> '.') and (s[i-1] <> '/') do Dec(i);
 233   if (i > 1) and (s[i-1] = '.') then
 234   begin
 235     //writeln('[', s, '] -> [', Copy(s, 1, i-2), ']');
 236     s := Copy(s, 1, i-2);
 237   end;
 238   result := s;
 239 end;
 240
 241 function TWADFile.GetResourceEx (name: AnsiString; wantMap: Boolean; var pData: Pointer; var Len: Integer): Boolean;
 242 var
 243   f, lastSlash: Integer;
 244   fi: TSFSFileInfo;
 245   fs: TStream;
 246   fpp: Pointer;
 247   rpath, rname: AnsiString;
 248   sign: array [0..2] of Char;
 249   goodMap: Boolean;
 250 begin
 251   Result := False;
 252   if not isOpen or (fIter = nil) then Exit;
 253   rname := removeExt(name);
 254   if length(rname) = 0 then Exit; // just in case
 255   lastSlash := -1;
 256   for f := 1 to length(rname) do
 257   begin
 258     if rname[f] = '\' then rname[f] := '/';
 259     if rname[f] = '/' then lastSlash := f;
 260   end;
 261   if lastSlash > 0 then
 262   begin
 263     rpath := Copy(rname, 1, lastSlash);
 264     Delete(rname, 1, lastSlash);
 265   end
 266   else
 267   begin
 268     rpath := '';
 269   end;
 270   // backwards, due to possible similar names and such
 271   for f := fIter.Count-1 downto 0 do
 272   begin
 273     fi := fIter.Files[f];
 274     if fi = nil then continue;
 275     if StrEquCI1251(removeExt(fi.name), rname) then
 276     begin
 277       // i found her (maybe)
 278       if not wantMap then
 279       begin
 280         if length(fi.path) < length(rpath) then continue; // alas
 281         if length(fi.path) = length(rpath) then
 282         begin
 283           if not StrEquCI1251(fi.path, rpath) then continue; // alas
 284         end
 285         else
 286         begin
 287           if fi.path[length(fi.path)-length(rpath)] <> '/' then continue; // alas
 288           if not StrEquCI1251(Copy(fi.path, length(fi.path)+1-length(rpath), length(fi.path)), rpath) then continue; // alas
 289         end;
 290       end;
 291       try
 292         fs := fIter.volume.OpenFileByIndex(f);
 293       except
 294         fs := nil;
 295       end;
 296       if fs = nil then
 297       begin
 298         if wantMap then continue;
 299         e_WriteLog(Format('DFWAD: can''t open file [%s] in [%s]', [name, fFileName]), MSG_WARNING);
 300         break;
 301       end;
 302       // if we want only maps, check if this is map
 303 {$IFDEF SFS_MAPDETECT_FX}
 304       if wantMap then
 305       begin
 306         goodMap := false;
 307         //e_WriteLog(Format('DFWAD: checking for good map in wad [%s], file [%s] (#%d)', [fFileName, fi.fname, f]), MSG_NOTIFY);
 308         try
 309           fs.readBuffer(sign, 3);
 310           goodMap := (sign = MAP_SIGNATURE);
 311           {
 312           if goodMap then
 313             e_WriteLog(Format('  GOOD map in wad [%s], file [%s] (#%d)', [fFileName, fi.fname, f]), MSG_NOTIFY)
 314           else
 315             e_WriteLog(Format('  BAD map in wad [%s], file [%s] (#%d)', [fFileName, fi.fname, f]), MSG_NOTIFY);
 316           }
 317         except
 318         end;
 319         if not goodMap then
 320         begin
 321           //e_WriteLog(Format('  not a map in wad [%s], file [%s] (#%d)', [fFileName, fi.fname, f]), MSG_NOTIFY);
 322           fs.Free();
 323           continue;
 324         end;
 325         fs.position := 0;
 326       end;
 327 {$ENDIF}
 328       Len := Integer(fs.size);
 329       GetMem(pData, Len);
 330       fpp := pData;
 331       try
 332         fs.ReadBuffer(pData^, Len);
 333         fpp := nil;
 334       finally
 335         if fpp <> nil then
 336         begin
 337           FreeMem(fpp);
 338           pData := nil;
 339           Len := 0;
 340         end;
 341         fs.Free;
 342       end;
 343 {$IFNDEF SFS_MAPDETECT_FX}
 344       if wantMap then
 345       begin
 346         goodMap := false;
 347         if Len >= 3 then
 348         begin
 349           Move(pData^, sign, 3);
 350           goodMap := (sign = MAP_SIGNATURE);
 351         end;
 352         if not goodMap then
 353         begin
 354           //e_WriteLog(Format('  not a map in wad [%s], file [%s] (#%d)', [fFileName, fi.fname, f]), MSG_NOTIFY);
 355           FreeMem(pData);
 356           pData := nil;
 357           Len := 0;
 358           continue;
 359         end;
 360       end;
 361 {$ENDIF}
 362       result := true;
 363       {$IFDEF SFS_DWFAD_DEBUG}
 364       if gSFSDebug then
 365         e_WriteLog(Format('DFWAD: file [%s] FOUND in [%s]; size is %d bytes', [name, fFileName, Len]), MSG_NOTIFY);
 366       {$ENDIF}
 367       exit;
 368     end;
 369   end;
 370   e_WriteLog(Format('DFWAD: file [%s] not found in [%s]', [name, fFileName]), MSG_WARNING);
 371 end;
 372
 373 function TWADFile.GetResource (name: AnsiString; var pData: Pointer; var Len: Integer): Boolean;
 374 begin
 375   result := GetResourceEx(name, false, pData, Len);
 376 end;
 377
 378 function TWADFile.GetMapResource (name: AnsiString; var pData: Pointer; var Len: Integer): Boolean;
 379 begin
 380   result := GetResourceEx(name, true, pData, Len);
 381 end;
 382
 383 function TWADFile.GetMapResources (): SArray;
 384 var
 385   f, c: Integer;
 386   fi: TSFSFileInfo;
 387   s: AnsiString;
 388 begin
 389   Result := nil;
 390   if not isOpen or (fIter = nil) then Exit;
 391   for f := fIter.Count-1 downto 0 do
 392   begin
 393     fi := fIter.Files[f];
 394     if fi = nil then continue;
 395     if length(fi.name) = 0 then continue;
 396     //e_WriteLog(Format('DFWAD: checking for map in wad [%s], file [%s] (#%d)', [fFileName, fi.fname, f]), MSG_NOTIFY);
 397     if isMapResource(f) then
 398     begin
 399       s := removeExt(fi.name);
 400       c := High(result);
 401       while c >= 0 do
 402       begin
 403         if StrEquCI1251(result[c], s) then break;
 404         Dec(c);
 405       end;
 406       if c < 0 then
 407       begin
 408         SetLength(result, Length(result)+1);
 409         result[high(result)] := removeExt(fi.name);
 410       end;
 411     end;
 412   end;
 413 end;
 414
 415
 416 function TWADFile.ReadFile (FileName: AnsiString): Boolean;
 417 var
 418   rfn: AnsiString;
 419   //f: Integer;
 420   //fi: TSFSFileInfo;
 421 begin
 422   Result := False;
 423   //e_WriteLog(Format('TWADFile.ReadFile: [%s]', [FileName]), MSG_NOTIFY);
 424   FreeWAD();
 425   rfn := findDiskWad(FileName);
 426   if length(rfn) = 0 then
 427   begin
 428     e_WriteLog(Format('TWADFile.ReadFile: error looking for [%s]', [FileName]), MSG_NOTIFY);
 429     exit;
 430   end;
 431   {$IFDEF SFS_DWFAD_DEBUG}
 432   if gSFSDebug then e_WriteLog(Format('TWADFile.ReadFile: FOUND [%s]', [rfn]), MSG_NOTIFY);
 433   {$ENDIF}
 434   // cache this wad
 435   try
 436     if gSFSFastMode then
 437     begin
 438       if not SFSAddDataFile(rfn, true) then exit;
 439     end
 440     else
 441     begin
 442       if not SFSAddDataFileTemp(rfn, true) then exit;
 443     end;
 444   except
 445     exit;
 446   end;
 447   fIter := SFSFileList(rfn);
 448   if fIter = nil then Exit;
 449   fFileName := rfn;
 450   {$IFDEF SFS_DWFAD_DEBUG}
 451   if gSFSDebug then e_WriteLog(Format('TWADFile.ReadFile: [%s] opened', [fFileName]), MSG_NOTIFY);
 452   {$ENDIF}
 453   Result := True;
 454 end;
 455
 456
 457 var
 458   uniqueCounter: Integer = 0;
 459
 460 function TWADFile.ReadMemory (Data: Pointer; Len: LongWord): Boolean;
 461 var
 462   fn: AnsiString;
 463   st: TStream = nil;
 464   //f: Integer;
 465   //fi: TSFSFileInfo;
 466 begin
 467   Result := False;
 468   FreeWAD();
 469   if (Data = nil) or (Len = 0) then
 470   begin
 471     e_WriteLog('TWADFile.ReadMemory: EMPTY SUBWAD!', MSG_WARNING);
 472     Exit;
 473   end;
 474
 475   fn := Format(' -- memwad %d -- ', [uniqueCounter]);
 476   Inc(uniqueCounter);
 477   {$IFDEF SFS_DWFAD_DEBUG}
 478     e_WriteLog(Format('TWADFile.ReadMemory: [%s]', [fn]), MSG_NOTIFY);
 479   {$ENDIF}
 480
 481   try
 482     st := TSFSMemoryStreamRO.Create(Data, Len);
 483     if not SFSAddSubDataFile(fn, st, true) then
 484     begin
 485       st.Free;
 486       Exit;
 487     end;
 488   except
 489     st.Free;
 490     Exit;
 491   end;
 492
 493   fIter := SFSFileList(fn);
 494   if fIter = nil then Exit;
 495
 496   fFileName := fn;
 497   {$IFDEF SFS_DWFAD_DEBUG}
 498     e_WriteLog(Format('TWADFile.ReadMemory: [%s] opened', [fFileName]), MSG_NOTIFY);
 499   {$ENDIF}
 500
 501   {
 502   for f := 0 to fIter.Count-1 do
 503   begin
 504     fi := fIter.Files[f];
 505     if fi = nil then continue;
 506     st := fIter.volume.OpenFileByIndex(f);
 507     if st = nil then
 508     begin
 509       e_WriteLog(Format('[%s]: [%s : %s] CAN''T OPEN', [fFileName, fi.path, fi.name]), MSG_NOTIFY);
 510     end
 511     else
 512     begin
 513       e_WriteLog(Format('[%s]: [%s : %s] %u', [fFileName, fi.path, fi.name, st.size]), MSG_NOTIFY);
 514       st.Free;
 515     end;
 516   end;
 517   //fIter.volume.OpenFileByIndex(0);
 518   }
 519
 520   Result := True;
 521 end;
 522
 523
 524 begin
 525   sfsDiskDirs := '<exedir>/data'; //FIXME
 526 end.