DEADSOFTWARE

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