Delphi How to parse specified values from HTTP get - delphi

procedure TMainForm.btn1Click(Sender: TObject);
var
lHTTP: TIdHTTP;
begin
lHTTP := TIdHTTP.Create(nil);
try
mmo1.Text := lHTTP.Get('http://guessit.io/guess?filename=House.of.Cards.2013.S02E03.1080p.NF.WEBRip.DD5.1.x264-NTb.mkv');
finally
lHTTP.Free;
end;
end;
the result will be like that:
{
"series":"House of Cards",
"episodeNumber":3,
"releaseGroup":"NTb",
"format":"WEBRip",
"season":2,
"audioCodec":"DolbyDigital",
"year":2013,
"mimetype":"video/x-matroska",
"container":"mkv",
"videoCodec":"h264",
"other":[
"Netflix"
],
"audioChannels":"5.1",
"screenSize":"1080p",
"type":"episode"
}
how i can read the series ("series": "House of Cards") value for example.
i try to use
Function ExtractBetweenTags(Const Line, TagI, TagF: string): string;
var
i, f : integer;
begin
i := Pos(TagI, Line);
f := Pos(TagF, Copy(Line, i+length(TagI), MAXINT));
if (i > 0) and (f > 0) then
Result:= Copy(Line, i+length(TagI), f-1);
end;
mmo1.Text := StringReplace(ExtractBetweenTags(mmo1.Text,'"series": "','"'), ' ', '-',[rfReplaceAll, rfIgnoreCase]);
but i need to parsing all the values automatically

You might use DBXJSON contained in Delphi since Delphi 2010, an other option could be to use e.g. SuperObject.
Since your shown example is a simple JSON String without nesting you might access the cointained values by just interating over a TJSONObject acessing as TJSONArray.
This array consists of Pairs of "Name" and the value.
An simple example shown with the string you provided:
uses
DBXJSON;
procedure TForm7.Button1Click(Sender: TObject);
var
S:String;
I:Integer;
JObj:TJSONObject;
Pair : TJSONPair;
begin
s := '{"series": "House of Cards", "episodeNumber": 3, "releaseGroup": "NTb", "format": "WEBRip", "season": 2'
+', "audioCodec": "DolbyDigital", "year": 2013, "mimetype": "video/x-matroska", "container": "mkv", "videoCodec": "h264", "other": ["Netflix"], "audioChannels":
"5.1", "screenSize": "1080p", "type": "episode"}';
JObj := TJSONObject.ParseJSONValue(s) as TJSONObject;
for I := 0 to TJSONArray(JObj).Size - 1 do
begin
Pair := TJSONPair(TJSONArray(JObj).Get(i));
Memo1.Lines.Add( Pair.JsonString.Value + '=' + Pair.JsonValue.ToString)
end;
end;

You can parse the object with class like this:
uses System.JSON, Rest.JSON;
type
TGuess = class(TObject)
public
fseries: string;
fepisodeNumber: integer;
freleaseGroup: string;
fformat: string;
fseason: integer;
faudioCodec: string;
fyear: integer;
fmimetype: string;
fcontainer: string;
fvideoCodec: string;
fother: TArray<string>;
faudioChannels: string;
fscreenSize: string;
ftype: string;
end;
var
g: TGuess;
s: string; // your input string
// g object will be created by following call and will contain parsed values
g := TJson.JsonToObject<TGuess>(s);
// do something with g
// release g after it is no longer needed
g.Free;

Thanks for all the answers but here what i finally figure it out
procedure TMainForm.btn1Click(Sender: TObject);
var
S : String;
NS , S1,S2,series,season,episodeNumber : String;
L , I , LN : integer;
MM :TStringList;
begin
try
MM := TStringList.Create;
NS := '';
S := '{"series": "House of Cards", "episodeNumber": 3, "releaseGroup": "NTb", "format":'+
'"WEBRip", "season": 2, "audioCodec": "DolbyDigital", "year": 2013, "mimetype": "video/x-matroska", "container": "mkv",'+
'"videoCodec": "h264", "other": ["Netflix"], "audioChannels": "5.1", "screenSize": "1080p", "type": "episode"}';
{if AnsiPos('title',s) <> 0 then
IsMovie := True
else
IsMovie := False;}
L := Length(S);
for I := 1 to L do
Begin
If (Ord(S[I]) <> 34)
And (Ord(S[I]) <> 123)
And (Ord(S[I]) <> 125)
Then NS := NS + Copy(S,I,1);
End;
S := NS;
NS := '';
L := Length(S);
for I := 1 to L do
Begin
If (Ord(S[I]) = 44)
Or (Ord(S[I]) = 58)
Then Begin
NS := NS + #13#10;
MM.Add(Trim(NS));
NS := '';
End
Else NS := NS + Copy(S,I,1);
End;
MM.Add(Trim(NS));
// --------------------------------------------------------------
LN := MM.Count-1;
for I := 0 to LN Do
Begin
If MM[I] = Trim('series')
Then series := Trim(MM[I + 1]);
If MM[I] = Trim('season')
Then season := Trim(MM[I + 1]);
If MM[I] = Trim('episodeNumber')
Then episodeNumber := Trim(MM[I + 1]);
End;
ShowMessage(series+'.S'+season+'.E'+episodeNumber);
finally
MM.Free
end;
end;

Related

How to fill TListView with TJSONIterator.Next?

I have an app with a TListView and I want to populate data from JSON inside its Items by using TJSONIterator.Next(). The code I use displays the results I want, except for the first one.
How can I parse these JSON objects correctly, what am I doing wrong?
Data: Data.json
{
"event":"subscribe-status",
"status":"ok",
"success":[
{
"symbol":"EUR/USD",
"exchange":"PHYSICAL CURRENCY",
"mic_code":"PHYSICAL CURRENCY",
"country":"",
"type":"Physical Currency"
},
{
"symbol":"USD/JPY",
"exchange":"PHYSICAL CURRENCY",
"mic_code":"PHYSICAL CURRENCY",
"country":"",
"type":"Physical Currency"
},
{
"symbol":"BTC/USD",
"exchange":"Coinbase Pro",
"mic_code":"Coinbase Pro",
"country":"",
"type":"Digital Currency"
},
{
"symbol":"ETH/BTC",
"exchange":"Huobi",
"mic_code":"Huobi",
"country":"",
"type":"Digital Currency"
}
],
"fails":null
}
Code app:
LStringReader := TStreamReader.Create('../../Data.json', TEncoding.UTF8, True);
LJsonTextReader := TJsonTextReader.Create(LStringReader);
LIterator := TJSONIterator.Create(LJsonTextReader);
NObjJSON := LIterator.AsInteger;
ListView1.Items.Clear;
ListView1.BeginUpdate;
try
while True do
begin
while LIterator.Next do
begin
if LIterator.&Type in [TJsonToken.StartObject, TJsonToken.StartArray] then
begin
LIterator.Recurse;
LIterator.Next;
oItem := ListView1.Items.Add;
for NObjJSON := 0 to ListView1.ItemCount -1 do
begin
oItem.Text := 'Object #' + NObjJSON.ToString + ' ' + LIterator.AsValue.ToString;
oItem.Detail := 'Key:' +LIterator.Key;
end
end;
end;
if LIterator.InRecurse then
LIterator.Return
else
Break;
end;
finally
ListView1.EndUpdate;
LIterator.Free;
LJsonTextReader.Free;
lStringReader.Free;
Memo1.Lines.Text := NObjJSON.ToString;
end;
Add this recurse / next at beginning of your loop to prepare to enter array :
while LIterator.Next do
begin
if LIterator.&Type = TJsonToken.StartArray then
begin
LIterator.Recurse;
LIterator.Next;
end;
You can check this exemple in the doc : https://docwiki.embarcadero.com/CodeExamples/Sydney/en/RTL.JSONIterator
The code below is easier to read :
procedure TFormX.LoadJSON;
const
cValue = 'symbol';
var
LValue: TJSONValue;
LArray: TJSONArray;
i: integer;
oItem: TListViewItem;
begin
LValue := TJSONObject.ParseJSONValue('{json}');
LArray := LValue.FindValue('success') as TJSONArray;
if Assigned(LArray) then
begin
for i := 0 to LArray.Count - 1 do
begin
oItem := ListView1.Items.Add;
oItem.Text := 'Object #' + i.ToString + ' ' + LArray.Items[i].GetValue<string>(cValue);
oItem.Detail := 'Key:' + cValue;
end;
end;
end;
After all, i found the correct solution:*
var
LIterator: TJSONIterator;
LJsonTextReader: TJsonTextReader;
LStringReader: TStreamReader;
NObjJSON: Integer;
begin
LStringReader := TStreamReader.Create('../../Data.json', TEncoding.UTF8, True);
LJsonTextReader := TJsonTextReader.Create(LStringReader);
LIterator := TJSONIterator.Create(LJsonTextReader);
NObjJSON := LIterator.AsInteger;
ListView1.Items.Clear;
ListView1.BeginUpdate;
try
while True do
begin
while LIterator.Next do
begin
if LIterator.&Type in [TJsonToken.StartObject, TJsonToken.StartArray] then
begin
Memo1.Lines.Add(LIterator.Key);
LIterator.Recurse;
end
else if LIterator.Path = 'success['+NObjJSON.ToString+'].symbol' then
begin
Memo1.Lines.Add(LIterator.AsValue.ToString);
oItem := ListView1.Items.Add;
for NObjJSON := 0 to ListView1.ItemCount -1 do
oItem.Text := 'Object #' + NObjJSON.ToString + ' ' + LIterator.AsValue.ToString;
end
end;
if LIterator.InRecurse then
LIterator.Return
else
Break;
end;
finally
ListView1.EndUpdate;
LIterator.Free;
LJsonTextReader.Free;
LStringReader.Free;
end;
end;
NObjJSON is used to count the number of objects inside array and it returns 4.
You can use a simple integer (I) and replace "for NObjJSON := 0 to ListView1.ItemCount -1 do" by for I := 0 to ListView1.ItemCount -1 do but the number of objects will return 0.

Parse Url querystring with delphi 5

I have this string:
Called=%2B12608883475&ToState=IN&CallerCountry=US&Direction=inbound&CallerState=IN&ToZip=&CallSid=CAb7faaa30058c2347a595630f2475113a&To=%2B12608883475&CallerZip=
I would like to parse it by & to get all the parameters out and then sort the parameters in an alphabetical case-sensitive order.
All of this has to be done in Delphi 5:
Function TwilioSignatureValidate(twilioSignature: string; QueryString: string ; Url: string): boolean;
begin
parameters := QueryString;
List := TStringList.Create;
end;
Here is the C# version that I want to copy:
string input = "Called=%2B12608883475&ToState=IN&CallerCountry=US&Direction=inbound&CallerState=IN&ToZip=&CallSid=CAb7faaa30058c2347a595630f2475113a&To=%2B12608883475&CallerZip=";
Dictionary<string,string> keyValuePairs = input.Split('&')
.Select(value => value.Split('='))
.ToDictionary(pair => pair[0], pair => pair[1]);
string studentId = keyValuePairs["StudentId"];
Using List.Sort;
I got my Delphi List To sort alphebetically but its not in using Unix-style case-sensitive sorting order:
//Delphi Sort
https://ffbc1360.ngrok.io
AccountSidACc6d06b4cb61ccbfa61bf461957a5a626
ApiVersion2010-04-01
Called+12608883475
CalledCity
CalledCountryUS
CalledStateIN
CalledZip
Caller+12602060582
CallerCity
CallerCountryUS
CallerStateIN
CallerZip
CallSidCAb7faaa30058c2347a595630f2475113a
CallStatusringing
Directioninbound
From+12602060582
FromCity
FromCountryUS
FromStateIN
FromZip
To+12608883475
ToCity
ToCountryUS
ToStateIN
ToZip
//Correct c# Sort
https://ffbc1360.ngrok.io
AccountSidACc6d06b4cb61ccbfa61bf461957a5a626
ApiVersion2010-04-01
CallSidCAb7faaa30058c2347a595630f2475113a
CallStatusringing
Called+12608883475
CalledCity
CalledCountryUS
CalledStateIN
CalledZip
Caller+12602060582
CallerCity
CallerCountry
USCaller
StateIN
CallerZip
Directioninbound
From+12602060582
FromCity
FromCountryUS
FromStateIN
FromZip
To+12608883475
ToCity
ToCountryUS
ToStateIN
ToZip
TStringList in Delphi 6 and later has Delimiter, DelimitedText, and CaseSensitive properties. Set the Delimiter to '&' and then assign the query string to DelimitedText, then you can use the Values[] property to extract values by name (since the resulting delimited strings are already in name=value format). No sorting is needed:
Function TwilioSignatureValidate(twilioSignature: string; QueryString: string ; Url: string): boolean;
var
List: TStringList;
begin
List := TStringList.Create;
try
List.Delimiter := '&';
List.DelimitedText := QueryString;
List.CaseSensitive := True;
// use List.Values['param name'] as needed, eg:
// List.Values['Called']
// List.Values['ToState']
// List.Values['CallerCountry']
// List.Values['Direction']
// List.Values['CallerState']
// List.Values['ToZip']
// List.Values['CallSid']
// List.Values['To']
// List.Values['CallerZip']
finally
List.Free;
end;
end;
However, in Delphi 5, none of those properties existed yet, so you will have to do everything manually:
Function TwilioSignatureValidate(twilioSignature: string; QueryString: string ; Url: string): boolean;
var
List: TStringList;
// the following are tweaked from TStrings in later Delphi versions...
procedure MySetDelimitedText(const Value: string);
var
P, P1: PChar;
S: string;
begin
List.BeginUpdate;
try
List.Clear;
P := PChar(Value);
while P^ <> #0 do
begin
if P^ = '"' then
S := AnsiExtractQuotedStr(P, '"')
else
begin
P1 := P;
while (P^ <> #0) and (P^ <> '&') do
P := CharNext(P);
SetString(S, P1, P - P1);
end;
List.Add(S);
if P^ = '&' then
begin
P := CharNext(P);
if P^ = #0 then
List.Add('');
end;
end;
finally
List.EndUpdate;
end;
end;
function MyIndexOfName(const Name: string): Integer;
var
P: Integer;
S: string;
begin
for Result := 0 to List.Count - 1 do
begin
S := List.Strings[Result];
P := AnsiPos('=', S);
if (P <> 0) and (AnsiCompareStr(Copy(S, 1, P - 1), Name) = 0) then Exit;
end;
Result := -1;
end;
function MyGetValue(const Name: string): string;
var
I: Integer;
begin
I := MyIndexOfName(Name);
if I >= 0 then
Result := Copy(List.Strings[I], Length(Name) + 2, MaxInt) else
Result := '';
end;
begin
List := TStringList.Create;
try
MySetDelimitedText(QueryString);
// use MyGetValue('param name') as needed, eg:
// MyGetValue('Called')
// MyGetValue('ToState')
// MyGetValue('CallerCountry')
// MyGetValue('Direction')
// MyGetValue('CallerState')
// MyGetValue('ToZip')
// MyGetValue('CallSid')
// MyGetValue('To')
// MyGetValue('CallerZip')
finally
List.Free;
end;
end;

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;

Delphi/pascal Parse a string to a combobox

I'm trying to parse a string (sys) that looks exactly like this
-1|low
0|normal
1|high
I need to pair them in a combo box, where for example, low is the caption and -1 will be the value. What is the best way to do this? What I have so far is:
var
sys : String;
InputLine : TStringList;
InputLine := TStringList.Create;
InputLine.Delimiter := '|';
InputLine.DelimitedText := sys;
Combobox1.items.AddStrings(InputLine);
FreeAndNil(InputLine)
This gives each line of the combo box as such:
-1
low
0
normal
1
high
Parse it manually yourself.
var
SL: TStringList;
StrVal: string;
IntVal: Integer;
Line: string;
DividerPos: Integer;
begin
SL := TStringList.Create;
try
SL.LoadFromFile('Whatever.txt');
for Line in SL do
begin
DividerPos := Pos('|', Line);
if DividerPos > 0 then
begin
StrVal := Copy(Line, DividerPos + 1, Length(Line));
IntVal := StrToInt(Copy(Line, 1, DividerPos - 1));
ComboBox1.Items.AddObject(StrVal, TObject(IntVal));
end;
end
finally
SL.Free;
end;
end;
To retrieve the value from a selected item:
if (ComboBox1.ItemIndex <> -1) then
SelVal := Integer(ComboBox1.Items.Objects[ComboBox1.ItemIndex]);

How to insert character in all possible positions of a string?

I want to insert a char into every possible position of s string except start and end.
e.g.
abc
I want to have
a-bc
ab-c
a-b-c
Below is my test, but not correct:
procedure TForm1.Button2Click(Sender: TObject);
var
start, i,j,k,position,loop: integer;
laststart,lastend:integer;
c,item,stem:string;
str, prefix:string;
begin
str:='abcd';
memo1.clear;
memo1.Lines.Add(str);
laststart:=0;
lastend:=memo1.lines.count-1;
position:=0;
prefix:='';
loop:=0;
while loop<=length(str)-1 do
begin
for j:= laststart to lastend do
begin
item:=memo1.lines[j];
for k:=length(item) downto 1 do
begin
if item[k]='-' then
begin
position:=j;
break;
end;
end; //for k
prefix:=copy(item,1,position);
stem:=copy(item,position+1, length(item));
for start:=1 to length(stem)-1 do
begin
c:=prefix+copy(stem,1,start)+'-'+
copy(stem, start+1,length(stem));
memo1.lines.add(c);
end;
end; //for j
laststart:=lastend+1;
lastend:=memo1.Lines.Count-1;
inc(loop);
end; //end while
end;
it outputs:
abcd
a-bcd
ab-cd
abc-d
a--bcd // not correct
a-b-cd
a-bc-d
ab--cd //incorrect
ab-c-d
abc--d //incorrect
a--bc-d //incorrect
I feel the maximum possible breaks is lenth(str)-1, abc->most possible is insert 2 '-' (twice). Is this correct?
And are there other faster ways to do it?
Thanks a lot.
Recursive version.
procedure InsertSymbols(s: string; c: Char; Position: Integer = 1);
var
i: Integer;
begin
Memo1.Lines.Add(s);
for i := Position to Length(s) - 1 do
InsertSymbols(Copy(s, 1, i) + c + Copy(s, i + 1, Length(s) - i), c, i + 2);
end;
begin
InsertSymbols('Test', '-');
end;
This works:
procedure TForm4.Button1Click(Sender: TObject);
var
S: string;
N: integer;
Marker: cardinal;
MaxMarker: cardinal;
Str: string;
i: Integer;
begin
S := Edit1.Text;
N := length(S);
Marker := 0;
MaxMarker := 1 shl (N - 1) - 1;
Memo1.Clear;
Memo1.Lines.BeginUpdate;
for Marker := 0 to MaxMarker do
begin
Str := S[1];
for i := 2 to N do
begin
if (Marker shr (N-i)) and 1 <> 0 then
Str := Str + '-';
Str := Str + S[i];
end;
Memo1.Lines.Add(Str);
end;
Memo1.Lines.EndUpdate;
end;
As you can see, it works by using binary representation of numbers:
t e s t
0 0 0
0 0 1
0 1 0
0 1 1
1 0 0
1 0 1
1 1 0
1 1 1
Why all the difficult solutions?
Just copy the string to a new one char by char, add hyphens in between, except for the last one.
I needed to separate a string to use as a serial number and here is the code:
Function GetDashedKey(Key: string): string
const
PartSize = 7;
var
Indx: Integer;
dashedKey : string;
begin
repeat
if Trim(dashedKey)<>'' then
dashedKey := dashedKey + ' - ';
if Length(Key) < PartSize then
begin
dashedKey := dashedKey + Key;
Key := '';
end
else
begin
dashedKey := dashedKey + Copy(Key, 1, PartSize);
Key := Copy(Key, PartSize + 1, Length(Key)-1);
end;
until Trim(Key) = '';
Result := dashedKey;
end;

Resources