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           if goodMap then
 312             e_WriteLog(Format('  GOOD map in wad [%s], file [%s] (#%d)', [fFileName, fi.fname, f]), MSG_NOTIFY)
 313           else
 314             e_WriteLog(Format('  BAD map in wad [%s], file [%s] (#%d)', [fFileName, fi.fname, f]), MSG_NOTIFY);
 315         except
 316         end;
 317         if not goodMap then
 318         begin
 319           e_WriteLog(Format('  not a map in wad [%s], file [%s] (#%d)', [fFileName, fi.fname, f]), MSG_NOTIFY);
 320           fs.Free();
 321           continue;
 322         end;
 323         fs.position := 0;
 324       end;
 325 {$ENDIF}
 326       Len := Integer(fs.size);
 327       GetMem(pData, Len);
 328       fpp := pData;
 329       try
 330         fs.ReadBuffer(pData^, Len);
 331         fpp := nil;
 332       finally
 333         if fpp <> nil then
 334         begin
 335           FreeMem(fpp);
 336           pData := nil;
 337           Len := 0;
 338         end;
 339         fs.Free;
 340       end;
 341 {$IFNDEF SFS_MAPDETECT_FX}
 342       if wantMap then
 343       begin
 344         goodMap := false;
 345         if Len >= 3 then
 346         begin
 347           Move(pData^, sign, 3);
 348           goodMap := (sign = MAP_SIGNATURE);
 349         end;
 350         if not goodMap then
 351         begin
 352           e_WriteLog(Format('  not a map in wad [%s], file [%s] (#%d)', [fFileName, fi.fname, f]), MSG_NOTIFY);
 353           FreeMem(pData);
 354           pData := nil;
 355           Len := 0;
 356           continue;
 357         end;
 358       end;
 359 {$ENDIF}
 360       result := true;
 361       {$IFDEF SFS_DWFAD_DEBUG}
 362       if gSFSDebug then
 363         e_WriteLog(Format('DFWAD: file [%s] FOUND in [%s]; size is %d bytes', [name, fFileName, Len]), MSG_NOTIFY);
 364       {$ENDIF}
 365       exit;
 366     end;
 367   end;
 368   e_WriteLog(Format('DFWAD: file [%s] not found in [%s]', [name, fFileName]), MSG_WARNING);
 369 end;
 370
 371 function TWADFile.GetResource (name: AnsiString; var pData: Pointer; var Len: Integer): Boolean;
 372 begin
 373   result := GetResourceEx(name, false, pData, Len);
 374 end;
 375
 376 function TWADFile.GetMapResource (name: AnsiString; var pData: Pointer; var Len: Integer): Boolean;
 377 begin
 378   result := GetResourceEx(name, true, pData, Len);
 379 end;
 380
 381 function TWADFile.GetMapResources (): SArray;
 382 var
 383   f, c: Integer;
 384   fi: TSFSFileInfo;
 385   s: AnsiString;
 386 begin
 387   Result := nil;
 388   if not isOpen or (fIter = nil) then Exit;
 389   for f := fIter.Count-1 downto 0 do
 390   begin
 391     fi := fIter.Files[f];
 392     if fi = nil then continue;
 393     if length(fi.name) = 0 then continue;
 394     e_WriteLog(Format('DFWAD: checking for map in wad [%s], file [%s] (#%d)', [fFileName, fi.fname, f]), MSG_NOTIFY);
 395     if isMapResource(f) then
 396     begin
 397       s := removeExt(fi.name);
 398       c := High(result);
 399       while c >= 0 do
 400       begin
 401         if StrEquCI1251(result[c], s) then break;
 402         Dec(c);
 403       end;
 404       if c < 0 then
 405       begin
 406         SetLength(result, Length(result)+1);
 407         result[high(result)] := removeExt(fi.name);
 408       end;
 409     end;
 410   end;
 411 end;
 412
 413
 414 function TWADFile.ReadFile (FileName: AnsiString): Boolean;
 415 var
 416   rfn: AnsiString;
 417   //f: Integer;
 418   //fi: TSFSFileInfo;
 419 begin
 420   Result := False;
 421   //e_WriteLog(Format('TWADFile.ReadFile: [%s]', [FileName]), MSG_NOTIFY);
 422   FreeWAD();
 423   rfn := findDiskWad(FileName);
 424   if length(rfn) = 0 then
 425   begin
 426     e_WriteLog(Format('TWADFile.ReadFile: error looking for [%s]', [FileName]), MSG_NOTIFY);
 427     exit;
 428   end;
 429   {$IFDEF SFS_DWFAD_DEBUG}
 430   if gSFSDebug then e_WriteLog(Format('TWADFile.ReadFile: FOUND [%s]', [rfn]), MSG_NOTIFY);
 431   {$ENDIF}
 432   // cache this wad
 433   try
 434     if gSFSFastMode then
 435     begin
 436       if not SFSAddDataFile(rfn, true) then exit;
 437     end
 438     else
 439     begin
 440       if not SFSAddDataFileTemp(rfn, true) then exit;
 441     end;
 442   except
 443     exit;
 444   end;
 445   fIter := SFSFileList(rfn);
 446   if fIter = nil then Exit;
 447   fFileName := rfn;
 448   {$IFDEF SFS_DWFAD_DEBUG}
 449   if gSFSDebug then e_WriteLog(Format('TWADFile.ReadFile: [%s] opened', [fFileName]), MSG_NOTIFY);
 450   {$ENDIF}
 451   Result := True;
 452 end;
 453
 454
 455 var
 456   uniqueCounter: Integer = 0;
 457
 458 function TWADFile.ReadMemory (Data: Pointer; Len: LongWord): Boolean;
 459 var
 460   fn: AnsiString;
 461   st: TStream = nil;
 462   //f: Integer;
 463   //fi: TSFSFileInfo;
 464 begin
 465   Result := False;
 466   FreeWAD();
 467   if (Data = nil) or (Len = 0) then
 468   begin
 469     e_WriteLog('TWADFile.ReadMemory: EMPTY SUBWAD!', MSG_WARNING);
 470     Exit;
 471   end;
 472
 473   fn := Format(' -- memwad %d -- ', [uniqueCounter]);
 474   Inc(uniqueCounter);
 475   {$IFDEF SFS_DWFAD_DEBUG}
 476     e_WriteLog(Format('TWADFile.ReadMemory: [%s]', [fn]), MSG_NOTIFY);
 477   {$ENDIF}
 478
 479   try
 480     st := TSFSMemoryStreamRO.Create(Data, Len);
 481     if not SFSAddSubDataFile(fn, st, true) then
 482     begin
 483       st.Free;
 484       Exit;
 485     end;
 486   except
 487     st.Free;
 488     Exit;
 489   end;
 490
 491   fIter := SFSFileList(fn);
 492   if fIter = nil then Exit;
 493
 494   fFileName := fn;
 495   {$IFDEF SFS_DWFAD_DEBUG}
 496     e_WriteLog(Format('TWADFile.ReadMemory: [%s] opened', [fFileName]), MSG_NOTIFY);
 497   {$ENDIF}
 498
 499   {
 500   for f := 0 to fIter.Count-1 do
 501   begin
 502     fi := fIter.Files[f];
 503     if fi = nil then continue;
 504     st := fIter.volume.OpenFileByIndex(f);
 505     if st = nil then
 506     begin
 507       e_WriteLog(Format('[%s]: [%s : %s] CAN''T OPEN', [fFileName, fi.path, fi.name]), MSG_NOTIFY);
 508     end
 509     else
 510     begin
 511       e_WriteLog(Format('[%s]: [%s : %s] %u', [fFileName, fi.path, fi.name, st.size]), MSG_NOTIFY);
 512       st.Free;
 513     end;
 514   end;
 515   //fIter.volume.OpenFileByIndex(0);
 516   }
 517
 518   Result := True;
 519 end;
 520
 521
 522 begin
 523   sfsDiskDirs := '<exedir>/data'; //FIXME
 524 end.