src/shared/wadreader.pas

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