index 89b242a5958dd719999dc26328a5cba00dd06d2d..85a78356f67bd3e6794c5394d075320b4a011f82 100644 (file)
+{$ASSERTIONS ON}
unit g_resources;
interface
unit g_resources;
interface
+ (**
+ g_GetResourceSection
+ Parse path in form 'path/to/file.wad:some/section/resouce' to
+ wad = 'path/to/file.wad', section = 'some/section', name = 'resource'
+
+ g_DeleteFile
+ Delete file if it exists. Make backup if enabled.
+ return true when file not exists.
+
+ g_ReadResource
+ Read whole file from wad
+ (data <> nil) and (len > 0) when ok
+ use FreeMem(data) when done
+
+ g_ReadSubResource
+ Read whole file from folded wad
+ (data <> nil) and (len > 0) when ok
+ use FreeMem(data) when done
+
+ g_DeleteResource
+ Delete file from wad
+ res = 0 when ok
+
+ g_AddResource
+ Add/overwrite file to wad
+ res = 0 when ok
+
+ g_ExistsResource
+ Check that resource exists
+ res = 0 when ok
+ **)
+
+ (* Editor options *)
+ var
+ Compress: Boolean;
+ Backup: Boolean;
+
+ procedure g_GetResourceSection (path: String; out wad, section, name: String);
+ function g_DeleteFile(wad: String; backupPostfix: String = '.bak'): Boolean;
+
procedure g_ReadResource (wad, section, name: String; out data: PByte; out len: Integer);
procedure g_ReadSubResource (wad, section0, name0, section1, name1: String; out data: PByte; out len: Integer);
procedure g_ReadResource (wad, section, name: String; out data: PByte; out len: Integer);
procedure g_ReadSubResource (wad, section0, name0, section1, name1: String; out data: PByte; out len: Integer);
+ procedure g_DeleteResource (wad, section, name: String; out res: Integer);
+ procedure g_AddResource (wad, section, name: String; const data: PByte; len: Integer; out res: Integer);
+ procedure g_ExistsResource (wad, section, name: String; out res: Integer);
implementation
implementation
- uses sfs, xstreams, utils, Classes;
+ uses sfs, xstreams, dfzip, utils, Classes, SysUtils, WADEDITOR, e_log;
- procedure g_ReadResource (wad, section, name: String; out data: PByte; out len: Integer);
+ function NoTrailing (path: String): String;
+ var i: Integer;
+ begin
+ i := Length(path);
+ while (i > 0) and ((path[i] = '/') or (path[i] = '\')) do dec(i);
+ result := Copy(path, 1, i)
+ end;
+
+ function g_CleanPath (path: String; sys: Boolean = False): String;
+ var i, len: Integer;
+ begin
+ i := 1;
+ result := '';
+ len := Length(path);
+ (* drop separators at the end *)
+ while (len > 1) and ((path[i] = '/') or (path[i] = '\')) do dec(len);
+ while i <= len do
+ begin
+ while (i <= len) and (path[i] <> '/') and (path[i] <> '\') do
+ begin
+ result := result + path[i];
+ inc(i)
+ end;
+ if i <= len then
+ if sys then
+ result := result + DirectorySeparator
+ else
+ result := result + '/';
+ inc(i);
+ while (i <= len) and ((path[i] = '/') or (path[i] = '\')) do inc(i)
+ end;
+ end;
+
+ procedure g_GetResourceSection (path: String; out wad, section, name: String);
+ var i, j, len: Integer;
+ begin
+ len := Length(path);
+ i := len;
+ while (i > 0) and (path[i] <> '/') and (path[i] <> '\') do dec(i);
+ name := Copy(path, i + 1, len);
+ j := i;
+ while (i > 0) and (path[i] <> ':') do dec(i);
+ section := Copy(path, i + 1, j - i - 1);
+ wad := Copy(path, 1, i - 1);
+ end;
+
+ function g_DeleteFile (wad: String; backupPostfix: String = '.bak'): Boolean;
+ var newwad: String; ok: Boolean;
+ begin
+ SFSGCCollect;
+ SFSGCCollect;
+ SFSGCCollect;
+ ok := true;
+ if FileExists(wad) then
+ begin
+ if Backup then
+ begin
+ newwad := wad + backupPostfix;
+ if FileExists(newwad) then ok := DeleteFile(newwad);
+ if ok then ok := RenameFile(wad, newwad);
+ end
+ else
+ ok := DeleteFile(wad);
+ end;
+ result := ok;
+ end;
+
+ procedure g_AddResourceToDFWAD (wad, section, name: String; const data: PByte; len: Integer; out res: Integer);
+ var f: TWADEditor_1;
+ begin
+ res := 1; (* error *)
+ section := utf2win(NoTrailing(section));
+ name := utf2win(name);
+ ASSERT(name <> '');
+ f := TWADEditor_1.Create();
+ if not f.ReadFile(wad) then
+ begin
+ (* do nothing *)
+ end;
+ f.CreateImage;
+ f.RemoveResource(section, name);
+ f.AddResource(data, len, name, section);
+ g_DeleteFile(wad);
+ f.SaveTo(wad);
+ f.Free;
+ res := 0
+ end;
+
+ procedure g_AddResourceToZip (wad, section, name: String; const data: PByte; len: Integer; out res: Integer);
+ var
+ i, n, len0: Integer;
+ data0: PByte;
+ list: TSFSFileList;
+ tmp, path: String;
+ ts: TFileStream;
+ dir: array of TFileInfo;
+ ok: Boolean;
+
+ procedure Add (name: String; data: PByte; len: Integer);
+ var ds: TSFSMemoryChunkStream;
+ begin
+ SetLength(dir, n + 1);
+ ds := TSFSMemoryChunkStream.Create(data, len, False);
+ dir[n] := dfzip.ZipOne(ts, name, ds, Compress);
+ ds.Free;
+ INC(n);
+ end;
+
+ begin
+ res := 1;
+ wad := ExpandFileName(wad);
+ section := utf2win(NoTrailing(section));
+ name := utf2win(name);
+ ASSERT(name <> '');
+ list := SFSFileList(wad);
+ tmp := wad + '.tmp' + IntToStr(Random(100000));
+ ts := TFileStream.Create(tmp, fmCreate);
+ n := 0;
+ SetLength(dir, 0);
+ if list <> nil then
+ begin
+ for i := 0 to list.Count - 1 do
+ begin
+ path := NoTrailing(list.Files[i].path);
+ if (path <> section) or (list.Files[i].name <> name) then
+ begin
+ g_ReadResource(wad, win2utf(path), win2utf(list.Files[i].name), data0, len0);
+ ASSERT(data0 <> nil);
+ if path = '' then
+ path := list.Files[i].name
+ else
+ path := path + '/' + list.Files[i].name;
+ Add(path, data0, len0);
+ FreeMem(data0)
+ end
+ end;
+ list.Destroy
+ end;
+
+ if section = '' then
+ path := name
+ else
+ path := section + '/' + name;
+ Add(path, data, len);
+
+ dfzip.writeCentralDir(ts, dir);
+ ts.Free;
+
+ ok := g_DeleteFile(wad);
+ if not ok then e_WriteLog('Cant delete older wad [' + wad + ']', TRecordCategory.MSG_WARNING);
+ ok := RenameFile(tmp, wad);
+ if not ok then e_WriteLog('ERROR: Cant rename [' + tmp + '] -> [' + wad + ']', TRecordCategory.MSG_WARNING);
+ if ok then res := 0 else res := 2;
+ end;
+
+ procedure g_AddResource (wad, section, name: String; const data: PByte; len: Integer; out res: Integer);
+ var ext: String;
+ begin
+ ASSERT(name <> '');
+ res := 2; (* unknown type *)
+ ext := LowerCase(SysUtils.ExtractFileExt(wad));
+ e_WriteLog('g_AddResource "' + wad + '" "' + section + '" "' + name + '"', MSG_NOTIFY);
+ if ext = '.wad' then
+ g_AddResourceToDFWAD(wad, section, name, data, len, res)
+ else
+ g_AddResourceToZip(wad, section, name, data, len, res)
+ end;
+
+ procedure g_DeleteResourceFromDFWAD (wad, section, name: String; out res: Integer);
+ var f: TWADEditor_1;
+ begin
+ ASSERT(name <> '');
+ res := 1; (* error *)
+ section := utf2win(NoTrailing(section));
+ name := utf2win(name);
+ f := TWADEditor_1.Create;
+ if not f.ReadFile(wad) then
+ begin
+ f.Free;
+ Exit
+ end;
+ f.CreateImage;
+ f.RemoveResource(section, name);
+ g_DeleteFile(wad);
+ f.SaveTo(wad);
+ f.Free;
+ res := 0 (* ok *)
+ end;
+
+ procedure g_DeleteResourceFromZip (wad, section, name: String; out res: Integer);
var
var
- stream: TStream;
- str: String;
- i: Integer;
+ data0: PByte;
+ i, n, len0: Integer;
+ list: TSFSFileList;
+ tmp, path: String;
+ ts: TFileStream;
+ dir: array of TFileInfo;
+ ok: Boolean;
+
+ procedure Add (name: String; data: PByte; len: Integer);
+ var ds: TSFSMemoryChunkStream;
+ begin
+ SetLength(dir, n + 1);
+ ds := TSFSMemoryChunkStream.Create(data, len, False);
+ dir[n] := dfzip.ZipOne(ts, name, ds, Compress);
+ ds.Free;
+ INC(n);
+ end;
+
+ begin
+ res := 1;
+ wad := ExpandFileName(wad);
+ section := utf2win(NoTrailing(section));
+ name := utf2win(name);
+ ASSERT(name <> '');
+ list := SFSFileList(wad);
+ tmp := wad + '.tmp' + IntToStr(Random(100000));
+ ts := TFileStream.Create(tmp, fmCreate);
+ n := 0;
+ SetLength(dir, 0);
+ if list <> nil then
+ begin
+ for i := 0 to list.Count - 1 do
+ begin
+ path := NoTrailing(list.Files[i].path);
+ if (path <> section) or (list.Files[i].name <> name) then
+ begin
+ g_ReadResource(wad, win2utf(path), win2utf(list.Files[i].name), data0, len0);
+ ASSERT(data0 <> nil);
+ if path = '' then
+ path := list.Files[i].name
+ else
+ path := path + '/' + list.Files[i].name;
+ Add(path, data0, len0);
+ FreeMem(data0)
+ end
+ end;
+ list.Destroy
+ end;
+
+ dfzip.writeCentralDir(ts, dir);
+ ts.Free;
+
+ ok := g_DeleteFile(wad);
+ if not ok then e_WriteLog('Cant delete older wad [' + wad + ']', TRecordCategory.MSG_WARNING);
+ ok := RenameFile(tmp, wad);
+ if not ok then e_WriteLog('ERROR: Cant rename [' + tmp + '] -> [' + wad + ']', TRecordCategory.MSG_WARNING);
+ if ok then res := 0 else res := 2;
+ end;
+
+ procedure g_DeleteResource (wad, section, name: String; out res: Integer);
+ var ext: String;
+ begin
+ ASSERT(name <> '');
+ res := 2; (* unknown type *)
+ ext := LowerCase(SysUtils.ExtractFileExt(wad));
+ if ext = '.wad' then
+ g_DeleteResourceFromDFWAD(wad, section, name, res)
+ else
+ g_DeleteResourceFromZip(wad, section, name, res)
+ end;
+
+ procedure g_ExistsResource (wad, section, name: String; out res: Integer);
+ var str: String; stream: TStream;
+ begin
+ res := 1;
+ section := utf2win(NoTrailing(section));
+ name := utf2win(name);
+ ASSERT(name <> '');
+ if SFSAddDataFileTemp(wad, TRUE) then
+ begin
+ str := SFSGetLastVirtualName(section + '\' + name);
+ stream := SFSFileOpen(wad + '::' + str);
+ if stream <> nil then
+ begin
+ res := 0;
+ stream.Destroy
+ end
+ end;
+ SFSGCCollect
+ end;
+
+ procedure g_ReadResource (wad, section, name: String; out data: PByte; out len: Integer);
+ var stream: TStream; str: String; i: Integer;
begin
begin
- section := utf2win(section);
+ e_WriteLog('g_ReadResource: "' + wad + '" "' + section + '" "' + name + '"', MSG_NOTIFY);
+ section := utf2win(NoTrailing(section));
name := utf2win(name);
data := nil;
len := 0;
name := utf2win(name);
data := nil;
len := 0;
+ //ASSERT(name <> '');
+ if name = '' then Exit; (* SKY can be void *)
if SFSAddDataFileTemp(wad, TRUE) then
begin
if SFSAddDataFileTemp(wad, TRUE) then
begin
- str := SFSGetLastVirtualName(section + '\' + name);
+ str := SFSGetLastVirtualName(section + '/' + name);
stream := SFSFileOpen(wad + '::' + str);
if stream <> nil then
begin
len := stream.Size;
GetMem(data, len);
stream := SFSFileOpen(wad + '::' + str);
if stream <> nil then
begin
len := stream.Size;
GetMem(data, len);
+ ASSERT(data <> nil);
//stream.ReadBuffer(data, len); (* leads to segfault *)
for i := 0 to len - 1 do
data[i] := stream.ReadByte();
stream.Destroy
end
end;
//stream.ReadBuffer(data, len); (* leads to segfault *)
for i := 0 to len - 1 do
data[i] := stream.ReadByte();
stream.Destroy
end
end;
+ SFSGCCollect
end;
procedure g_ReadSubResource (wad, section0, name0, section1, name1: String; out data: PByte; out len: Integer);
end;
procedure g_ReadSubResource (wad, section0, name0, section1, name1: String; out data: PByte; out len: Integer);
- var
- stream0, stream1: TStream;
- str0, str1: String;
- xdata: Pointer;
- i, xlen: Integer;
+ var stream0, stream1: TStream; str0, str1: String; i: Integer;
begin
data := nil;
len := 0;
begin
data := nil;
len := 0;
- if (wad = '') OR (section0 = '') OR (name0 = '') OR (section1 = '') OR (name1 = '') then Exit;
- section0 := utf2win(section0);
+ section0 := utf2win(NoTrailing(section0));
name0 := utf2win(name0);
name0 := utf2win(name0);
- section1 := utf2win(section1);
+ section1 := utf2win(NoTrailing(section1));
name1 := utf2win(name1);
name1 := utf2win(name1);
+ //ASSERT(name0 <> '');
+ //ASSERT(name1 <> '');
+ if (wad = '') OR (name0 = '') OR (name1 = '') then Exit; (* ??? *)
if SFSAddDataFileTemp(wad, TRUE) then
begin
str0 := SFSGetLastVirtualName(section0 + '\' + name0);
if SFSAddDataFileTemp(wad, TRUE) then
begin
str0 := SFSGetLastVirtualName(section0 + '\' + name0);
if SFSAddSubDataFile(wad + '\' + str0, stream0, TRUE) then
begin
str1 := SFSGetLastVirtualName(section1 + '\' + name1);
if SFSAddSubDataFile(wad + '\' + str0, stream0, TRUE) then
begin
str1 := SFSGetLastVirtualName(section1 + '\' + name1);
- stream1 := SFSFileOpenEx(wad + '\' + str0 + '::' + str1);
+ stream1 := SFSFileOpen(wad + '\' + str0 + '::' + str1);
if stream1 <> nil then
begin
len := stream1.Size;
GetMem(data, len);
if stream1 <> nil then
begin
len := stream1.Size;
GetMem(data, len);
+ ASSERT(data <> nil);
//stream1.ReadBuffer(data, len); (* leads to segfault *)
for i := 0 to len - 1 do
data[i] := stream1.ReadByte();
stream1.Destroy
//stream1.ReadBuffer(data, len); (* leads to segfault *)
for i := 0 to len - 1 do
data[i] := stream1.ReadByte();
stream1.Destroy
+ //stream0.Destroy (* leads to memory corruption, it destroyed with stream1? *)
+ end
+ else
+ begin
+ stream0.Destroy
end
end
end
end
+ else
+ begin
+ stream0.Destroy
+ end
end
end
- else
- begin
- stream0.Destroy
- end
- end
+ end;
+ SFSGCCollect
end;
end.
end;
end.