"Fossies" - the Fresh Open Source Software Archive  

Source code changes of the file "list_utils.pas" between
peazip-7.7.0.src.zip and peazip-7.7.1.src.zip

About: PeaZip is an OS-portable graphical file archiver, acting as frontend for various open source archiving utilities (incl. its native Pea archive format).

list_utils.pas  (peazip-7.7.0.src):list_utils.pas  (peazip-7.7.1.src)
skipping to change at line 114 skipping to change at line 114
0.52 20200524 G.Tani Added support for .zstd extension, as used in co mpressed cipo in new rpm installers, 197 extemsions supported 0.52 20200524 G.Tani Added support for .zstd extension, as used in co mpressed cipo in new rpm installers, 197 extemsions supported
0.53 20200614 G.Tani Added support for additional extensions, 210 ext ensions supported 0.53 20200614 G.Tani Added support for additional extensions, 210 ext ensions supported
.cramfs compressed ROM/RAM file system .cramfs compressed ROM/RAM file system
.ext, .ext2, .ext3, and .ext4 filesystem images .ext, .ext2, .ext3, and .ext4 filesystem images
.hfsx filesystem images .hfsx filesystem images
.qcow, and .qcow2c QEMU disk images .qcow, and .qcow2c QEMU disk images
.scap, and .uefif firmware files .scap, and .uefif firmware files
.mub, .pkg, and .ppmd compressed files .mub, .pkg, and .ppmd compressed files
0.54 20201230 G.Tani Added support for .appxbundle format, 211 extens ions supported 0.54 20201230 G.Tani Added support for .appxbundle format, 211 extens ions supported
Improved recognition of temp and other system's paths Improved recognition of temp and other system's paths
0.55 20210123 G.Tani Improved handling of special characters in passw ords and filenames
(C) Copyright 2006 Giorgio Tani giorgio.tani.software@gmail.com (C) Copyright 2006 Giorgio Tani giorgio.tani.software@gmail.com
The program is released under GNU LGPL http://www.gnu.org/licenses/lgpl.txt The program is released under GNU LGPL http://www.gnu.org/licenses/lgpl.txt
This library is free software; you can redistribute it and/or This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either License as published by the Free Software Foundation; either
version 3 of the License, or (at your option) any later version. version 3 of the License, or (at your option) any later version.
This library is distributed in the hope that it will be useful, This library is distributed in the hope that it will be useful,
skipping to change at line 346 skipping to change at line 347
function ShellTreeViewSetTextPath(ashelltreeview: TShellTreeView; function ShellTreeViewSetTextPath(ashelltreeview: TShellTreeView;
Path: ansistring): integer; Path: ansistring): integer;
//set parent paths as entries in a combobox //set parent paths as entries in a combobox
procedure ComboBoxSetPaths(acombobox: TComboBox; apath:ansistring); procedure ComboBoxSetPaths(acombobox: TComboBox; apath:ansistring);
//check full name against reserved and illegal characters, and reserved filename s //check full name against reserved and illegal characters, and reserved filename s
function checkfiledirname(s: ansistring): integer; function checkfiledirname(s: ansistring): integer;
function checkfiledirname_acceptblank(s: ansistring): integer; function checkfiledirname_acceptblank(s: ansistring): integer;
//check for some special characters in filenames in *x environments
function checkescapedoutname(s: ansistring):ansistring;
//escape filenames in *x environments likely using Gnome or KDE as desktop envir onment (Linux, *BSD) //escape filenames in *x environments likely using Gnome or KDE as desktop envir onment (Linux, *BSD)
function escapefilenamelinuxlike(s: ansistring; desk_env: byte): ansistring; function escapefilenamelinuxlike(s: ansistring; desk_env: byte): ansistring;
//cross platform filename escaping //cross platform filename escaping
function escapefilename(s: ansistring; desk_env: byte): ansistring; function escapefilename(s: ansistring; desk_env: byte): ansistring;
//escape file names and apply correct quotes
function escapefilenamedelim(s: ansistring; desk_env: byte): ansistring;
//apply correct quotes (on *x like swap ' and " quotes if needed)
function stringdelim(s:ansistring): ansistring;
//open Explorer selecting specified file //open Explorer selecting specified file
procedure winexplorepath(s: ansistring); procedure winexplorepath(s: ansistring);
//open files in *x environments likely using Gnome or KDE as desktop environment (Linux, *BSD) //open files in *x environments likely using Gnome or KDE as desktop environment (Linux, *BSD)
function cp_open_linuxlike(s: ansistring; desk_env: byte): integer; function cp_open_linuxlike(s: ansistring; desk_env: byte): integer;
//open Gnome or KDE search interface //open Gnome or KDE search interface
procedure cp_search_linuxlike(desk_env: byte); procedure cp_search_linuxlike(desk_env: byte);
//get correct quotes to delimit a string, swapping ' and " quotes if needed and
if it is supported by the OS
function correctdelimiter(s:AnsiString): AnsiString;
//get desktop environment //get desktop environment
procedure getdesk_env(var bytedesk: byte; var caption_build, delimiter: ansistri ng); procedure getdesk_env(var bytedesk: byte; var caption_build, delimiter: ansistri ng);
//get desktop path //get desktop path
procedure get_desktop_path(var s: ansistring); procedure get_desktop_path(var s: ansistring);
//get home path (*x) or profile path (win) //get home path (*x) or profile path (win)
procedure get_home_path(var s: ansistring); procedure get_home_path(var s: ansistring);
//get a temporary work path writeable from current user //get a temporary work path writeable from current user
skipping to change at line 745 skipping to change at line 758
function movecontent_todir(d1,d2:ansistring; mode:integer):integer; //input, out put, mode 0:keep input dir 1:delete input dir if empty function movecontent_todir(d1,d2:ansistring; mode:integer):integer; //input, out put, mode 0:keep input dir 1:delete input dir if empty
//results -1 copy error, 0 success, 1 remove input dir error //results -1 copy error, 0 success, 1 remove input dir error
var var
r: TSearchRec; r: TSearchRec;
begin begin
Result:=-1; Result:=-1;
if (FindFirst(d1 + '*', faAnyFile, r) = 0) then if (FindFirst(d1 + '*', faAnyFile, r) = 0) then
try try
repeat repeat
{$IFNDEF MSWINDOWS}
if FileExists(d2+r.name) then break;
{$ENDIF}
if (r.Name <> '.') and (r.Name <> '..') then if (r.Name <> '.') and (r.Name <> '..') then
renamefile(d1+r.name, d2+r.name); renamefile(d1+r.name, d2+r.name);
until findnext(r) <> 0; until findnext(r) <> 0;
except except
FindClose(r); FindClose(r);
exit; exit;
end; end;
FindClose(r); FindClose(r);
Result:=0; Result:=0;
if mode=1 then if mode=1 then
skipping to change at line 1464 skipping to change at line 1480
if pos(char(i), s) <> 0 then if pos(char(i), s) <> 0 then
exit; exit;
//reserved characters, full name //reserved characters, full name
if pos('*', s) <> 0 then if pos('*', s) <> 0 then
exit; exit;
if pos('?', s) <> 0 then if pos('?', s) <> 0 then
exit; exit;
{$IFDEF MSWINDOWS} {$IFDEF MSWINDOWS}
if pos('"', s) <> 0 then if pos('"', s) <> 0 then
exit; exit;
{$ELSE}
if pos('''', s) <> 0 then
exit;
{$ENDIF} {$ENDIF}
if pos('<', s) <> 0 then if pos('<', s) <> 0 then
exit; exit;
if pos('>', s) <> 0 then if pos('>', s) <> 0 then
exit; exit;
if pos('|', s) <> 0 then if pos('|', s) <> 0 then
exit; exit;
if pos(' ', s) <> 0 then if pos(' ', s) <> 0 then
exit; exit;
sf := extractfilename(s); sf := extractfilename(s);
skipping to change at line 1507 skipping to change at line 1520
end; end;
//wrapper for filename/dir check, accepts empty or valid name as valid input for special purposes i.e. replace string in file name with a valid string or nothin g (it is needed a separate final check for the file name to not be empty) //wrapper for filename/dir check, accepts empty or valid name as valid input for special purposes i.e. replace string in file name with a valid string or nothin g (it is needed a separate final check for the file name to not be empty)
function checkfiledirname_acceptblank(s: ansistring): integer; function checkfiledirname_acceptblank(s: ansistring): integer;
begin begin
result := -1; result := -1;
if s = '' then result:=0 if s = '' then result:=0
else result:=checkfiledirname(s); else result:=checkfiledirname(s);
end; end;
function checkescapedoutname(s: ansistring):ansistring;
var
varstr: ansistring;
i: integer;
begin
varstr := s;
{$IFNDEF MSWINDOWS}
repeat
i := pos('?', varstr);
if i > 0 then
varstr[pos('?', varstr)] := '_';
until i = 0;
{$ENDIF}
result:=varstr;
end;
function escapefilenamelinuxlike(s: ansistring; desk_env: byte): ansistring; function escapefilenamelinuxlike(s: ansistring; desk_env: byte): ansistring;
var var
varstr: ansistring; varstr,dstr: ansistring;
i: integer; i: integer;
begin begin
varstr := s; varstr := s;
// replace ' with ? (quick way to to preserve string delimitation in command l dstr:=correctdelimiter(s);
ine) // replace quote characters if found in string;
//correctdelimiter swaps ' and " quotes, but that cannot guarantee against bot
h characters being used in the same string - the remaining character is replaced
by a jolly
i := 1; i := 1;
repeat if dstr='''' then
i := pos('''', varstr); repeat
if i > 0 then i := pos('''', varstr);
varstr[pos('''', varstr)] := '?'; if i > 0 then
until i = 0; varstr[pos('''', varstr)] := '?';
until i = 0;
if dstr='"' then
repeat
i := pos('"', varstr);
if i > 0 then
varstr[pos('"', varstr)] := '?';
until i = 0;
// find and delete 'file://' (and any part before) if it is passed as part of filename (it happens sometimes in Gnome, i.e. using "open with" context menu ent ry) // find and delete 'file://' (and any part before) if it is passed as part of filename (it happens sometimes in Gnome, i.e. using "open with" context menu ent ry)
i := pos('file://', varstr); i := pos('file://', varstr);
if i > 0 then if i > 0 then
varstr := copy(varstr, i + 7, length(varstr) - i - 6); varstr := copy(varstr, i + 7, length(varstr) - i - 6);
//replace %20 with space (if inverse replacement was done by desktop environme nt, happens in Gnome passing input from desktop environment rather than from app lication's dialogs) //replace %20 with space (if inverse replacement was done by desktop environme nt, happens in Gnome passing input from desktop environment rather than from app lication's dialogs)
if desk_env = 1 then //apply it strictly only on Gnome if desk_env = 1 then //apply it strictly only on Gnome
if filegetattr(s) <= 0 then if filegetattr(s) <= 0 then
repeat repeat
i := pos('%20', varstr); i := pos('%20', varstr);
if i > 0 then if i > 0 then
begin begin
Delete(varstr, i, 3); Delete(varstr, i, 3);
insert(' ', varstr, i); insert(' ', varstr, i);
end; end;
until i = 0; until i = 0;
escapefilenamelinuxlike := varstr; escapefilenamelinuxlike := varstr;
end; end;
{in Linux and BSDs if filename contains delimiter ' change the character in ?, a
nd checking special cases for Gnome and KDE
in Windows delimiter is " and it's not a valid character in filenames, so this c
ontrol returns the input string (which doesn't need to be variable)
on other systems filenames are not escaped
}
function escapefilename(s: ansistring; desk_env: byte): ansistring; function escapefilename(s: ansistring; desk_env: byte): ansistring;
begin begin
{$IFDEF MSWINDOWS} {$IFDEF MSWINDOWS}
escapefilename := s; escapefilename := s;
{$ENDIF} {$ENDIF}
{$IFDEF LINUX} {$IFDEF LINUX}
escapefilename := escapefilenamelinuxlike(s, desk_env); escapefilename := escapefilenamelinuxlike(s, desk_env);
{$ENDIF} {$ENDIF}
{$IFDEF FREEBSD} {$IFDEF FREEBSD}
escapefilename := escapefilenamelinuxlike(s, desk_env); escapefilename := escapefilenamelinuxlike(s, desk_env);
{$ENDIF} {$ENDIF}
{$IFDEF NETBSD} {$IFDEF NETBSD}
escapefilename := escapefilenamelinuxlike(s, desk_env); escapefilename := escapefilenamelinuxlike(s, desk_env);
{$ENDIF} {$ENDIF}
end; end;
function escapefilenamedelim(s: ansistring; desk_env: byte): ansistring;
var
cdelim:utf8string;
begin
cdelim:=correctdelimiter(s);
result := cdelim+escapefilename(s, desk_env)+cdelim;
end;
function stringdelim(s:ansistring): ansistring;
var
cdelim:utf8string;
begin
cdelim:=correctdelimiter(s);
result := cdelim+s+cdelim;
end;
function cp_open_linuxlike(s: ansistring; desk_env: byte): integer; function cp_open_linuxlike(s: ansistring; desk_env: byte): integer;
var var
P: TProcessUTF8; P: TProcessUTF8;
begin begin
cp_open_linuxlike := -1; cp_open_linuxlike := -1;
if s = '' then if s = '' then
exit; exit;
if (desk_env = 10) or (desk_env = 20) then //continue for gnome=1 kde=2 and un known desktop manager =0, exit for Windows=10 and Darwin=20 if (desk_env = 10) or (desk_env = 20) then //continue for gnome=1 kde=2 and un known desktop manager =0, exit for Windows=10 and Darwin=20
exit; exit;
P := TProcessUTF8.Create(nil); P := TProcessUTF8.Create(nil);
skipping to change at line 1616 skipping to change at line 1666
P := TProcessUTF8.Create(nil); P := TProcessUTF8.Create(nil);
P.Options := [poNoConsole, poWaitOnExit]; P.Options := [poNoConsole, poWaitOnExit];
if desk_env = 1 then if desk_env = 1 then
P.Executable := 'gnome-search-tool'; P.Executable := 'gnome-search-tool';
if desk_env = 2 then if desk_env = 2 then
P.Executable := 'kfind'; P.Executable := 'kfind';
P.Execute; P.Execute;
P.Free; P.Free;
end; end;
function correctdelimiter(s:AnsiString): AnsiString;
begin
result := '''';
{$IFDEF MSWINDOWS}
result := '"';
{$ELSE}
if pos('''',s)<>0 then result := '"';
{$ENDIF}
end;
procedure getdesk_env(var bytedesk: byte; var caption_build, delimiter: ansistri ng); procedure getdesk_env(var bytedesk: byte; var caption_build, delimiter: ansistri ng);
//0 unknown, 1 Gnome, 2 KDE, 10 MS Windows, 20 Darwin, 30 OSX //0 unknown, 1 Gnome, 2 KDE, 10 MS Windows, 20 Darwin, 30 OSX
begin begin
caption_build := 'Unknown OS Build'; caption_build := 'Unknown OS Build';
delimiter := ''''; delimiter := '''';
//defaults, overwritten by specifical values if target system is recognized: u nknown OS, ' as delimiter character (*x like) //defaults, overwritten by specifical values if target system is recognized: u nknown OS, ' as delimiter character (*x like)
{$IFDEF WIN32} {$IFDEF WIN32}
caption_build := 'Windows Build'; caption_build := 'Windows Build';
delimiter := '"'; delimiter := '"';
{$ENDIF} {$ENDIF}
skipping to change at line 1769 skipping to change at line 1829
exit; exit;
if pos(':', s) <> 0 then if pos(':', s) <> 0 then
exit; exit;
if pos('*', s) <> 0 then if pos('*', s) <> 0 then
exit; exit;
if pos('?', s) <> 0 then if pos('?', s) <> 0 then
exit; exit;
{$IFDEF MSWINDOWS} {$IFDEF MSWINDOWS}
if pos('"', s) <> 0 then if pos('"', s) <> 0 then
exit; exit;
{$ELSE}
if pos('''', s) <> 0 then
exit;
{$ENDIF} {$ENDIF}
if pos('<', s) <> 0 then if pos('<', s) <> 0 then
exit; exit;
if pos('>', s) <> 0 then if pos('>', s) <> 0 then
exit; exit;
if pos('|', s) <> 0 then if pos('|', s) <> 0 then
exit; exit;
if pos(' ', s) <> 0 then if pos(' ', s) <> 0 then
exit; exit;
//reserved filenames (Windows) //reserved filenames (Windows)
skipping to change at line 1808 skipping to change at line 1865
function checkfilename_acceptblank(s: ansistring): integer; function checkfilename_acceptblank(s: ansistring): integer;
begin begin
result := -1; result := -1;
if s = '' then result:=0 if s = '' then result:=0
else result:=checkfilename(s); else result:=checkfilename(s);
end; end;
function validatecl(var s: ansistring): integer; function validatecl(var s: ansistring): integer;
var var
i: integer; i: integer;
s1,delimiter:ansistring; s1,delimch:ansistring;
begin begin
validatecl := -1; validatecl := -1;
if s = '' then exit; if s = '' then exit;
for i := 0 to 31 do if pos(char(i), s) <> 0 then exit; //illegal characters for i := 0 to 31 do if pos(char(i), s) <> 0 then exit; //illegal characters
{$IFDEF MSWINDOWS} delimch := correctdelimiter(s);
delimiter := '"';
{$ELSE}
delimiter := '''';
{$ENDIF}
s1:=s; s1:=s;
if pos('7z',s)<>0 then if (pos('res'+directoryseparator+'7z',s)<>0) or (pos('res'+directoryseparator+'a
if pos(delimiter+'-p',s)<>0 then rc',s)<>0) or (pos('Rar.exe',s)<>0) then
if pos(delimch+'-p',s)<>0 then
begin begin
s1:=copy(s,pos(delimiter+'-p',s)+3,length(s)-pos(delimiter+'-p',s)-2); s1:=copy(s,pos(delimch+'-p',s)+3,length(s)-pos(delimch+'-p',s)-2);
s1:=copy(s1,pos(delimiter,s1)+1,length(s1)-pos(delimiter,s1)); s1:=copy(s1,pos(delimch,s1)+1,length(s1)-pos(delimch,s1));
s1:=copy(s,1,pos(delimiter+'-p',s))+s1; s1:=copy(s,1,pos(delimch+'-p',s))+s1;
end end
else else
if pos(' -p',s)<>0 then if pos(' -p',s)<>0 then
begin begin
s1:=copy(s,pos(' -p',s)+3,length(s)-pos(' -p',s)-2); s1:=copy(s,pos(' -p',s)+3,length(s)-pos(' -p',s)-2);
s1:=copy(s1,pos(' ',s1)+1,length(s1)-pos(' ',s1)); s1:=copy(s1,pos(' ',s1)+1,length(s1)-pos(' ',s1));
s1:=copy(s,1,pos(' -p',s))+s1; s1:=copy(s,1,pos(' -p',s))+s1;
end; end;
if (pos('res'+directoryseparator+'arc',s)<>0) or (pos('Rar.exe',s)<>0) then
if pos(delimch+'-hp',s)<>0 then
begin
s1:=copy(s,pos(delimch+'-hp',s)+4,length(s)-pos(delimch+'-hp',s)-3);
s1:=copy(s1,pos(delimch,s1)+1,length(s1)-pos(delimch,s1));
s1:=copy(s,1,pos(delimch+'-hp',s))+s1;
end
else
if pos(' -hp',s)<>0 then
begin
s1:=copy(s,pos(' -hp',s)+4,length(s)-pos(' -hp',s)-3);
s1:=copy(s1,pos(' ',s1)+1,length(s1)-pos(' ',s1));
s1:=copy(s,1,pos(' -hp',s))+s1;
end;
if (pos('res'+directoryseparator+'pea',s)<>0) then
if pos('BATCH',s)<>0 then
begin
s1:=copy(s,pos('BATCH',s)+6,length(s)-pos('BATCH',s)-5);
if pos('FROMCL',s1)<>0 then s1:=copy(s1,pos('FROMCL',s1)+7,length(s1)-pos(
'FROMCL',s1)-6)
else s1:=copy(s1,pos('NOKEYFILE',s1)+9,length(s1)-pos('NOKEYFILE',s1)-8);
s1:=copy(s,1,pos('BATCH',s))+s1;
end;
{if pos('<',s1)<>0 then exit; {if pos('<',s1)<>0 then exit;
if pos('>',s1)<>0 then exit;} if pos('>',s1)<>0 then exit;}
if pos('|', s1) <> 0 then exit; if pos('|', s1) <> 0 then exit;
if pos(' ', s1) <> 0 then exit; //more than 4 consecutive spaces may be inte ntional attempt to hamper readability (as in 7-Zip) if pos(' ', s1) <> 0 then exit; //more than 4 consecutive spaces may be inte ntional attempt to hamper readability (as in 7-Zip)
validatecl := 0; validatecl := 0;
end; end;
{$IFDEF MSWINDOWS} {$IFDEF MSWINDOWS}
procedure getwinenv(var wincomspec, winver: ansistring); procedure getwinenv(var wincomspec, winver: ansistring);
var var
 End of changes. 19 change blocks. 
31 lines changed or deleted 112 lines changed or added

Home  |  About  |  Features  |  All  |  Newest  |  Dox  |  Diffs  |  RSS Feeds  |  Screenshots  |  Comments  |  Imprint  |  Privacy  |  HTTP(S)