85a78356f67bd3e6794c5394d075320b4a011f82
8 Parse path in form 'path/to/file.wad:some/section/resouce' to
9 wad = 'path/to/file.wad', section = 'some/section', name = 'resource'
12 Delete file if it exists. Make backup if enabled.
13 return true when file not exists.
16 Read whole file from wad
17 (data <> nil) and (len > 0) when ok
18 use FreeMem(data) when done
21 Read whole file from folded wad
22 (data <> nil) and (len > 0) when ok
23 use FreeMem(data) when done
30 Add/overwrite file to wad
34 Check that resource exists
43 procedure g_GetResourceSection (path
: String; out wad
, section
, name
: String);
44 function g_DeleteFile(wad
: String; backupPostfix
: String = '.bak'): Boolean;
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);
54 uses sfs
, xstreams
, dfzip
, utils
, Classes
, SysUtils
, WADEDITOR
, e_log
;
56 function NoTrailing (path
: String): String;
60 while (i
> 0) and ((path
[i
] = '/') or (path
[i
] = '\')) do dec(i
);
61 result
:= Copy(path
, 1, i
)
64 function g_CleanPath (path
: String; sys
: Boolean = False): String;
70 (* drop separators at the end *)
71 while (len
> 1) and ((path
[i
] = '/') or (path
[i
] = '\')) do dec(len
);
74 while (i
<= len
) and (path
[i
] <> '/') and (path
[i
] <> '\') do
76 result
:= result
+ path
[i
];
81 result
:= result
+ DirectorySeparator
83 result
:= result
+ '/';
85 while (i
<= len
) and ((path
[i
] = '/') or (path
[i
] = '\')) do inc(i
)
89 procedure g_GetResourceSection (path
: String; out wad
, section
, name
: String);
90 var i
, j
, len
: Integer;
94 while (i
> 0) and (path
[i
] <> '/') and (path
[i
] <> '\') do dec(i
);
95 name
:= Copy(path
, i
+ 1, len
);
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);
102 function g_DeleteFile (wad
: String; backupPostfix
: String = '.bak'): Boolean;
103 var newwad
: String; ok
: Boolean;
109 if FileExists(wad
) then
113 newwad
:= wad
+ backupPostfix
;
114 if FileExists(newwad
) then ok
:= DeleteFile(newwad
);
115 if ok
then ok
:= RenameFile(wad
, newwad
);
118 ok
:= DeleteFile(wad
);
123 procedure g_AddResourceToDFWAD (wad
, section
, name
: String; const data
: PByte; len
: Integer; out res
: Integer);
126 res
:= 1; (* error *)
127 section
:= utf2win(NoTrailing(section
));
128 name
:= utf2win(name
);
130 f
:= TWADEditor_1
.Create();
131 if not f
.ReadFile(wad
) then
136 f
.RemoveResource(section
, name
);
137 f
.AddResource(data
, len
, name
, section
);
144 procedure g_AddResourceToZip (wad
, section
, name
: String; const data
: PByte; len
: Integer; out res
: Integer);
151 dir
: array of TFileInfo
;
154 procedure Add (name
: String; data
: PByte; len
: Integer);
155 var ds
: TSFSMemoryChunkStream
;
157 SetLength(dir
, n
+ 1);
158 ds
:= TSFSMemoryChunkStream
.Create(data
, len
, False);
159 dir
[n
] := dfzip
.ZipOne(ts
, name
, ds
, Compress
);
166 wad
:= ExpandFileName(wad
);
167 section
:= utf2win(NoTrailing(section
));
168 name
:= utf2win(name
);
170 list
:= SFSFileList(wad
);
171 tmp
:= wad
+ '.tmp' + IntToStr(Random(100000));
172 ts
:= TFileStream
.Create(tmp
, fmCreate
);
177 for i
:= 0 to list
.Count
- 1 do
179 path
:= NoTrailing(list
.Files
[i
].path
);
180 if (path
<> section
) or (list
.Files
[i
].name
<> name
) then
182 g_ReadResource(wad
, win2utf(path
), win2utf(list
.Files
[i
].name
), data0
, len0
);
183 ASSERT(data0
<> nil);
185 path
:= list
.Files
[i
].name
187 path
:= path
+ '/' + list
.Files
[i
].name
;
188 Add(path
, data0
, len0
);
198 path
:= section
+ '/' + name
;
199 Add(path
, data
, len
);
201 dfzip
.writeCentralDir(ts
, dir
);
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;
211 procedure g_AddResource (wad
, section
, name
: String; const data
: PByte; len
: Integer; out res
: Integer);
215 res
:= 2; (* unknown type *)
216 ext
:= LowerCase(SysUtils
.ExtractFileExt(wad
));
217 e_WriteLog('g_AddResource "' + wad
+ '" "' + section
+ '" "' + name
+ '"', MSG_NOTIFY
);
219 g_AddResourceToDFWAD(wad
, section
, name
, data
, len
, res
)
221 g_AddResourceToZip(wad
, section
, name
, data
, len
, res
)
224 procedure g_DeleteResourceFromDFWAD (wad
, section
, name
: String; out res
: Integer);
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
238 f
.RemoveResource(section
, name
);
245 procedure g_DeleteResourceFromZip (wad
, section
, name
: String; out res
: Integer);
252 dir
: array of TFileInfo
;
255 procedure Add (name
: String; data
: PByte; len
: Integer);
256 var ds
: TSFSMemoryChunkStream
;
258 SetLength(dir
, n
+ 1);
259 ds
:= TSFSMemoryChunkStream
.Create(data
, len
, False);
260 dir
[n
] := dfzip
.ZipOne(ts
, name
, ds
, Compress
);
267 wad
:= ExpandFileName(wad
);
268 section
:= utf2win(NoTrailing(section
));
269 name
:= utf2win(name
);
271 list
:= SFSFileList(wad
);
272 tmp
:= wad
+ '.tmp' + IntToStr(Random(100000));
273 ts
:= TFileStream
.Create(tmp
, fmCreate
);
278 for i
:= 0 to list
.Count
- 1 do
280 path
:= NoTrailing(list
.Files
[i
].path
);
281 if (path
<> section
) or (list
.Files
[i
].name
<> name
) then
283 g_ReadResource(wad
, win2utf(path
), win2utf(list
.Files
[i
].name
), data0
, len0
);
284 ASSERT(data0
<> nil);
286 path
:= list
.Files
[i
].name
288 path
:= path
+ '/' + list
.Files
[i
].name
;
289 Add(path
, data0
, len0
);
296 dfzip
.writeCentralDir(ts
, dir
);
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;
306 procedure g_DeleteResource (wad
, section
, name
: String; out res
: Integer);
310 res
:= 2; (* unknown type *)
311 ext
:= LowerCase(SysUtils
.ExtractFileExt(wad
));
313 g_DeleteResourceFromDFWAD(wad
, section
, name
, res
)
315 g_DeleteResourceFromZip(wad
, section
, name
, res
)
318 procedure g_ExistsResource (wad
, section
, name
: String; out res
: Integer);
319 var str
: String; stream
: TStream
;
322 section
:= utf2win(NoTrailing(section
));
323 name
:= utf2win(name
);
325 if SFSAddDataFileTemp(wad
, TRUE) then
327 str
:= SFSGetLastVirtualName(section
+ '\' + name
);
328 stream
:= SFSFileOpen(wad
+ '::' + str
);
329 if stream
<> nil then
338 procedure g_ReadResource (wad
, section
, name
: String; out data
: PByte; out len
: Integer);
339 var stream
: TStream
; str
: String; i
: Integer;
341 e_WriteLog('g_ReadResource: "' + wad
+ '" "' + section
+ '" "' + name
+ '"', MSG_NOTIFY
);
342 section
:= utf2win(NoTrailing(section
));
343 name
:= utf2win(name
);
346 //ASSERT(name <> '');
347 if name
= '' then Exit
; (* SKY can be void *)
348 if SFSAddDataFileTemp(wad
, TRUE) then
350 str
:= SFSGetLastVirtualName(section
+ '/' + name
);
351 stream
:= SFSFileOpen(wad
+ '::' + str
);
352 if stream
<> nil then
357 //stream.ReadBuffer(data, len); (* leads to segfault *)
358 for i
:= 0 to len
- 1 do
359 data
[i
] := stream
.ReadByte();
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;
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
380 str0
:= SFSGetLastVirtualName(section0
+ '\' + name0
);
381 stream0
:= SFSFileOpen(wad
+ '::' + str0
);
382 if stream0
<> nil then
384 if SFSAddSubDataFile(wad
+ '\' + str0
, stream0
, TRUE) then
386 str1
:= SFSGetLastVirtualName(section1
+ '\' + name1
);
387 stream1
:= SFSFileOpen(wad
+ '\' + str0
+ '::' + str1
);
388 if stream1
<> nil then
393 //stream1.ReadBuffer(data, len); (* leads to segfault *)
394 for i
:= 0 to len
- 1 do
395 data
[i
] := stream1
.ReadByte();
397 //stream0.Destroy (* leads to memory corruption, it destroyed with stream1? *)