Convert string with commas to float - delphi

Is there a built-in Delphi function which would convert a string such as '3,232.00' to float? StrToFloat raises an exception because of the comma. Or is the only way to strip out the comma first and then do StrToFloat?
Thanks.

Do you exactly know, that '.' is decimal separator and ',' is thousand separator (always)?
If so, then you should fill the TFormatSettings record and pass it to StrToFloat.
FillChar(FS, SizeOf(FS), 0);
... // filling other fields
FS.ThousandSeparator := ',';
FS.DecimalSeparator := '.';
V := StrToFloat(S, FS);

below is what i use. there might be more efficient ways, but this works for me. in short, no, i don't know of any built-in delphi function that will convert a string-float containing commas to a float
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
safeFloat
Strips many bad characters from a string and returns it as a double.
}
function safeFloat(sStringFloat : AnsiString) : double;
var
dReturn : double;
begin
sStringFloat := stringReplace(sStringFloat, '%', '', [rfIgnoreCase, rfReplaceAll]);
sStringFloat := stringReplace(sStringFloat, '$', '', [rfIgnoreCase, rfReplaceAll]);
sStringFloat := stringReplace(sStringFloat, ' ', '', [rfIgnoreCase, rfReplaceAll]);
sStringFloat := stringReplace(sStringFloat, ',', '', [rfIgnoreCase, rfReplaceAll]);
try
dReturn := strToFloat(sStringFloat);
except
dReturn := 0;
end;
result := dReturn;
end;

function StrToFloat_Universal( pText : string ): Extended;
const
EUROPEAN_ST = ',';
AMERICAN_ST = '.';
var
lformatSettings : TFormatSettings;
lFinalValue : string;
lAmStDecimalPos : integer;
lIndx : Byte;
lIsAmerican : Boolean;
lIsEuropean : Boolean;
begin
lIsAmerican := False;
lIsEuropean := False;
for lIndx := Length( pText ) - 1 downto 0 do
begin
if ( pText[ lIndx ] = AMERICAN_ST ) then
begin
lIsAmerican := True;
pText := StringReplace( pText, ',', '', [ rfIgnoreCase, rfReplaceAll ]); //get rid of thousand incidental separators
Break;
end;
if ( pText[ lIndx ] = EUROPEAN_ST ) then
begin
lIsEuropean := True;
pText := StringReplace( pText, '.', '', [ rfIgnoreCase, rfReplaceAll ]); //get rid of thousand incidental separators
Break;
end;
end;
GetLocaleFormatSettings( LOCALE_SYSTEM_DEFAULT, lformatSettings );
if ( lformatSettings.DecimalSeparator = EUROPEAN_ST ) then
begin
if lIsAmerican then
begin
lFinalValue := StringReplace( pText, '.', ',', [ rfIgnoreCase, rfReplaceAll ] );
end;
end;
if ( lformatSettings.DecimalSeparator = AMERICAN_ST ) then
begin
if lIsEuropean then
begin
lFinalValue := StringReplace( pText, ',', '.', [ rfIgnoreCase, rfReplaceAll ] );
end;
end;
pText := lFinalValue;
Result := StrToFloat( pText, lformatSettings );
end;

Try: StrToFloat(StringReplace('3,232.00', ',', '')
It should get rid of the commas before doing the conversion.
In C# / VB.NET I use would use something like decimal.convert("3,232.00", ",", "");
I know of no way to do the conversion without stripping out the extra characters. In fact, I have a special function in my library that strips out commas and currency symbols. So a actually call MyConverer.decimalConverter("$3,232.00");

I use a function which is able to handle the ',' and the '.' as decimalseparator...:
function ConvertToFloat(aNr: String; aDefault:Integer): Extended;
var
sNr, s3R, sWhole, sCent:String;
eRC:Extended;
begin
sNr:=ReplaceStr(sNr, ' ', '');
if (Pos('.', sNr) > 0) or (Pos(',', sNr) > 0) then
begin
// Get 3rd character from right
s3R:=LeftStr(RightStr(sNr, 3), 1);
if s3R <> DecimalSeparator then
begin
if not IsNumber(s3R) then
begin
s3R := DecimalSeparator;
sWhole := LeftSr(sNr, Length(sNr) - 3);
sCent := (RightStr(sNr, 2);
sNr := sWhole + DecimalSeparator + sCent;
end
else
// there are no decimals... add ',00'
sNr:=sNr + DecimalSeparator + '00';
end;
// DecimalSeparator is present; get rid of other symbols
if (DecimalSeparator = '.') and (Pos(',', sNr) > 0) then sNr:=ReplaceStr(sNr, ',', '');
if (DecimalSeparator = ',') and (Pos('.', sNr) > 0) then sNr:=ReplaceStr(sNr, '.', '');
end;
eRc := StrToFloat(sNr);
end;

I had the same problem when my Users need to enter 'scientific' values such as "1,234.06mV". Here there is a comma, a multiplier (m=x0.001) and a unit (V). I created a 'wide' format converter routine to handle these situtations.
Brian

Myfunction:
function StrIsFloat2 (S: string; out Res: Extended): Boolean;
var
I, PosDecimal: Integer;
Ch: Char;
STrunc: string;
liDots, liComma, J: Byte;
begin
Result := False;
if S = ''
then Exit;
liDots := 0;
liComma := 0;
for I := 1 to Length(S) do begin
Ch := S[I];
if Ch = FormatSettings.DecimalSeparator then begin
Inc (liDots);
if liDots > 1 then begin
Exit;
end;
end
else if (Ch = '-') and (I > 1) then begin
Exit;
end
else if Ch = FormatSettings.ThousandSeparator then begin
Inc (liComma);
end
else if not CharIsCipher(Ch) then begin
Exit;
end;
end;
if liComma > 0 then begin
PosDecimal := Pos (FormatSettings.DecimalSeparator, S);
if PosDecimal = 0 then
STrunc := S
else
STrunc := Copy (S, 1, PosDecimal-1);
if STrunc[1] = '-' then
Delete (S, 1, 1);
if Length(STrunc) < ((liComma * 3) + 2) then
Exit;
J := 0;
for I := Length(STrunc) downto 1 do begin
Inc(J);
if J mod 4 = 0 then
if STrunc[I] <> FormatSettings.ThousandSeparator then
Exit;
end;
S := ReplaceStr (S, FormatSettings.ThousandSeparator, '');
end;
try
Res := StrToFloat (S);
Result := True;
except
Result := False;
end;
end;

Using Foreach loop
public static float[] ToFloatArray()
{
string pcords="200.812, 551.154, 232.145, 482.318, 272.497, 511.752";
float[] spiltfloat = new float[pcords.Split(',').Length];
int i = 0;
foreach (string s in pcords.Split(','))
{
spiltfloat[i] = (float)(Convert.ToDouble(s));
i++;
}
return spiltfloat;
}

using lemda Expression to convert string comma seprated to float array
public static float[] ToFloatArrayUsingLemda()
{
string pcords="200.812, 551.154, 232.145, 482.318, 272.497, 511.752";
float[] spiltfloat = new float[pcords.Split(',').Length];
string[] str = pcords.Split(',').Select(x => x.Trim()).ToArray();
spiltfloat = Array.ConvertAll(str, float.Parse);
return spiltfloat;
}

procedure Edit1Exit(Sender: TObject);
begin
edit1.Text:=stringreplace(edit1.Text,'''','',[rfReplaceAll]);
if not IsValidDecimal( maskedit1.Text ) then
begin
showmessage('The Decimal entered -> '+edit1.Text+' <- is in the wrong format ');
edit1.SetFocus;
end;
end;
function IsValidDecimal(S:string):boolean;
VAR
FS: TFormatSettings;
DC: variant;
begin
//FS := TFormatSettings.Create('it-IT');
FS := TFormatSettings.Create('en-EN');
try
DC:=StrToFloat ( S, FS );
result:=true;
except
on e:exception do
result:=false;
end;
end;

Related

Generate random password in Delphi

I have a following function to generate random passwords:
function GeneratePassword(ALength: Integer; Mode: TPasswordMode): string;
const
cLower = 'abcdefghijklmnopqrstuvwxyz';
cUpper = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
cNumbers = '0123456789';
cExtra = '_.';
var
i : Integer;
S : string;
iM: BYTE;
begin
if Mode = [] then Exit;
i := 0;
Randomize;
while (i < ALength) do
begin
iM := RANDOM(4);
case iM of
0: if (pmLower in Mode) then begin
S := S + cLower[1+RANDOM(Length(cLower))];
Inc(i);
end;
1: if (pmUpper in Mode) then begin
S := S + cUpper[1+RANDOM(Length(cUpper))];
Inc(i);
end;
2: if (pmNumbers in Mode) then begin
S := S + cNumbers[1+RANDOM(Length(cNumbers))];
Inc(i);
end;
3: if (pmExtra in Mode) then begin
S := S + cExtra[1+RANDOM(Length(cExtra))];
Inc(i);
end;
end;
end;
Result := S;
end;
How to make this function so that a capital letter and a special character appear only once, but always? Sometimes there is no capital letter or special character when I'm generating passwords.
To be sure to have one special char and one uppercase you can do that :
function GeneratePassword(ALength: Integer; Mode: TPasswordModes): string;
const
cLower = 'abcdefghijklmnopqrstuvwxyz';
cUpper = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
cNumbers = '0123456789';
cExtra = '_.';
var
iM: Byte;
i: integer;
begin
if Mode = [] then Exit;
Result := '';
i := 0;
if pmUpper in Mode then
Inc(i);
if pmExtra in Mode then
Inc(i);
// add lower case and/or number
while Result.Length < (ALength - i) do
begin
iM := Random(2);
case iM of
0: if (pmLower in Mode) then begin
Result := Result + cLower[1 + Random(Length(cLower))];
end;
1: if (pmNumbers in Mode) then begin
Result := Result + cNumbers[1 + Random(Length(cNumbers))];
end;
end;
end;
// add uppercase and/or extra
if i > 0 then
begin
if pmUpper in Mode then
Result := Result.Insert(1 + Random(Length(Result)), cUpper[1 + Random(Length(cUpper))]);
if pmExtra in Mode then
Result := Result.Insert(1 + Random(Length(Result)), cExtra[1 + Random(Length(cExtra))]);
end;
end;
type
TPasswordMode = (pmLower, pmUpper, pmNumbers, pmExtra);
TPasswordModes = set of TPasswordMode;
implementation
function GeneratePassword(ALength: Integer; Mode: TPasswordModes): string;
const
cLower = 'abcdefghijklmnopqrstuvwxyz';
cUpper = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
cNumbers = '0123456789';
cExtra = '_.';
var
i : Integer;
S : string;
iM: BYTE;
begin
if Mode = [] then Exit;
i := 0;
Randomize;
while (i < ALength) do
begin
iM := RANDOM(4);
case iM of
0: if (pmLower in Mode) then begin
S := S + cLower[1+RANDOM(Length(cLower))];
Inc(i);
end;
1: if (pmUpper in Mode) then begin
S := S + cUpper[1+RANDOM(Length(cUpper))];
Inc(i);
Mode := Mode - [pmUpper]; // This I added
end;
2: if (pmNumbers in Mode) then begin
S := S + cNumbers[1+RANDOM(Length(cNumbers))];
Inc(i);
end;
3: if (pmExtra in Mode) then begin
S := S + cExtra[1+RANDOM(Length(cExtra))];
Inc(i);
Mode := Mode - [pmExtra]; // This I added
end;
end;
end;
Result := S;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(GeneratePassword(10,[pmLower,pmUpper,pmNumbers,pmExtra]));
end;
This is not a complete solution but with this you will at least remove Upper and Extra from the requirements as soon as they get taken. You now check in the end if they ever were ever added if required and then add them if so required.
Edit:
I was in a hurry when I typed the above. You just need to check in the end if the generated password contains an Upper and Extra character. If not, you still need to add them as that was one of your requirements.
Here is example that first makes sure all extra modes are filled and the rest. It prefills Result with spaces and then replaces with random chars until all spaces are replaced.
function GetRandomEmptyPos(const aStr: string): integer; inline;
begin
// find random empty position
repeat
Result := Random(Length(aStr)) + 1;
until aStr[Result] = ' ';
end;
function GeneratePassword2(aLength: Integer; aModes: TPasswordModes): string;
const
cLower = 'abcdefghijklmnopqrstuvwxyz';
cUpper = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
cNumbers = '0123456789';
cExtra = '_.';
var
i,vPos: integer;
vMode: TPasswordMode;
begin
if (aLength = 0) or (aModes = []) then Exit;
Randomize;
// Prefill Result with empty spaces
Result := StringOfChar(' ', aLength);
// Add extra characters at random places
for vMode in aModes do
begin
vPos := GetRandomEmptyPos(Result);
case vMode of
pmLower: Result[vPos] := cLower[Random(Length(cLower)) + 1];
pmUpper: Result[vPos] := cUpper[Random(Length(cUpper)) + 1];
pmNumbers: Result[vPos] := cNumbers[Random(Length(cNumbers)) + 1];
pmExtra: Result[vPos] := cExtra[Random(Length(cExtra)) + 1];
end;
end;
// Add random char on emtpy spaces
for i := 1 to Result.Length do
if Result[i] = ' ' then
Result[i] := String(cLower + cNumbers)[Random(Length(cLower) + Length(cNumbers)) + 1];
end;
unrefined code but maybe it can be useful ...
function RandomPassword(PLen: Integer): string;
var
strBase: string;
strUpper: string;
strSpecial: string;
strRecombine: string;
begin
strRecombine:='';
Result := '';
Randomize;
//string with all possible chars
strBase := 'abcdefghijklmnopqrstuvwxyz1234567890';
strUpper:='ABCDEFGHIJKLMNOPQRSTUVWXYZ';
strSpecial:='#!_';
// Start Random
strRecombine:= strUpper[Random(Length(strUpper)) + 1];
Result:=strRecombine;
strRecombine:= strSpecial[Random(Length(strSpecial))+1];
repeat
Result := Result + strBase[Random(Length(strBase)) + 1];
until (Length(Result) = PLen);
RandomRange(2, Length(strBase));
Result[RandomRange(2, PLen)]:=strRecombine[1];
//result:=Result+strRecombine;
end;

How to transform a string from a delphi code source into a standard string to be saved in a database?

I've written a parser to extract from my Delphi code, the resourcestring to save them into a database that I should send to a translator.
My request is : Is there an easy way to transform a Delphi string like from source code to a "standard" string ready to be save into database ?
Here is an example : from my source code I have this :
MyResourceString1 = 'Error : I can''t load the file from disk !';
or
MyResourceString2 = 'Error : I can'#39't load the file from disk !';
then after my parser process, I've extracted these kind of string values. But before to save them into a database, I would like to transform all the strings to a "standard" sentence like :
"Error : I can't load the file from disk !"
or
"Error : I can't load the file from disk !"
I would like to use an interpreter function unlike parse the Delphi string to change all #code char to the right char.
Thank you for your help.
This is easy to implement using a simple state machine:
function TryParseStringLiteral(const ALiteral: string; out AString: string): Boolean;
var
LLiteral: string;
i, c: Integer;
InQuotes: Boolean;
InCharCode: Boolean;
NumCodeStr: string;
NumVal: Integer;
begin
LLiteral := ALiteral.Trim;
SetLength(AString, LLiteral.Length);
InQuotes := False;
InCharCode := False;
NumCodeStr := '';
NumVal := 0;
c := 0;
for i := 1 to LLiteral.Length do
begin
if InCharCode then
begin
if (LLiteral[i] = '#') or (LLiteral[i] = '''') then
begin
if TryStrToInt(NumCodeStr, NumVal) and InRange(NumVal, Word.MinValue, Word.MaxValue) then
begin
Inc(c);
AString[c] := Chr(NumVal);
end
else
Exit(False);
InCharCode := LLiteral[i] = '#';
InQuotes := LLiteral[i] = '''';
NumCodeStr := '';
NumVal := 0;
end
else
NumCodeStr := NumCodeStr + LLiteral[i];
end
else if InQuotes then
begin
if (LLiteral[i] = '''') and (i < LLiteral.Length) and (LLiteral[Succ(i)] = '''') then
begin
InQuotes := False; // a bit of a hack
Inc(c);
AString[c] := '''';
end
else if LLiteral[i] = '''' then
InQuotes := False
else
begin
Inc(c);
AString[c] := LLiteral[i];
end;
end
else if LLiteral[i] = '''' then
InQuotes := True
else if LLiteral[i] = '#' then
InCharCode := True
else
Exit(False);
end;
if InCharCode then
if TryStrToInt(NumCodeStr, NumVal) and InRange(NumVal, Word.MinValue, Word.MaxValue) then
begin
Inc(c);
AString[c] := Chr(NumVal);
end
else
Exit(False);
if InQuotes then
Exit(False);
SetLength(AString, c);
Result := True;
end;
To try it:
procedure TForm1.Edit1Change(Sender: TObject);
var
S: string;
begin
if TryParseStringLiteral(Edit1.Text, S) then
Edit2.Text := S
else
Edit2.Text := ' -- Invalid string literal -- ';
end;
Some examples:
'This is a test!' This is a test!
'What''s up?' What's up?
'alpha'#64'beta'#63 alpha#beta?
'alpha'#$40'beta'#$3F alpha#beta?
#94#94#94 ^^^
#94#94#94'ABC' ^^^ABC
'ABC'#94#94#94 ABC^^^
'ABC'#94#94#94'abc' ABC^^^abc
'ABC'#94#94#94'abc'#63'!' ABC^^^abc?!
'test'#32'again' test again
'test'#32#32#$20'again' test again
''
'''' '
'''''''' '''
'a' a
#65 A
#65#$21 A!
'''test'''#65 'test'A

Update Knuth, Morris, Pratt algorithm to work with unicode

Have some old code (written by someone else) that I need to fix to work with Unicode strings in Delphi 10.1. EDIT: I've narrowed my question down to the following: code below fails with unicode strings. Suggestions?
//global variable:
var
UpCaseLookup : array[ 1..255 ] of char;
// ---- Knuth, Morris, Pratt:
type
failure = array[1..255] of word;
procedure PrepareUpcaseLookup;
var
S : string; //was shortstring;
i : integer;
begin
for i := 1 to 255 do
begin
S := ToUpper( chr(i) ); //was AnsiUpperCase
UpCaseLookup[i] := S[1]
end
end;
function PosKnuthMorrisPratt(Pattern, Text: string): Integer;
var
Prefix: array of Integer;
i, k: Integer;
begin
Result := 0;
if (Pattern = '') or (Text = '') then
Exit;
Pattern := UpperCase(Pattern); // case-insensitive
Text := UpperCase(Text);
// Buld prefix function array
SetLength(Prefix, Length(Pattern) + 1);
Prefix[1] := 0;
k := 0;
for i := 2 to Length(Pattern) do begin
while (k > 0) and (Pattern[k + 1] <> Pattern[i]) do
k := Prefix[k];
if Pattern[k + 1] = Pattern[i] then
Inc(k);
Prefix[i] := k;
end;
k := 0;
for i := 1 to Length(Text) do begin
while (k > 0) and (Pattern[k + 1] <> Text[i]) do
k := Prefix[k];
if Pattern[k + 1] = Text[i] then
Inc(k);
if k = Length(Pattern) then
Exit(i + 1 - Length(Pattern));
end;
end;
begin
Memo1.Lines.Add(IntToStr(PosKnuthMorrisPratt('abaBc', 'ggabagabAbccsab')));
Memo1.Lines.Add(IntToStr(PosKnuthMorrisPratt('ab', 'ggagbc')));

Function to increment filename

I'm trying to make a function that can increment a filename.
If last char of the string is a number then increment it.
If last char is a letter then add _1 or _2 or _3(increment this also).
I have to be sure the filename is unique but i cannot use datetime inside filename because all the filenames must be <32 chars without extension.
EX: Apple_99.txt =>Apple_100
Ex: Apple_173 => Apple_174
EX: This_is_my_first_text.txt => This_is_my_first_text_1.txt
Ex: This_is_my_first_text_9.txt => This_is_my_first_text_10.txt
I need to use this in order to rename a file an then upload it to a ftp server.
I've found a function that can do something like this but it only works if the filename contains only uppercase.How can I modify this function in order to access lowercase an uppercase string?
Here is the function:
function IncStr(Str: String; Amount: Integer; Index: Integer = -1): String;
const
MIN_VAL = 65; // 'A'
MAX_VAL = 90; // 'Z'
var
Digit, ToAdd, ToCarry: Integer;
begin
if (Index = 0) and (Amount > 0) then
begin
Result := Char(MIN_VAL + Amount - 1) + Str;
Exit;
end;
if Index = -1 then Index := Length(Str);
ToCarry := 0;
Digit := Ord(Str[Index]);
while not (Digit in [MIN_VAL..MAX_VAL]) do
begin
Dec(Index);
Digit := Ord(Str[Index]);
end;
ToAdd := Digit + Amount;
while (ToAdd > MAX_VAL) do
begin
Dec(ToAdd, 26);
Inc(ToCarry);
end;
Result := Str;
Result[Index] := Char(ToAdd);
if (ToCarry > 0) then
Result := IncStr(Result, ToCarry, Index - 1);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
S: String; // holds string to increment
C: Integer; // amount to increment by
begin
// make sure that Edit1 starts with a valid character
// i.e. 'A' to 'Z'
S := Edit1.Text;
C := StrtoIntDef(Edit2.Text, 0);
// test it, place result in Edit3
Edit3.Text := IncStr(S, C);
{
Example data:
Edit1 := AAZ
Edit2 := 2
= Edit3 := ABB
Edit1 := BZY
Edit2 := 3
= Edit3 := CAB
Edit1 := ZZZ
Edit2 := 1
= Edit3 := AAAA
Edit1 := AA-AC
Edit2 := 3
= Edit3 := AA-AF
Edit1 := AA/Z
Edit2 := 5
= Edit3 := AB/E
... etc
Here's one to try too :-)
Edit1 := ZZZ
Edit2 := 264172
}
end;
Thank you!
Like so many programming problems, the key is to break the problem down into small pieces. First of all, let's write a function to decode the original file name into its constituent parts:
procedure DecodeFileName(const Input: string; out Stem, Ext: string; out Number: Integer);
var
P: Integer;
begin
Ext := TPath.GetExtension(Input);
Stem := TPath.GetFileNameWithoutExtension(Input);
Number := 0;
P := Stem.LastIndexOf('_');
if P = -1 then begin
exit;
end;
if TryStrToInt(Stem.Substring(P+1), Number) then begin
Stem := Stem.Substring(0, P);
end;
end;
The following demonstrates how this works:
DecodeFileName('test.txt', Stem, Ext, Number);
Writeln(Stem, ', ', Number, ', ', Ext);
DecodeFileName('test_dd.txt', Stem, Ext, Number);
Writeln(Stem, ', ', Number, ', ', Ext);
DecodeFileName('test_23.txt', Stem, Ext, Number);
Writeln(Stem, ', ', Number, ', ', Ext);
The output is:
test, 0, .txt
test_dd, 0, .txt
test, 23, .txt
So now you can make a new filename like this:
function IncrementedFileName(const FileName: string): string;
var
Stem, Ext: string;
Number: Integer;
begin
DecodeFileName(FileName, Stem, Ext, Number);
Result := Format('%s_%d%s', [Stem, Number+1, Ext]);
end;
And then we can see how that performs:
Writeln(IncrementedFileName('test.txt'));
Writeln(IncrementedFileName('test_dd.txt'));
Writeln(IncrementedFileName('test_23.txt'));
Writeln(IncrementedFileName('test_28'));
The output is:
test_1.txt
test_dd_1.txt
test_24.txt
test_29
If you don't have access to the string helper methods then you can code it like this:
procedure DecodeFileName(const Input: string; out Stem, Ext: string; out Number: Integer);
var
P: Integer;
begin
Ext := TPath.GetExtension(Input);
Stem := TPath.GetFileNameWithoutExtension(Input);
Number := 0;
P := LastDelimiter('_', Stem);
if P = 0 then begin
exit;
end;
if TryStrToInt(Copy(Stem, P+1, MaxInt), Number) then begin
Stem := Copy(Stem, 1, P-1);
end;
end;
I have not executed this final function, so do not be surprised if it has errors.

How to read value of ParamStr with different deliminators?

When you read ParamStr(), it's deliminated by spaces between each parameter. However, I've seen many command-line arguments which accept a space between the parameter name and its paired value, while also accepting an equals = sign and even no deliminator (just prefixed with the param name) or no value.
Here's some examples of possible param strings:
-name value
/name value
-name=value
/name=value
-namevalue
/namevalue
-name -nextname
/name /nextname
-name="value with spaces"
/name="value with spaces"
...etc.
What I would like to do is two things both related... Check if a parameter name exists, and read the value of the parameter. For example...
if ParamExists('ParamName') then
SomeString:= ParamValue('ParamName')
else
SomeString:= 'SomeOtherString';
Is there something in Delphi which can do this? If not, how do I do this? Everything I find when searching for this just leads me to the same basic example:
for i := 0 to ParamCount do
ShowMessage(ParamStr(i));
It also needs to be case sensitive. I'm looking for something in particular like OSQL and similar command-line tools use where '-s' could be different from '-S'.
The problem is that if I use a space as a deliminator, I have no clue how to recognize when it's part of the previous parameter, because it splits them by spaces. How do I get around this?
I'm sure there's a standard term for this too, it's the common formatting of command-line arguments. But I don't know how to read them properly using just ParamStr. It seems ParamStr falls short of what it's usually used for.
To be clear, I don't necessarily need to support every above example - those are just examples I've seen before.
ParamStr() (and consequently FindCmdLineSwitch()) is not flexible enough to handle all of the examples you have shown. You will have to call the Win32 API GetCommandLine() function and parse it manually.
Ironically, just last night I wrote something for this, and just a little bit ago found this got up-voted. Here's a class I just wrote encapsulating this:
unit CmdLine;
(*
Command Line Parser
by Jerry Dodge
Class: TCmdLine
- Parses out a command line into individual name/value pairs
- Concatenates name/value pairs into a command line string
- Property "ModuleFilename" for the current executable path
- Property "OpenFilename" for the file to be opened, if any
- Default property "Values" to read/write name/value pairs
*)
interface
uses
System.Classes, System.SysUtils;
type
TCmdLine = class(TObject)
private
FItems: TStringList;
FModuleFilename: String;
FOpenFilename: String;
function GetAsString: String;
procedure SetAsString(const Value: String);
procedure SetModuleFilename(const Value: String);
procedure SetOpenFilename(const Value: String);
function GetValue(const Name: String): String;
procedure SetValue(const Name, Value: String);
function GetName(const Index: Integer): String;
public
constructor Create;
destructor Destroy; override;
function Count: Integer;
function Exists(const N: String; const IgnoreCase: Boolean = False): Boolean;
property ModuleFilename: String read FModuleFilename write SetModuleFilename;
property OpenFilename: String read FOpenFilename write SetOpenFilename;
property AsString: String read GetAsString write SetAsString;
property Names[const Index: Integer]: String read GetName;
property Values[const Name: String]: String read GetValue write SetValue; default;
end;
implementation
{ TCmdLine }
constructor TCmdLine.Create;
begin
FItems:= TStringList.Create;
end;
destructor TCmdLine.Destroy;
begin
FItems.Free;
inherited;
end;
function TCmdLine.Count: Integer;
begin
Result:= FItems.Count;
end;
function TCmdLine.Exists(const N: String; const IgnoreCase: Boolean = False): Boolean;
var
X: Integer;
begin
Result:= False;
for X := 0 to FItems.Count-1 do begin
if IgnoreCase then begin
if SameText(N, FItems.Names[X]) then begin
Result:= True;
Break;
end;
end else begin
if N = FItems.Names[X] then begin
Result:= True;
Break;
end;
end;
end;
end;
procedure TCmdLine.SetModuleFilename(const Value: String);
begin
FModuleFilename:= Value;
end;
procedure TCmdLine.SetOpenFilename(const Value: String);
begin
FOpenFilename:= Value;
end;
function TCmdLine.GetValue(const Name: String): String;
begin
Result:= FItems.Values[Name];
end;
procedure TCmdLine.SetValue(const Name, Value: String);
begin
FItems.Values[Name]:= Value;
end;
function TCmdLine.GetAsString: String;
var
X: Integer;
Cmd: String;
Val: String;
begin
Result:= '"'+FModuleFilename+'"';
if Trim(FOpenFilename) <> '' then
Result:= Result + ' "'+FOpenFilename+'"';
for X := 0 to FItems.Count-1 do begin
Cmd:= FItems.Names[X];
Val:= FItems.Values[Cmd];
Result:= Result + ' -'+Cmd;
if Trim(Val) <> '' then begin
Result:= Result + ' ';
if Pos(' ', Val) > 0 then
Result:= Result + '"'+Val+'"'
else
Result:= Result + Val;
end;
end;
end;
function TCmdLine.GetName(const Index: Integer): String;
begin
Result:= FItems.Names[Index];
end;
procedure TCmdLine.SetAsString(const Value: String);
var
Str: String;
Tmp: String;
Cmd: String;
Val: String;
P: Integer;
begin
FItems.Clear;
FModuleFilename:= '';
FOpenFilename:= '';
Str:= Trim(Value) + ' ';
//Extract module filename
P:= Pos('"', Str);
if P = 1 then begin
Delete(Str, 1, 1);
P:= Pos('"', Str);
Tmp:= Copy(Str, 1, P-1);
Delete(Str, 1, P);
FModuleFilename:= Tmp;
end else begin
P:= Pos(' ', Str);
Tmp:= Copy(Str, 1, P-1);
Delete(Str, 1, P);
FModuleFilename:= Tmp;
end;
Str:= Trim(Str) + ' ';
//Extract open filename
P:= Pos('"', Str);
if P = 1 then begin
Delete(Str, 1, 1);
P:= Pos('"', Str);
Tmp:= Copy(Str, 1, P-1);
Delete(Str, 1, P);
FOpenFilename:= Tmp;
end else begin
P:= Pos('-', Str);
if P < 1 then
P:= Pos('/', 'Str');
if P < 1 then begin
P:= Pos(' ', Str);
Tmp:= Copy(Str, 1, P-1);
Delete(Str, 1, P);
FOpenFilename:= Tmp;
end;
end;
Str:= Trim(Str) + ' ';
//Extract remaining param switches/values
while Length(Trim(Str)) > 0 do begin
P:= Pos('-', Str);
if P < 1 then
P:= Pos('/', 'Str');
if P > 0 then begin
Delete(Str, 1, 1);
P:= Pos(' ', Str);
Tmp:= Trim(Copy(Str, 1, P-1));
Delete(Str, 1, P);
if Pos('"', Tmp) = 1 then begin
Delete(Tmp, 1, 1);
P:= Pos('"', Tmp);
if P > 0 then
Delete(Tmp, 1, 1);
end;
Cmd:= Tmp;
Str:= Trim(Str) + ' ';
if (Pos('-', Str) <> 1) and (Pos('/', Str) <> 1) then begin
P:= Pos('"', Str);
if P = 1 then begin
Delete(Str, 1, 1);
P:= Pos('"', Str);
Tmp:= Copy(Str, 1, P-1);
Delete(Str, 1, P);
end else begin
P:= Pos(' ', Str);
Tmp:= Copy(Str, 1, P-1);
Delete(Str, 1, P);
end;
Val:= Tmp;
end else begin
Val:= '';
end;
if Val = '' then
Val:= ' ';
FItems.Values[Cmd]:= Val;
end else begin
Str:= '';
raise Exception.Create('Command line parameters malformed ('+Str+')');
end;
Str:= Trim(Str) + ' ';
end;
end;
end.
I just rewrite all my proposed answer in order to add some value to it, thank you for your comments:
function TForm1.ParamExists(sParamName: String;
bIgnoreCase: boolean; equalchar : string = '='): Boolean;
begin
if bIgnoreCase then
Result := Pos(sParamName + equalChar, cmdLine) > 0
else
Result := AnsiPos(sParamName + equalChar, cmdLine) > 0;
end;
function TForm1.ParamValue(sParamName : String; bIgnoreCase : boolean = false;
equalchar : string = '='; delimiter : string = '"'): String;
var
I : Integer;
scmdLine : String;
begin
Result := '';
scmdLine := cmdLine;
if bIgnoreCase then
I := Pos(sParamName, scmdLine)
else
I := AnsiPos(sParamName, scmdLine);
inc(I, Length(sParamName + equalchar));
delete(scmdLine, 1, I-1);
if pos(delimiter, scmdLine) = 1 then
begin
delete(scmdLine, 1, 1);
Result := copy(scmdLine,1, pos(delimiter, scmdLine) -1);
end
else
Result := copy(scmdLine,1, pos(' ', scmdLine));
end;
Supposing this parameters:
project1.exe -name1 value1 /name2 value2 -name3=value3 /name4=value4 -name5value5 /name6value6 -name7 -name8 /name9 /name91 -name10="Value 10" /name11="Value 11"
Example:
ParamExists('-Name1', False, ' '); --> False
ParamExists('-Name1', True, ' '); --> True, ignore case
ParamExists('-name1', False, ' '); --> True
ParamExists('-name1', False, '='); --> False there are no a = after -name1 parameter
ParamExists('-name6', False, ''); --> True this parameter use the form -parameterValue
ParameterValue example:
ParamValue('-name1', false, ' '); --> value1
ParamValue('/name2', false, ' '); --> value2
ParamValue('-name3'); --> value3, using default values
ParamValue('-name4'); --> value4, using default values
ParamValue('-name5', false, ''); --> value5
ParamValue('/name6', false, ''); --> value6
Notice that parameters -name7, -name8, /name9 and /name91 must be evaluated as ParamExists because there are no a value asigned to them.
ParamValue('-name10', false, '=', '"'); --> Value 10
same as:
ParamValue('-name10'); --> Value 10
ParamValue('/name11'); --> Value 11
I have the same problem I made this function it is simple and very useful
function GetCmdLineValue(CmdLine: string; Arg: string; Switch: Char; Separator: Char): string;
var
ArgIndex: Integer; // Index of Argument
SepIndex: Integer; // Index of Separator between Arg and Value ex "=" or ":"
NextSwitchIndex: Integer; // Index of the next Arg ex "-"
LenghtValue: Integer;
begin
ArgIndex:= CmdLine.IndexOf(Arg);
SepIndex:= CmdLine.IndexOf(Separator, ArgIndex);
NextSwitchIndex:= CmdLine.IndexOf(Switch, ArgIndex+1);
{ No Value found then Exit }
// no separator found
if (SepIndex = -1) or
// the separator is located after the next switch
( SepIndex > NextSwitchIndex) and (NextSwitchIndex > -1) then Exit('');
if NextSwitchIndex = -1 then // No switch after Arg
LenghtValue:= CmdLine.Length - SepIndex+2
else
LenghtValue:= NextSwitchIndex - SepIndex-1;
Result:= Copy(CmdLine, SepIndex+2, LenghtValue).Trim;
end;
Demo
uses:
procedure TForm1.Button1Click(Sender: TObject);
begin
edt_Value.Text:= GetCmdLineValue(edt_CmdLine.Text, edt_Argum.Text, '-', '=');
end;

Resources