How to split the string in delphi - delphi

I just need to split a string like: "STANS", "Payment, chk#1", ,1210.000 into an array based on ,. The result in the string list would be
STANS
Payment, chk#1
1210.000

Create a TStringList and assign your comma separated string to StringList.CommaText. This parses your input and returns the split strings as the items of the string list.
StringList.CommaText := '"STANS", "Payment, chk# 1", ,1210.000';
//StringList[0]='STANS'
//StringList[1]='Payment, chk# 1'
//etc.

I wrote this function and works perfect for me in Delphi 2007
function ParseCSV(const S: string; ADelimiter: Char = ','; AQuoteChar: Char = '"'): TStrings;
type
TState = (sNone, sBegin, sEnd);
var
I: Integer;
state: TState;
token: string;
procedure AddToResult;
begin
if (token <> '') and (token[1] = AQuoteChar) then
begin
Delete(token, 1, 1);
Delete(token, Length(token), 1);
end;
Result.Add(token);
token := '';
end;
begin
Result := TstringList.Create;
state := sNone;
token := '';
I := 1;
while I <= Length(S) do
begin
case state of
sNone:
begin
if S[I] = ADelimiter then
begin
token := '';
AddToResult;
Inc(I);
Continue;
end;
state := sBegin;
end;
sBegin:
begin
if S[I] = ADelimiter then
if (token <> '') and (token[1] <> AQuoteChar) then
begin
state := sEnd;
Continue;
end;
if S[I] = AQuoteChar then
if (I = Length(S)) or (S[I + 1] = ADelimiter) then
state := sEnd;
end;
sEnd:
begin
state := sNone;
AddToResult;
Inc(I);
Continue;
end;
end;
token := token + S[I];
Inc(I);
end;
if token <> '' then
AddToResult;
if S[Length(S)] = ADelimiter then
AddToResult
end;

Related

How to search for different occurences of strings using POS

I'm trying to create a function that is similar to Delphi's pos function, but that i could pass different strings to be searched, instead of only one. So i could call the function like this :
multipos('word1#word2#word3','this is a sample text with word2',false);
// will return 'word2'
The function would return which string was found.
The code i did is below and it's working but it's too slow. How could i improve the speed of this code ?
function multipos(needles,key: string; requireAll: boolean): string;
var
k: array [1 .. 50] of string;
i, j: integer;
r, aux: string;
flag: boolean;
begin
if trim(key) = '' then
Result := ''
else
try
r := '';
Result := '';
j := 1;
for i := 1 to 50 do
k[i] := '';
for i := 1 to length(needles) do
begin
if needles[i] <> '#' then
aux := aux + needles[i]
else
begin
k[j] := aux;
Inc(j);
aux := '';
end;
if j >= 50 then
break;
end;
if aux <> '' then
k[j] := aux;
for i := 1 to j do
begin
if k[i] = '' then
break
else
if pos(lowercase(k[i]), lowercase(key)) > 0 then
begin
if not requireAll then
begin
Result := k[i];
break;
end
else
begin
r := r + k[i] + ',';
flag := i = j;
if not flag then
flag := k[i + 1] = '';
if flag then
begin
Result := r;
end;
end;
end
else
if requireAll then
begin
break;
end;
end;
except
on e: exception do
begin
Result := '';
end;
end;
end;
Consider to pass the items as an array, like:
function Multipos(const A: array of string; const S: string): string;
begin
for var E in A do
if Pos(E, S) > 0 then
Exit(E);
Result := ''; // Nothing found
end;
// sample calls
Multipos(['word1', 'word2', 'word3'], 'sample text with word2');
Multipos('word1#word2#word3'.Split(['#']), 'sample text with word2');
To implement RequireAll functionality, stop on first failure. Just check what to return in that case.
Also, TStrings/TStringList could work for your needs. Check it's Delimiter and DelimitedText properties.
As you didn't specify a Delphi version, I simply assume the latest:
function multipos(const needles,key: string; requireAll: boolean): string;
var
lst: TStringList;
begin
lst := TStringList.Create;
try
var lowerkey := key.ToLower; // do this only once
for var needle in needles.Split(['#']) do begin
if lowerkey.Contains(needle.ToLower) then begin
if not requireAll then
Exit(needle);
lst.Add(needle);
end;
end;
Result := lst.CommaText;
finally
lst.Free;
end;
end;
The array solution by Marcodor is good. Here is a TStringList alternative:
function multipos(SubStrs: TStringList; Str: string; RequireAll: Boolean): string;
var
i: Integer;
begin
if (not Str.IsEmpty) and (not SubStrs.Count < 1) then
begin
Result := '';
for i := 0 to SubStrs.Count - 1 do
if Pos(SubStrs[i], Str) > 0 then
Result := Result + Copy(Str, Pos(SubStrs[i], Str), SubStrs[i].Length)
else if RequireAll then
Result := '';
end;
end;
var
myList: TStringList;
begin
myList := TStringList.Create;
myList.Delimiter := '#';
myList.DelimitedText := 'word1#word2#word3';
Writeln(multipos(myList, 'this word1is a sample word3 text with word2', False));
end.
Obviously you'll need system.classes for the StringList. And perhaps some better checking if everything is in order before accessing the parameters, but it works for RequireAll True and False.

As a set is not assignment-compatible with a TValue, how do I represent a set using a TValue?

I have a string '[Top,Left,Bottom,Right]' that I want to convert to a set. For this I have the function StringToSet located in System.TypInfo But what I don't know is how I can assign the result of StringToSet to a tvalue (or any other way to convert '[Top,Left,Bottom,Right]' to a tvalue) ?
the code of the delphi StringToSet function:
function StringToSet(TypeInfo: PTypeInfo; const Value: string): Integer;
var
P: PChar;
EnumName: string;
EnumValue: NativeInt;
PEnumInfo: PPTypeInfo;
// grab the next enum name
function NextWord(var P: PChar): string;
var
i: Integer;
begin
i := 0;
// scan til whitespace
while not (P[i] in [',', ' ', #0,']']) do
Inc(i);
SetString(Result, P, i);
// skip whitespace
while (P[i] in [',', ' ',']']) do
Inc(i);
Inc(P, i);
end;
begin
Result := 0;
if Value = '' then Exit;
P := PChar(Value);
// skip leading bracket and whitespace
while (P^ in ['[',' ']) do
Inc(P);
PEnumInfo := GetTypeData(TypeInfo)^.CompType;
if PEnumInfo <> nil then
begin
EnumName := NextWord(P);
while EnumName <> '' do
begin
EnumValue := GetEnumValue(PEnumInfo^, EnumName);
if EnumValue < 0 then
raise EPropertyConvertError.CreateResFmt(#SInvalidPropertyElement, [EnumName]);
Include(TIntegerSet(Result), enumvalue);
EnumName := NextWord(P);
end;
end
else
begin
EnumName := NextWord(P);
while EnumName <> '' do
begin
EnumValue := StrToIntDef(EnumName, -1);
if EnumValue < 0 then
raise EPropertyConvertError.CreateResFmt(#SInvalidPropertyElement, [EnumName]);
Include(TIntegerSet(Result), enumvalue);
EnumName := NextWord(P);
end;
end;
end;

epson code misread as string output

Printing using Epson codes in Delphi Tokyo.
Function PrintRawData (built in to Winapi.Winspool library) appears to misread codes like 'ESC C' or 'ESC #' and prints 'C' and '#' instead of the prompts associated with said codes (Select page length & Initialise Printer).
procedure TFrmPrint.PageLen(hPrn : THandle); // Page length in Inches
var
Commalist : Array[1..20] of SmallInt;
istart, icomma, i : SmallInt;
ss, cr : UTF8String;
def : UTF8String;
Data : Array [0..255] of AnsiChar;
begin
ss := '';
cr := ' ';
cr[1] := #13; cr[2] := #10;
if not DM2.Q_PRNGen.Locate('PrAction','PAGELENIN',[loCaseInsensitive]) then
begin
ShowMessage('PAGELENIN Action not coded for Printer');
exit;
end;
ss := Trim(DM2.Q_PRNGen.Fields.FieldByName('ESCCODE').AsString);
icomma := 0;
istart := 1;
for i:=1 to Length(ss) do
begin
if ss[i] = ',' then
begin
inc(icomma);
Commalist[icomma] := StrToIntDef(Copy(ss,istart,i-istart),0);
istart := i + 1;
end;
end;
inc(icomma);
i := Length(ss);
Commalist[icomma] := StrToIntDef(Copy(ss,istart,i-istart+1),0);
def := '';
for i:=1 to icomma do
begin
def := def + ' ';
def[i] := AnsiChar(CommaList[i]);
// def := Def + IntToHex(CommaList[i],1);
end;
// ss := def + cr;
ss := def;
for i:=1 to Length(ss) do Data[i-1] := AnsiChar(ss[i]);
if frmPrint.PrintRawData(hPrn,#Data,Length(ss)) < 0 then
begin
ShowMessage('PrintRawData Failed');
frmPrint.EndRawPrintPage(hPrn);
frmPrint.EndRawPrintJob(hPrn);
exit;
end;
end;
It is under my assumption that the error lies within PrintRawData.
PrintRawData is listed here:
function TFrmPrint.PrintRawData(hPrn : THandle; Buffer : pointer; NumBytes : SpoolInt) : integer;
var
BytesWritten : DWORD;
begin
if NumBytes = 0 then
begin
Result := 1;
exit;
end;
if not WritePrinter(hPrn, Buffer, NumBytes, BytesWritten) then
begin
Result := -1;
exit;
end;
if NumBytes <> BytesWritten then
begin
Result := -1;
exit;
end;
Result := 1;
end;

Split a string into an array of strings based on a delimiter

I'm trying to find a Delphi function that will split an input string into an array of strings based on a delimiter. I've found a lot from searching the web, but all seem to have their own issues and I haven't been able to get any of them to work.
I just need to split a string like:
"word:doc,txt,docx" into an array based on ':'. The result would be
['word', 'doc,txt,docx']. How can I do that?
you can use the TStrings.DelimitedText property for split an string
check this sample
program Project28;
{$APPTYPE CONSOLE}
uses
Classes,
SysUtils;
procedure Split(Delimiter: Char; Str: string; ListOfStrings: TStrings) ;
begin
ListOfStrings.Clear;
ListOfStrings.Delimiter := Delimiter;
ListOfStrings.StrictDelimiter := True; // Requires D2006 or newer.
ListOfStrings.DelimitedText := Str;
end;
var
OutPutList: TStringList;
begin
OutPutList := TStringList.Create;
try
Split(':', 'word:doc,txt,docx', OutPutList) ;
Writeln(OutPutList.Text);
Readln;
finally
OutPutList.Free;
end;
end.
UPDATE
See this link for an explanation of StrictDelimiter.
There is no need for engineering a Split function. It already exists, see: Classes.ExtractStrings.
Use it in a following manner:
program Project1;
{$APPTYPE CONSOLE}
uses
Classes;
var
List: TStrings;
begin
List := TStringList.Create;
try
ExtractStrings([':'], [], PChar('word:doc,txt,docx'), List);
WriteLn(List.Text);
ReadLn;
finally
List.Free;
end;
end.
And to answer the question fully; List represents the desired array with the elements:
List[0] = 'word'
List[1] = 'doc,txt,docx'
You can use StrUtils.SplitString.
function SplitString(const S, Delimiters: string): TStringDynArray;
Its description from the documentation:
Splits a string into different parts delimited by the specified
delimiter characters.
SplitString splits a string into different parts delimited by the specified delimiter characters. S is the string to be split.
Delimiters is a string containing the characters defined as delimiters.
SplitString returns an array of strings of type System.Types.TStringDynArray that contains the split parts of the
original string.
Using the SysUtils.TStringHelper.Split function, introduced in Delphi XE3:
var
MyString: String;
Splitted: TArray<String>;
begin
MyString := 'word:doc,txt,docx';
Splitted := MyString.Split([':']);
end.
This will split a string with a given delimiter into an array of strings.
I always use something similar to this:
Uses
StrUtils, Classes;
Var
Str, Delimiter : String;
begin
// Str is the input string, Delimiter is the delimiter
With TStringList.Create Do
try
Text := ReplaceText(S,Delim,#13#10);
// From here on and until "finally", your desired result strings are
// in strings[0].. strings[Count-1)
finally
Free; //Clean everything up, and liberate your memory ;-)
end;
end;
Similar to the Explode() function offered by Mef, but with a couple of differences (one of which I consider a bug fix):
type
TArrayOfString = array of String;
function SplitString(const aSeparator, aString: String; aMax: Integer = 0): TArrayOfString;
var
i, strt, cnt: Integer;
sepLen: Integer;
procedure AddString(aEnd: Integer = -1);
var
endPos: Integer;
begin
if (aEnd = -1) then
endPos := i
else
endPos := aEnd + 1;
if (strt < endPos) then
result[cnt] := Copy(aString, strt, endPos - strt)
else
result[cnt] := '';
Inc(cnt);
end;
begin
if (aString = '') or (aMax < 0) then
begin
SetLength(result, 0);
EXIT;
end;
if (aSeparator = '') then
begin
SetLength(result, 1);
result[0] := aString;
EXIT;
end;
sepLen := Length(aSeparator);
SetLength(result, (Length(aString) div sepLen) + 1);
i := 1;
strt := i;
cnt := 0;
while (i <= (Length(aString)- sepLen + 1)) do
begin
if (aString[i] = aSeparator[1]) then
if (Copy(aString, i, sepLen) = aSeparator) then
begin
AddString;
if (cnt = aMax) then
begin
SetLength(result, cnt);
EXIT;
end;
Inc(i, sepLen - 1);
strt := i + 1;
end;
Inc(i);
end;
AddString(Length(aString));
SetLength(result, cnt);
end;
Differences:
aMax parameter limits the number of strings to be returned
If the input string is terminated by a separator then a nominal "empty" final string is deemed to exist
Examples:
SplitString(':', 'abc') returns : result[0] = abc
SplitString(':', 'a:b:c:') returns : result[0] = a
result[1] = b
result[2] = c
result[3] = <empty string>
SplitString(':', 'a:b:c:', 2) returns: result[0] = a
result[1] = b
It is the trailing separator and notional "empty final element" that I consider the bug fix.
I also incorporated the memory allocation change I suggested, with refinement (I mistakenly suggested the input string might at most contain 50% separators, but it could conceivably of course consist of 100% separator strings, yielding an array of empty elements!)
Explode is very high speed function, source alhoritm get from TStrings component.
I use next test for explode:
Explode 134217733 bytes of data, i get 19173962 elements, time of work: 2984 ms.
Implode is very low speed function, but i write it easy.
{ ****************************************************************************** }
{ Explode/Implode (String <> String array) }
{ ****************************************************************************** }
function Explode(S: String; Delimiter: Char): Strings; overload;
var I, C: Integer; P, P1: PChar;
begin
SetLength(Result, 0);
if Length(S) = 0 then Exit;
P:=PChar(S+Delimiter); C:=0;
while P^ <> #0 do begin
P1:=P;
while (P^ <> Delimiter) do P:=CharNext(P);
Inc(C);
while P^ in [#1..' '] do P:=CharNext(P);
if P^ = Delimiter then begin
repeat
P:=CharNext(P);
until not (P^ in [#1..' ']);
end;
end;
SetLength(Result, C);
P:=PChar(S+Delimiter); I:=-1;
while P^ <> #0 do begin
P1:=P;
while (P^ <> Delimiter) do P:=CharNext(P);
Inc(I); SetString(Result[I], P1, P-P1);
while P^ in [#1..' '] do P:=CharNext(P);
if P^ = Delimiter then begin
repeat
P:=CharNext(P);
until not (P^ in [#1..' ']);
end;
end;
end;
function Explode(S: String; Delimiter: Char; Index: Integer): String; overload;
var I: Integer; P, P1: PChar;
begin
if Length(S) = 0 then Exit;
P:=PChar(S+Delimiter); I:=1;
while P^ <> #0 do begin
P1:=P;
while (P^ <> Delimiter) do P:=CharNext(P);
SetString(Result, P1, P-P1);
if (I <> Index) then Inc(I) else begin
SetString(Result, P1, P-P1); Exit;
end;
while P^ in [#1..' '] do P:=CharNext(P);
if P^ = Delimiter then begin
repeat
P:=CharNext(P);
until not (P^ in [#1..' ']);
end;
end;
end;
function Implode(S: Strings; Delimiter: Char): String;
var iCount: Integer;
begin
Result:='';
if (Length(S) = 0) then Exit;
for iCount:=0 to Length(S)-1 do
Result:=Result+S[iCount]+Delimiter;
System.Delete(Result, Length(Result), 1);
end;
var
su : string; // What we want split
si : TStringList; // Result of splitting
Delimiter : string;
...
Delimiter := ';';
si.Text := ReplaceStr(su, Delimiter, #13#10);
Lines in si list will contain splitted strings.
You can make your own function which returns TArray of string:
function mySplit(input: string): TArray<string>;
var
delimiterSet: array [0 .. 0] of char;
// split works with char array, not a single char
begin
delimiterSet[0] := '&'; // some character
result := input.Split(delimiterSet);
end;
Here is an implementation of an explode function which is available in many other programming languages as a standard function:
type
TStringDynArray = array of String;
function Explode(const Separator, S: string; Limit: Integer = 0): TStringDynArray;
var
SepLen: Integer;
F, P: PChar;
ALen, Index: Integer;
begin
SetLength(Result, 0);
if (S = '') or (Limit < 0) then Exit;
if Separator = '' then
begin
SetLength(Result, 1);
Result[0] := S;
Exit;
end;
SepLen := Length(Separator);
ALen := Limit;
SetLength(Result, ALen);
Index := 0;
P := PChar(S);
while P^ <> #0 do
begin
F := P;
P := AnsiStrPos(P, PChar(Separator));
if (P = nil) or ((Limit > 0) and (Index = Limit - 1)) then P := StrEnd(F);
if Index >= ALen then
begin
Inc(ALen, 5);
SetLength(Result, ALen);
end;
SetString(Result[Index], F, P - F);
Inc(Index);
if P^ <> #0 then Inc(P, SepLen);
end;
if Index < ALen then SetLength(Result, Index);
end;
Sample usage:
var
res: TStringDynArray;
begin
res := Explode(':', yourString);
I wrote this function which returns linked list of separated strings by specific delimiter. Pure free pascal without modules.
Program split_f;
type
PTItem = ^TItem;
TItem = record
str : string;
next : PTItem;
end;
var
s : string;
strs : PTItem;
procedure split(str : string;delim : char;var list : PTItem);
var
i : integer;
buff : PTItem;
begin
new(list);
buff:= list;
buff^.str:='';
buff^.next:=nil;
for i:=1 to length(str) do begin
if (str[i] = delim) then begin
new(buff^.next);
buff:=buff^.next;
buff^.str := '';
buff^.next := nil;
end
else
buff^.str:= buff^.str+str[i];
end;
end;
procedure print(var list:PTItem);
var
buff : PTItem;
begin
buff := list;
while buff<>nil do begin
writeln(buff^.str);
buff:= buff^.next;
end;
end;
begin
s := 'Hi;how;are;you?';
split(s, ';', strs);
print(strs);
end.
Jedi Code Library provides an enhanced StringList with built-in Split function, that is capable of both adding and replacing the existing text. It also provides reference-counted interface. So this can be used even with older Delphi versions that have no SplitStrings and without careful and a bit tedious customizations of stock TStringList to only use specified delimiters.
For example given text file of lines like Dog 5 4 7 one can parse them using:
var slF, slR: IJclStringList; ai: TList<integer>; s: string; i: integer;
action: procedure(const Name: string; Const Data: array of integer);
slF := TJclStringList.Create; slF.LoadFromFile('some.txt');
slR := TJclStringList.Create;
for s in slF do begin
slR.Split(s, ' ', true);
ai := TList<Integer>.Create;
try
for i := 1 to slR.Count - 1 do
ai.Add(StrToInt(slR[i]));
action(slR[0], ai.ToArray);
finally ai.Free; end;
end;
http://wiki.delphi-jedi.org/wiki/JCL_Help:IJclStringList.Split#string#string#Boolean
This will solve your problem
interface
TArrayStr = Array Of string;
implementation
function SplitString(Text: String): TArrayStr;
var
intIdx: Integer;
intIdxOutput: Integer;
const
Delimiter = ';';
begin
intIdxOutput := 0;
SetLength(Result, 1);
Result[0] := '';
for intIdx := 1 to Length(Text) do
begin
if Text[intIdx] = Delimiter then
begin
intIdxOutput := intIdxOutput + 1;
SetLength(Result, Length(Result) + 1);
end
else
Result[intIdxOutput] := Result[intIdxOutput] + Text[intIdx];
end;
end;
My favourite function for splitting:
procedure splitString(delim: char; s: string; ListOfStrings: TStrings);
var temp: string;
i: integer;
begin
ListOfStrings.Clear;
for i:=1 to length(s) do
begin
if s[i] = delim then
begin
ListOfStrings.add(temp);
temp := '';
end
else
begin
temp := temp + s[i];
if i=length(s) then
ListOfStrings.add(temp);
end;
end;
ListOfStrings.add(temp);
end;
*
//Basic functionality of a TStringList solves this:
uses Classes //TStringList
,types //TStringDynArray
,SysUtils //StringReplace()
;
....
//--------------------------------------------------------------------------
function _SplitString(const s:string; const delimiter:Char):TStringDynArray;
var sl:TStringList;
i:integer;
begin
sl:=TStringList.Create;
//separete delimited items by sLineBreak;TStringlist will do the job:
sl.Text:=StringReplace(s,delimiter,sLineBreak,[rfReplaceAll]);
//return the splitted string as an array:
setlength(Result,sl.count);
for i:=0 to sl.Count-1
do Result[i]:=sl[i];
sl.Free;
end;
//To split a FileName (last item will be the pure filename itselfs):
function _SplitPath(const fn:TFileName):TStringDynArray;
begin
result:=_SplitString(fn,'\');
end;
*
The base of NGLG answer https://stackoverflow.com/a/8811242/6619626 you can use the following function:
type
OurArrayStr=array of string;
function SplitString(DelimeterChars:char;Str:string):OurArrayStr;
var
seg: TStringList;
i:integer;
ret:OurArrayStr;
begin
seg := TStringList.Create;
ExtractStrings([DelimeterChars],[], PChar(Str), seg);
for i:=0 to seg.Count-1 do
begin
SetLength(ret,length(ret)+1);
ret[length(ret)-1]:=seg.Strings[i];
end;
SplitString:=ret;
seg.Free;
end;
It works in all Delphi versions.
For delphi 2010, you need to create your own split function.
function Split(const Texto, Delimitador: string): TStringArray;
var
i: integer;
Len: integer;
PosStart: integer;
PosDel: integer;
TempText:string;
begin
i := 0;
SetLength(Result, 1);
Len := Length(Delimitador);
PosStart := 1;
PosDel := Pos(Delimitador, Texto);
TempText:= Texto;
while PosDel > 0 do
begin
Result[i] := Copy(TempText, PosStart, PosDel - PosStart);
PosStart := PosDel + Len;
TempText:=Copy(TempText, PosStart, Length(TempText));
PosDel := Pos(Delimitador, TempText);
PosStart := 1;
inc(i);
SetLength(Result, i + 1);
end;
Result[i] := Copy(TempText, PosStart, Length(TempText));
end;
You can refer to it as such
type
TStringArray = array of string;
var Temp2:TStringArray;
Temp1="hello:world";
Temp2=Split(Temp1,':')
procedure SplitCSV(S:STRING;out SL:TStringList);
var c,commatext:string;
a,b,up:integer;
begin
c:=s.Replace(' ','<SPACE>'); //curate spaces
//first ocurrence of "
a:=pos('"',c);
b:=pos('"',c,a+1);
if (a>0) and (b>0) then
begin
commatext:=commatext+copy(c,0,a-1);
commatext:=commatext+copy(c,a,b-a+1).Replace(',','<COMMA>'); //curate commas
up:=b+1;
end
else
commatext:=c;
//while continue discovering "
while (a>0) and (b>0) do
begin
a:=Pos('"',c,b+1);
b:=pos('"',c,a+1);
if (a>0) and (b>0) then
begin
commatext:=commatext+copy(c,up,a-up);
commatext:=commatext+copy(c,a,b-a+1).Replace(',','<COMMA>'); //curate commas
up:=b+1;
end;
end;
//last piece of text end
if up<c.Length then
commatext:=commatext+copy(c,up,c.Length-up+1);
//split text using CommaText
sl.CommaText:=commatext;
sl.Text:=sl.Text.Replace('<COMMA>',','); //curate commas
sl.Text:=sl.Text.Replace('<SPACE>',' '); //curate spaces
end;
interface
uses
Classes;
type
TStringArray = array of string;
TUtilStr = class
class function Split(const AValue: string; const ADelimiter: Char = ';'; const AQuoteChar: Char = '"'): TStringArray; static;
end;
implementation
{ TUtilStr }
class function TUtilStr.Split(const AValue: string; const ADelimiter: Char; const AQuoteChar: Char): TStringArray;
var
LSplited: TStringList;
LText: string;
LIndex: Integer;
begin
LSplited := TStringList.Create;
try
LSplited.StrictDelimiter := True;
LSplited.Delimiter := ADelimiter;
LSplited.QuoteChar := AQuoteChar;
LSplited.DelimitedText := AValue;
SetLength(Result, LSplited.Count);
for LIndex := 0 to LSplited.Count - 1 do
begin
Result[LIndex] := LSplited[LIndex];
end;
finally
LSplited.Free;
end;
end;
end.
I initially praised the answer from #Frank as I needed something that works for Delphi 6 and it appeared to work. However, I have since found that that solution has a bug whereby it still splits on #13#10 regardless of delimiter. Works perfectly if you are not expecting lines in your source string.
I wrote a simple parser that only works for single character delimiters. Note: it puts the values into a TStrings, not into an array as the op requested, but can easily be modified to adapt to arrays.
Here is the procedure:
procedure SplitString(const ASource: string; const ADelimiter: Char; AValues: TStrings);
var
i, lastDelimPos: Integer;
begin
AValues.Clear;
lastDelimPos := 0;
for i := 1 to Length(ASource) do
if ASource[i] = ADelimiter then
begin
if lastDelimPos = 0 then
AValues.Add(CopyRange(ASource, 1, i - 1))
else
AValues.Add(CopyRange(ASource, lastDelimPos + 1, i - 1));
lastDelimPos := i;
end;
if lastDelimPos = 0 then
AValues.Add(ASource)
else
AValues.Add(CopyRange(ASource, lastDelimPos + 1, MaxInt));
end;
function CopyRange(const s: string; const AIndexFrom, AIndexTo: Integer): string;
begin
Result := Copy(s, AIndexFrom, AIndexTo - AIndexFrom + 1);
end;
Note: as per C#'s string.Split(), a blank input string will result in a single blank string in the TStrings. Similarly, just having a delimiter by itself as the input string would result in two blank strings in the TStrings.
Here is the rough test code I used to ensure it's solid:
procedure AddTest(const ATestLine: string; const AExpectedResult: array of string);
var
expectedResult: TStringList;
i: Integer;
begin
expectedResult := TStringList.Create;
for i := 0 to Length(AExpectedResult) - 1 do
expectedResult.Add(AExpectedResult[i]);
testStrings.AddObject(ATestLine, expectedResult);
end;
//====================
AddTest('test', ['test']);
AddTest('', ['']);
AddTest(',', ['', '']);
AddTest('line1' + #13#10 + ',line 2,line3, line 4', ['line1' + #13#10, 'line 2', 'line3', ' line 4']);
AddTest('line1' + #13#10 + 'd,line 2,line3, line 4', ['line1' + #13#10 + 'd', 'line 2', 'line3', ' line 4']);
AddTest('line1,line 2,line3, line 4', ['line1', 'line 2', 'line3', ' line 4']);
AddTest('test, ', ['test', ' ']);
AddTest('test,', ['test', '']);
AddTest('test1,test2 ', ['test1', 'test2 ']);
AddTest('test1,test2', ['test1', 'test2']);
AddTest('test1,test2, ', ['test1', 'test2', ' ']);
AddTest('test1,test2,', ['test1', 'test2', '']);
//====================
testFailed := False;
for i := 0 to testStrings.Count - 1 do
begin
SplitString2(testStrings[i], ',', f);
log('Test ID=%d', [i]);
log(' Test String="%s"', [testStrings[i]]);
log(' Item count=%d', [f.Count]);
testResult := TStringList(TestStrings.Objects[i]);
if testResult.Count <> f.Count then
begin
Log('!!');
Log('!! Count mismatch. Got=%d, Expected=%d', [f.Count, testResult.Count]);
Log('!!');
testFailed := True;
end;
for j := 0 to f.Count - 1 do
begin
log(' Item %d="%s" (len=%d)', [j, f[j], Length(f[j])]);
if testResult[j] <> f[j] then
begin
Log('!!');
Log('!! Text mismatch. Got="%s", Expected="%s"', [f[j], testResult[j]]);
Log('!!');
testFailed := True;
end;
end;
end;
Edit: code for the CopyRange() function was missing, added now. My bad.

Is there an inverse function of *SysUtils.Format* in Delphi

Has anyone written an 'UnFormat' routine for Delphi?
What I'm imagining is the inverse of SysUtils.Format and looks something like this
UnFormat('a number %n and another %n',[float1, float2]);
So you could unpack a string into a series of variables using format strings.
I've looked at the 'Format' routine in SysUtils, but I've never used assembly so it is meaningless to me.
This is called scanf in C, I've made a Delphi look-a-like for this :
function ScanFormat(const Input, Format: string; Args: array of Pointer): Integer;
var
InputOffset: Integer;
FormatOffset: Integer;
InputChar: Char;
FormatChar: Char;
function _GetInputChar: Char;
begin
if InputOffset <= Length(Input) then
begin
Result := Input[InputOffset];
Inc(InputOffset);
end
else
Result := #0;
end;
function _PeekFormatChar: Char;
begin
if FormatOffset <= Length(Format) then
Result := Format[FormatOffset]
else
Result := #0;
end;
function _GetFormatChar: Char;
begin
Result := _PeekFormatChar;
if Result <> #0 then
Inc(FormatOffset);
end;
function _ScanInputString(const Arg: Pointer = nil): string;
var
EndChar: Char;
begin
Result := '';
EndChar := _PeekFormatChar;
InputChar := _GetInputChar;
while (InputChar > ' ')
and (InputChar <> EndChar) do
begin
Result := Result + InputChar;
InputChar := _GetInputChar;
end;
if InputChar <> #0 then
Dec(InputOffset);
if Assigned(Arg) then
PString(Arg)^ := Result;
end;
function _ScanInputInteger(const Arg: Pointer): Boolean;
var
Value: string;
begin
Value := _ScanInputString;
Result := TryStrToInt(Value, {out} PInteger(Arg)^);
end;
procedure _Raise;
begin
raise EConvertError.CreateFmt('Unknown ScanFormat character : "%s"!', [FormatChar]);
end;
begin
Result := 0;
InputOffset := 1;
FormatOffset := 1;
FormatChar := _GetFormatChar;
while FormatChar <> #0 do
begin
if FormatChar <> '%' then
begin
InputChar := _GetInputChar;
if (InputChar = #0)
or (FormatChar <> InputChar) then
Exit;
end
else
begin
FormatChar := _GetFormatChar;
case FormatChar of
'%':
if _GetInputChar <> '%' then
Exit;
's':
begin
_ScanInputString(Args[Result]);
Inc(Result);
end;
'd', 'u':
begin
if not _ScanInputInteger(Args[Result]) then
Exit;
Inc(Result);
end;
else
_Raise;
end;
end;
FormatChar := _GetFormatChar;
end;
end;
I know it tends to scare people, but you could write a simple function to do this using regular expressions
'a number (.*?) and another (.*?)
If you are worried about reg expressions take a look at www.regexbuddy.com and you'll never look back.
I tend to take care of this using a simple parser. I have two functions, one is called NumStringParts which returns the number of "parts" in a string with a specific delimiter (in your case above the space) and GetStrPart returns the specific part from a string with a specific delimiter. Both of these routines have been used since my Turbo Pascal days in many a project.
function NumStringParts(SourceStr,Delimiter:String):Integer;
var
offset : integer;
curnum : integer;
begin
curnum := 1;
offset := 1;
while (offset <> 0) do
begin
Offset := Pos(Delimiter,SourceStr);
if Offset <> 0 then
begin
Inc(CurNum);
Delete(SourceStr,1,(Offset-1)+Length(Delimiter));
end;
end;
result := CurNum;
end;
function GetStringPart(SourceStr,Delimiter:String;Num:Integer):string;
var
offset : integer;
CurNum : integer;
CurPart : String;
begin
CurNum := 1;
Offset := 1;
While (CurNum <= Num) and (Offset <> 0) do
begin
Offset := Pos(Delimiter,SourceStr);
if Offset <> 0 then
begin
CurPart := Copy(SourceStr,1,Offset-1);
Delete(SourceStr,1,(Offset-1)+Length(Delimiter));
Inc(CurNum)
end
else
CurPart := SourceStr;
end;
if CurNum >= Num then
Result := CurPart
else
Result := '';
end;
Example of usage:
var
st : string;
f1,f2 : double;
begin
st := 'a number 12.35 and another 13.415';
ShowMessage('Total String parts = '+IntToStr(NumStringParts(st,#32)));
f1 := StrToFloatDef(GetStringPart(st,#32,3),0.0);
f2 := StrToFloatDef(GetStringPart(st,#32,6),0.0);
ShowMessage('Float 1 = '+FloatToStr(F1)+' and Float 2 = '+FloatToStr(F2));
end;
These routines work wonders for simple or strict comma delimited strings too. These routines work wonderfully in Delphi 2009/2010.

Resources