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