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