mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-09 01:28:19 +02:00
lazutils: FileUtil: added SplitCmdLineParams
git-svn-id: trunk@39730 -
This commit is contained in:
parent
6e01f3745a
commit
899bdb7156
@ -173,6 +173,94 @@ begin
|
||||
Result:=SysToUTF8(SysUtils.SysErrorMessage(ErrorCode));
|
||||
end;
|
||||
|
||||
procedure SplitCmdLineParams(const Params: string; ParamList: TStrings;
|
||||
ReadBackslash: boolean = false);
|
||||
// split spaces, quotes are parsed as single parameter
|
||||
// if ReadBackslash=true then \" is replaced to " and not treated as quote
|
||||
// #0 is always end
|
||||
type
|
||||
TMode = (mNormal,mApostrophe,mQuote);
|
||||
var
|
||||
p: Integer;
|
||||
Mode: TMode;
|
||||
Param: String;
|
||||
begin
|
||||
p:=1;
|
||||
while p<=length(Params) do
|
||||
begin
|
||||
// skip whitespace
|
||||
while (p<=length(Params)) and (Params[p] in [' ',#9,#10,#13]) do inc(p);
|
||||
if (p>length(Params)) or (Params[p]=#0) then
|
||||
break;
|
||||
//writeln('SplitCmdLineParams After Space p=',p,'=[',Params[p],']');
|
||||
// read param
|
||||
Param:='';
|
||||
Mode:=mNormal;
|
||||
while p<=length(Params) do
|
||||
begin
|
||||
case Params[p] of
|
||||
#0:
|
||||
break;
|
||||
'\':
|
||||
begin
|
||||
inc(p);
|
||||
if ReadBackslash then
|
||||
begin
|
||||
// treat next character as normal character
|
||||
if (p>length(Params)) or (Params[p]=#0) then
|
||||
break;
|
||||
if ord(Params[p])<128 then
|
||||
begin
|
||||
Param+=Params[p];
|
||||
inc(p);
|
||||
end else begin
|
||||
// next character is already a normal character
|
||||
end;
|
||||
end else begin
|
||||
// treat backslash as normal character
|
||||
Param+='\';
|
||||
end;
|
||||
end;
|
||||
'''':
|
||||
begin
|
||||
inc(p);
|
||||
case Mode of
|
||||
mNormal:
|
||||
Mode:=mApostrophe;
|
||||
mApostrophe:
|
||||
Mode:=mNormal;
|
||||
mQuote:
|
||||
Param+='''';
|
||||
end;
|
||||
end;
|
||||
'"':
|
||||
begin
|
||||
inc(p);
|
||||
case Mode of
|
||||
mNormal:
|
||||
Mode:=mQuote;
|
||||
mApostrophe:
|
||||
Param+='"';
|
||||
mQuote:
|
||||
Mode:=mNormal;
|
||||
end;
|
||||
end;
|
||||
' ',#9,#10,#13:
|
||||
begin
|
||||
if Mode=mNormal then break;
|
||||
Param+=Params[p];
|
||||
inc(p);
|
||||
end;
|
||||
else
|
||||
Param+=Params[p];
|
||||
inc(p);
|
||||
end;
|
||||
end;
|
||||
//writeln('SplitCmdLineParams Param=#'+Param+'#');
|
||||
ParamList.Add(Param);
|
||||
end;
|
||||
end;
|
||||
|
||||
function DirPathExists(const FileName: String): Boolean;
|
||||
var
|
||||
F: Longint;
|
||||
|
@ -239,6 +239,8 @@ function GetAppConfigFileUTF8(Global: Boolean; SubDir: boolean = false;
|
||||
|
||||
// other
|
||||
function SysErrorMessageUTF8(ErrorCode: Integer): String;
|
||||
procedure SplitCmdLineParams(const Params: string; ParamList: TStrings;
|
||||
ReadBackslash: boolean = false);
|
||||
|
||||
implementation
|
||||
|
||||
|
@ -1,4 +1,4 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<?xml version="1.0"?>
|
||||
<fpdoc-descriptions>
|
||||
<package name="lazutils">
|
||||
<!--
|
||||
@ -1059,8 +1059,8 @@ else
|
||||
<element name="TFileSearcher.Search">
|
||||
<short>Searches for files in specified path with passed options.</short>
|
||||
<descr>Searches for files in specified path. When file is found the OnFileFound event is invoked, for directories
|
||||
OnDirectoryFound event. You can abort searching process by calling Stop method in this events.
|
||||
</descr>
|
||||
		 OnDirectoryFound event. You can abort searching process by calling Stop method in this events.
|
||||
		</descr>
|
||||
<errors/>
|
||||
<seealso>
|
||||
<link id="TFileSearcher.OnFileFound"/>
|
||||
@ -1182,6 +1182,12 @@ else
|
||||
<element name="GetTempFilename.Prefix">
|
||||
<short>The <var>Prefix</var> to which an integer will be attached to generate a temporary filename</short>
|
||||
</element>
|
||||
<element name="SplitCmdLineParams"><short>Splits parameters separated by one or more spaces.</short><descr>Parameters are separated by one or more spaces (#9,#10,#13,#32).
|
||||
Quotes are parsed as single parameter.
|
||||
if ReadBackslash=true then \" is replaced to " and not treated as quote.
|
||||
#0 is always end.
|
||||
</descr>
|
||||
</element>
|
||||
</module>
|
||||
<!-- FileUtil -->
|
||||
</package>
|
||||
|
@ -28,7 +28,7 @@ unit UTF8Process;
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Process, FileUtil, LCLStrConsts;
|
||||
Classes, SysUtils, Process, FileUtil, LazUTF8, LCLStrConsts;
|
||||
|
||||
type
|
||||
{ TProcessUTF8 }
|
||||
|
@ -4,6 +4,7 @@
|
||||
|
||||
Test specific with:
|
||||
./runtests --format=plain --suite=TestReplaceSubstring
|
||||
./runtests --format=plain --suite=TestSplitCmdLineParams
|
||||
}
|
||||
unit TestLazUtils;
|
||||
|
||||
@ -12,7 +13,7 @@ unit TestLazUtils;
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, fpcunit, testglobals, LazLogger;
|
||||
Classes, SysUtils, fpcunit, testglobals, LazLogger, FileUtil;
|
||||
|
||||
type
|
||||
|
||||
@ -22,6 +23,7 @@ type
|
||||
public
|
||||
published
|
||||
procedure TestReplaceSubstring;
|
||||
procedure TestSplitCmdLineParams;
|
||||
end;
|
||||
|
||||
implementation
|
||||
@ -62,6 +64,41 @@ begin
|
||||
AssertEquals('middle chars shorten','axe',r('abcde',2,3,'x'));
|
||||
end;
|
||||
|
||||
procedure TTestLazUtils.TestSplitCmdLineParams;
|
||||
|
||||
function r(Params: string; ReadBackslash: boolean = false): string;
|
||||
var
|
||||
ParamList: TStringList;
|
||||
i: Integer;
|
||||
begin
|
||||
Result:='';
|
||||
ParamList:=TStringList.Create;
|
||||
try
|
||||
SplitCmdLineParams(Params,ParamList,ReadBackslash);
|
||||
for i:=0 to ParamList.Count-1 do begin
|
||||
if i>0 then Result+='|';
|
||||
Result+=ParamList[i];
|
||||
end;
|
||||
finally
|
||||
ParamList.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
AssertEquals('empty','',r(''));
|
||||
AssertEquals('simple','a',r('a'));
|
||||
AssertEquals('two simple','a|b',r('a b'));
|
||||
AssertEquals('one quote "','a b',r('"a b"'));
|
||||
AssertEquals('one quote ''','a b',r('''a b'''));
|
||||
AssertEquals('two with backslash disabled','a\|b',r('a\ b'));
|
||||
AssertEquals('two with backslash enabled','a b',r('a\ b',true));
|
||||
AssertEquals('two with backslashed quote','a"b',r('"a\"b"',true));
|
||||
AssertEquals('two with backslashed apos','a''b',r('"a\''b"',true));
|
||||
AssertEquals('two with backslashed backslash','a\b',r('"a\\b"',true));
|
||||
AssertEquals('quoted quote','''|"',r('"''" ''"''',true));
|
||||
AssertEquals('empty params','|',r('"" '''''));
|
||||
end;
|
||||
|
||||
initialization
|
||||
AddToLazUtilsTestSuite(TTestLazUtils);
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user