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;
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
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')));
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.
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;