DEADSOFTWARE

GIT / REPO / FRED-BOY
Projects / d2df-editor.git / blob
summary | shortlog | log | commit | commitdiff | tree
history | raw | HEAD
res: fix file rename
[d2df-editor.git] / src / editor / g_resources.pas
1 {$ASSERTIONS ON}
2 unit g_resources;
3
4 interface
5
6 (**
7 g_GetResourceSection
8 Parse path in form 'path/to/file.wad:some/section/resouce' to
9 wad = 'path/to/file.wad', section = 'some/section', name = 'resource'
10
11 g_DeleteFile
12 Delete file if it exists. Make backup if enabled.
13 return true when file not exists.
14
15 g_ReadResource
16 Read whole file from wad
17 (data <> nil) and (len > 0) when ok
18 use FreeMem(data) when done
19
20 g_ReadSubResource
21 Read whole file from folded wad
22 (data <> nil) and (len > 0) when ok
23 use FreeMem(data) when done
24
25 g_DeleteResource
26 Delete file from wad
27 res = 0 when ok
28
29 g_AddResource
30 Add/overwrite file to wad
31 res = 0 when ok
32
33 g_ExistsResource
34 Check that resource exists
35 res = 0 when ok
36 **)
37
38 (* Editor options *)
39 var
40 Compress: Boolean;
41 Backup: Boolean;
42
43 procedure g_GetResourceSection (path: String; out wad, section, name: String);
44 function g_DeleteFile(wad: String; backupPostfix: String = '.bak'): Boolean;
45
46 procedure g_ReadResource (wad, section, name: String; out data: PByte; out len: Integer);
47 procedure g_ReadSubResource (wad, section0, name0, section1, name1: String; out data: PByte; out len: Integer);
48 procedure g_DeleteResource (wad, section, name: String; out res: Integer);
49 procedure g_AddResource (wad, section, name: String; const data: PByte; len: Integer; out res: Integer);
50 procedure g_ExistsResource (wad, section, name: String; out res: Integer);
51
52 implementation
53
54 uses sfs, xstreams, dfzip, utils, Classes, SysUtils, WADEDITOR, e_log;
55
56 function NoTrailing (path: String): String;
57 var i: Integer;
58 begin
59 i := Length(path);
60 while (i > 0) and ((path[i] = '/') or (path[i] = '\')) do dec(i);
61 result := Copy(path, 1, i)
62 end;
63
64 function g_CleanPath (path: String; sys: Boolean = False): String;
65 var i, len: Integer;
66 begin
67 i := 1;
68 result := '';
69 len := Length(path);
70 (* drop separators at the end *)
71 while (len > 1) and ((path[i] = '/') or (path[i] = '\')) do dec(len);
72 while i <= len do
73 begin
74 while (i <= len) and (path[i] <> '/') and (path[i] <> '\') do
75 begin
76 result := result + path[i];
77 inc(i)
78 end;
79 if i <= len then
80 if sys then
81 result := result + DirectorySeparator
82 else
83 result := result + '/';
84 inc(i);
85 while (i <= len) and ((path[i] = '/') or (path[i] = '\')) do inc(i)
86 end;
87 end;
88
89 procedure g_GetResourceSection (path: String; out wad, section, name: String);
90 var i, j, len: Integer;
91 begin
92 len := Length(path);
93 i := len;
94 while (i > 0) and (path[i] <> '/') and (path[i] <> '\') do dec(i);
95 name := Copy(path, i + 1, len);
96 j := i;
97 while (i > 0) and (path[i] <> ':') do dec(i);
98 section := Copy(path, i + 1, j - i - 1);
99 wad := Copy(path, 1, i - 1);
100 end;
101
102 function g_DeleteFile (wad: String; backupPostfix: String = '.bak'): Boolean;
103 var newwad: String; ok: Boolean;
104 begin
105 SFSGCCollect;
106 SFSGCCollect;
107 SFSGCCollect;
108 ok := true;
109 if FileExists(wad) then
110 begin
111 if Backup then
112 begin
113 newwad := wad + backupPostfix;
114 if FileExists(newwad) then ok := DeleteFile(newwad);
115 if ok then ok := RenameFile(wad, newwad);
116 end
117 else
118 ok := DeleteFile(wad);
119 end;
120 result := ok;
121 end;
122
123 procedure g_AddResourceToDFWAD (wad, section, name: String; const data: PByte; len: Integer; out res: Integer);
124 var f: TWADEditor_1;
125 begin
126 res := 1; (* error *)
127 section := utf2win(NoTrailing(section));
128 name := utf2win(name);
129 ASSERT(name <> '');
130 f := TWADEditor_1.Create();
131 if not f.ReadFile(wad) then
132 begin
133 (* do nothing *)
134 end;
135 f.CreateImage;
136 f.RemoveResource(section, name);
137 f.AddResource(data, len, name, section);
138 g_DeleteFile(wad);
139 f.SaveTo(wad);
140 f.Free;
141 res := 0
142 end;
143
144 procedure g_AddResourceToZip (wad, section, name: String; const data: PByte; len: Integer; out res: Integer);
145 var
146 i, n, len0: Integer;
147 data0: PByte;
148 list: TSFSFileList;
149 tmp, path: String;
150 ts: TFileStream;
151 dir: array of TFileInfo;
152 ok: Boolean;
153
154 procedure Add (name: String; data: PByte; len: Integer);
155 var ds: TSFSMemoryChunkStream;
156 begin
157 SetLength(dir, n + 1);
158 ds := TSFSMemoryChunkStream.Create(data, len, False);
159 dir[n] := dfzip.ZipOne(ts, name, ds, Compress);
160 ds.Free;
161 INC(n);
162 end;
163
164 begin
165 res := 1;
166 wad := ExpandFileName(wad);
167 section := utf2win(NoTrailing(section));
168 name := utf2win(name);
169 ASSERT(name <> '');
170 list := SFSFileList(wad);
171 tmp := wad + '.tmp' + IntToStr(Random(100000));
172 ts := TFileStream.Create(tmp, fmCreate);
173 n := 0;
174 SetLength(dir, 0);
175 if list <> nil then
176 begin
177 for i := 0 to list.Count - 1 do
178 begin
179 path := NoTrailing(list.Files[i].path);
180 if (path <> section) or (list.Files[i].name <> name) then
181 begin
182 g_ReadResource(wad, win2utf(path), win2utf(list.Files[i].name), data0, len0);
183 ASSERT(data0 <> nil);
184 if path = '' then
185 path := list.Files[i].name
186 else
187 path := path + '/' + list.Files[i].name;
188 Add(path, data0, len0);
189 FreeMem(data0)
190 end
191 end;
192 list.Destroy
193 end;
194
195 if section = '' then
196 path := name
197 else
198 path := section + '/' + name;
199 Add(path, data, len);
200
201 dfzip.writeCentralDir(ts, dir);
202 ts.Free;
203
204 ok := g_DeleteFile(wad);
205 if not ok then e_WriteLog('Cant delete older wad [' + wad + ']', TRecordCategory.MSG_WARNING);
206 ok := RenameFile(tmp, wad);
207 if not ok then e_WriteLog('ERROR: Cant rename [' + tmp + '] -> [' + wad + ']', TRecordCategory.MSG_WARNING);
208 if ok then res := 0 else res := 2;
209 end;
210
211 procedure g_AddResource (wad, section, name: String; const data: PByte; len: Integer; out res: Integer);
212 var ext: String;
213 begin
214 ASSERT(name <> '');
215 res := 2; (* unknown type *)
216 ext := LowerCase(SysUtils.ExtractFileExt(wad));
217 e_WriteLog('g_AddResource "' + wad + '" "' + section + '" "' + name + '"', MSG_NOTIFY);
218 if ext = '.wad' then
219 g_AddResourceToDFWAD(wad, section, name, data, len, res)
220 else
221 g_AddResourceToZip(wad, section, name, data, len, res)
222 end;
223
224 procedure g_DeleteResourceFromDFWAD (wad, section, name: String; out res: Integer);
225 var f: TWADEditor_1;
226 begin
227 ASSERT(name <> '');
228 res := 1; (* error *)
229 section := utf2win(NoTrailing(section));
230 name := utf2win(name);
231 f := TWADEditor_1.Create;
232 if not f.ReadFile(wad) then
233 begin
234 f.Free;
235 Exit
236 end;
237 f.CreateImage;
238 f.RemoveResource(section, name);
239 g_DeleteFile(wad);
240 f.SaveTo(wad);
241 f.Free;
242 res := 0 (* ok *)
243 end;
244
245 procedure g_DeleteResourceFromZip (wad, section, name: String; out res: Integer);
246 var
247 data0: PByte;
248 i, n, len0: Integer;
249 list: TSFSFileList;
250 tmp, path: String;
251 ts: TFileStream;
252 dir: array of TFileInfo;
253 ok: Boolean;
254
255 procedure Add (name: String; data: PByte; len: Integer);
256 var ds: TSFSMemoryChunkStream;
257 begin
258 SetLength(dir, n + 1);
259 ds := TSFSMemoryChunkStream.Create(data, len, False);
260 dir[n] := dfzip.ZipOne(ts, name, ds, Compress);
261 ds.Free;
262 INC(n);
263 end;
264
265 begin
266 res := 1;
267 wad := ExpandFileName(wad);
268 section := utf2win(NoTrailing(section));
269 name := utf2win(name);
270 ASSERT(name <> '');
271 list := SFSFileList(wad);
272 tmp := wad + '.tmp' + IntToStr(Random(100000));
273 ts := TFileStream.Create(tmp, fmCreate);
274 n := 0;
275 SetLength(dir, 0);
276 if list <> nil then
277 begin
278 for i := 0 to list.Count - 1 do
279 begin
280 path := NoTrailing(list.Files[i].path);
281 if (path <> section) or (list.Files[i].name <> name) then
282 begin
283 g_ReadResource(wad, win2utf(path), win2utf(list.Files[i].name), data0, len0);
284 ASSERT(data0 <> nil);
285 if path = '' then
286 path := list.Files[i].name
287 else
288 path := path + '/' + list.Files[i].name;
289 Add(path, data0, len0);
290 FreeMem(data0)
291 end
292 end;
293 list.Destroy
294 end;
295
296 dfzip.writeCentralDir(ts, dir);
297 ts.Free;
298
299 ok := g_DeleteFile(wad);
300 if not ok then e_WriteLog('Cant delete older wad [' + wad + ']', TRecordCategory.MSG_WARNING);
301 ok := RenameFile(tmp, wad);
302 if not ok then e_WriteLog('ERROR: Cant rename [' + tmp + '] -> [' + wad + ']', TRecordCategory.MSG_WARNING);
303 if ok then res := 0 else res := 2;
304 end;
305
306 procedure g_DeleteResource (wad, section, name: String; out res: Integer);
307 var ext: String;
308 begin
309 ASSERT(name <> '');
310 res := 2; (* unknown type *)
311 ext := LowerCase(SysUtils.ExtractFileExt(wad));
312 if ext = '.wad' then
313 g_DeleteResourceFromDFWAD(wad, section, name, res)
314 else
315 g_DeleteResourceFromZip(wad, section, name, res)
316 end;
317
318 procedure g_ExistsResource (wad, section, name: String; out res: Integer);
319 var str: String; stream: TStream;
320 begin
321 res := 1;
322 section := utf2win(NoTrailing(section));
323 name := utf2win(name);
324 ASSERT(name <> '');
325 if SFSAddDataFileTemp(wad, TRUE) then
326 begin
327 str := SFSGetLastVirtualName(section + '\' + name);
328 stream := SFSFileOpen(wad + '::' + str);
329 if stream <> nil then
330 begin
331 res := 0;
332 stream.Destroy
333 end
334 end;
335 SFSGCCollect
336 end;
337
338 procedure g_ReadResource (wad, section, name: String; out data: PByte; out len: Integer);
339 var stream: TStream; str: String; i: Integer;
340 begin
341 e_WriteLog('g_ReadResource: "' + wad + '" "' + section + '" "' + name + '"', MSG_NOTIFY);
342 section := utf2win(NoTrailing(section));
343 name := utf2win(name);
344 data := nil;
345 len := 0;
346 //ASSERT(name <> '');
347 if name = '' then Exit; (* SKY can be void *)
348 if SFSAddDataFileTemp(wad, TRUE) then
349 begin
350 str := SFSGetLastVirtualName(section + '/' + name);
351 stream := SFSFileOpen(wad + '::' + str);
352 if stream <> nil then
353 begin
354 len := stream.Size;
355 GetMem(data, len);
356 ASSERT(data <> nil);
357 //stream.ReadBuffer(data, len); (* leads to segfault *)
358 for i := 0 to len - 1 do
359 data[i] := stream.ReadByte();
360 stream.Destroy
361 end
362 end;
363 SFSGCCollect
364 end;
365
366 procedure g_ReadSubResource (wad, section0, name0, section1, name1: String; out data: PByte; out len: Integer);
367 var stream0, stream1: TStream; str0, str1: String; i: Integer;
368 begin
369 data := nil;
370 len := 0;
371 section0 := utf2win(NoTrailing(section0));
372 name0 := utf2win(name0);
373 section1 := utf2win(NoTrailing(section1));
374 name1 := utf2win(name1);
375 //ASSERT(name0 <> '');
376 //ASSERT(name1 <> '');
377 if (wad = '') OR (name0 = '') OR (name1 = '') then Exit; (* ??? *)
378 if SFSAddDataFileTemp(wad, TRUE) then
379 begin
380 str0 := SFSGetLastVirtualName(section0 + '\' + name0);
381 stream0 := SFSFileOpen(wad + '::' + str0);
382 if stream0 <> nil then
383 begin
384 if SFSAddSubDataFile(wad + '\' + str0, stream0, TRUE) then
385 begin
386 str1 := SFSGetLastVirtualName(section1 + '\' + name1);
387 stream1 := SFSFileOpen(wad + '\' + str0 + '::' + str1);
388 if stream1 <> nil then
389 begin
390 len := stream1.Size;
391 GetMem(data, len);
392 ASSERT(data <> nil);
393 //stream1.ReadBuffer(data, len); (* leads to segfault *)
394 for i := 0 to len - 1 do
395 data[i] := stream1.ReadByte();
396 stream1.Destroy
397 //stream0.Destroy (* leads to memory corruption, it destroyed with stream1? *)
398 end
399 else
400 begin
401 stream0.Destroy
402 end
403 end
404 else
405 begin
406 stream0.Destroy
407 end
408 end
409 end;
410 SFSGCCollect
411 end;
412
413 end.
[MIRROR] Doom2DF editor ported to FPC/Lazarus
[25/02/2024 19:55:35]
DEADSOFTWARE 2012-2024