Reverse strings in an array - delphi

procedure ReverseArray(var A : array of string);
var I,J,L : integer;
begin
for I := Low(A) to High(A) do
begin
L := length(A[I]);
for J := L downto 1 do M := M + A[I];
end;
writeln(M);
end;
begin
for I := 1 to 4 do readln(T[I]);
ReverseArray(T);
sleep(40000);
end.
What I'm trying to do here basically is reverse every string in the array but I'm unable to do it , what the code above do is basically repeat the words depends on their length (I write 'bob' in the array , the procedure will give me 'bob' three times because the length is 3) ... not sure why it's not working properly and what I'm missing

Delphi has a ReverseString() function in the StrUtils unit.
uses
StrUtils;
type
TStrArray = array of string;
procedure ReverseArray(var A : TStrArray);
var
I: integer;
begin
for I := Low(A) to High(A) do
A[I] := ReverseString(A[I]);
end;
var
T: TStrArray;
I: Integer
begin
SetLength(T, 4);
for I := 1 to 4 do Readln(T[I]);
ReverseArray(T);
...
end.

A string is an array of char with some extra bells and whistles added.
So an array of string is a lot like an array of array of char.
If you want to reverse the string, you'll have to access every char and reverse it.
procedure ReverseArray(var A : array of string);
var
i,j,Len : integer;
B: string;
begin
for i := Low(A) to High(A) do begin
Len := length(A[i]);
SetLength(B, Len); //Make B the same length as A[i].
//B[Len] = A[i][1]; B[Len-1]:= A[i][2] etc...
for j := Len downto 1 do B[j]:= A[i][(Len-J)+1];
//Store the reversed string back in the array.
A[i]:= B;
//Because A is a var parameter it will be returned.
//Writeln(B); //Write B for debugging purposes.
end;
end;
var
i: integer;
Strings: array [0..3] of string;
begin
for i := 0 to 3 do readln(Strings[i]);
ReverseArray(Strings);
for i := 0 to 3 do writeln(Strings[i]);
WriteLn('Done, press a key...');
ReadLn;
end.
Some tips:
Do not use global variables like M but declare a local variable instead.
Don't do AStr:= AStr + AChar in a loop, if you can avoid it. If you know how long the result is going to be use the SetLength trick as shown in the code. It's generates much faster code.
Instead of a Sleep you can use a ReadLn to halt a console app. It will continue as soon as you press a key.
Don't put the writeln in your working routine.
Note the first element in a string is 1, but the first element in a array is 0 (unless otherwise defined); Dynamic arrays always start counting from zero.
Note that array of string in a parameter definition is an open array; a different thing from a dynamic array.
Single uppercase identifiers like T, K, etc are usually used for generic types, you shouldn't use them for normal variables; Use a descriptive name instead.

Come on! 'bob' is one of those words you shouldn't try to test a reverse routine. But the problem goes beyond that.
Your problem is in here
for J := L downto 1 do
M := M + A[I];
You are trying to add the whole string to the M variable instead of the character you are trying to access. So, it should be
for J := L downto 1 do
M := M + A[I][J];
Also you need to set M := '' inside the first loop where it will have nothing when you start accumulating characters in to it.
Third, move the writing part, WriteLn(M), inside the first loop where you get a nice, separated outputs.
Putting together, it is going to be:
for I := Low(A) to High(A) do
begin
L := length(A[I]);
M := '';
for J := L downto 1 do
M := M + A[I][J];
writeln(M);
end;

My preferred solution for this is
type
TStringModifier = function(const s: string): string;
procedure ModifyEachOf( var aValues: array of string; aModifier: TStringModifier );
var
lIdx: Integer;
begin
for lIdx := Low(aValues) to High(aValues) do
aValues[lIdx] := aModifier( aValues[lIdx] );
end;
and it ends up with
var
MyStrings: array[1..3] of string;
begin
MyStrings[1] := '123';
MyStrings[2] := '456';
MyStrings[3] := '789';
ModifyEachOf( MyStrings, SysUtils.ReverseString );
end;

uses
System.SysUtils, System.StrUtils;
var
Forwards, backwards : string;
begin
forwards:= 'abcd';
backwards:= ReverseString(forwards);
Writeln(backwards);
Readln;
end;
// dcba

Related

How to use MOVE for dynamic arrays with a record as an element and a dynamic array field on it?

I'm using Delphi Rio and my program has a lot of dynamic arrays operations. In order to improve speed of some long array copy, I tried to use Move . For 1D dynamic arrays of basic types (real, integer) I could manage the use of Move, but for a dynamic arrays with a record as its element and this record with another dynamic array fields I'm having trouble to make it work. The way I' using MOVE for the dynamic arrays fileds of records, after issue the command , these fileds continue pointing to the original source address of the source array.
Testing procedure : array_A is dynamic array of records, tow fileds of this record are dynamic arrays. After issue Move(array_A[0],B_array[0],sizeof(Array[0]) * length(arra_A)) then change values in array_B dynamic arrays fields, this cause changes in values of array_A too ! Both are pointing to the same address. How to change this behaviour using MOVE ?
See my code :
program ProjArrayMove;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils;
Type
Arrayint = Tarray<Integer>;
Arrayreal = TArray<Real>;
RECmember = record
mcode : integer;
mname : string[30];
mdynarr_int : arrayint;
mdynarr_real : arrayreal;
end;
ArrayMember = array of RECMember;
Procedure FillsRecord (var pRec : RECmember; pSize : integer; pFactor : real);
// Given a pRec , fills each dynamic array fields with pSize numbers
var
idx : integer;
begin
setlength(pRec.mdynarr_int,pSize);
setlength(pRec.mdynarr_real,pSize);
with pRec do
begin
for idx := 0 to pSize - 1 do
begin
mdynarr_int[idx] := idx;
mdynarr_real[idx] := idx * (1.0 + pFactor);
end;
end;
end;
Procedure FillsArray (var pArr : ArrayMember; pSizeArray, pSizeRec : integer; pChar : Char);
// Given a array of records pArr , fills the array with pSizeArray records
var
idx : integer;
begin
setlength(pArr,pSizeArray);
//Fils first record - element 0
FillsRecord(pArr[0],pSizeRec,2.3);
pArr[0].mcode := 0;
pArr[0].mname := '0' + pChar;
//Fills major array with records , each record with dynamic arrays fields also filled
for idx := 1 to High(pArr) do
begin
FillsRecord(pArr[idx],pSizeRec,idx * 2.3);
pArr[idx].mcode := idx;
pArr[idx].mname := idx.ToString + StringOfChar(pChar,2);
end;
end;
Procedure PrintArray(pArr : ArrayMember);
// Given an array of records pArr, prints each element including the dynami array fields
var
i,j : integer;
begin
Writeln(stringofchar('=',20));
for I := Low(pArr) to High(pArr) do
begin
Write('Idx :' + i.ToString + ' ' );
Write('Code :' + pArr[i].mcode.ToString + ' ' );
Write('Name :' + pArr[i].mname + ' ');
Write(' mdynarr_int :');
for j := Low(pArr[i].mdynarr_int) to High(pArr[i].mdynarr_int) do
Write(' ' + pArr[i].mdynarr_int[j].ToString);
Write(' mdynarr_real :');
for j := Low(pArr[i].mdynarr_real) to High(pArr[i].mdynarr_real) do
Write(' ' + FloatToStr(pArr[i].mdynarr_real[j]));
Writeln;
end;
end;
var
larray_A, larray_B : ArrayMember;
idx, lsizeA, lsize_int, lsize_real : integer;
begin
try
//Step 1 - Fills the first array with 10 records and its relaed dynamic arrays fields with 5 elements each
FillsArray(larray_A,10,5, 'A');
//Step 2- An attempt to ast copy elements of larray_A to larray_B
Setlength(larray_B, length(larray_A));
lsizeA := Sizeof(larray_A[0]);
MOVE(larray_A[0], larray_B[0], length(larray_A) * lsizeA);
Writeln('========== ARRAY A ==========');
PrintArray(larray_A);
readln;
Writeln('========== ARRAY B ==========');
PrintArray(larray_B);
readln;
//Now change values in item of array B
larray_B[0].mcode := 777;
larray_B[0].mname := 'B was changed';
larray_B[0].mdynarr_int[0] := 427;
larray_B[0].mdynarr_real[0] := 784.96;
Writeln('======= ARRAY B AFTER CHANGES ========');
PrintArray(larray_B);
readln;
Writeln('====== VERIFYING IMPACT IN ARRAY A =======');
PrintArray(larray_A);
readln;
//3-Attemp to use MOVE to copy contet of dynamic arrays fields in records member
lsize_int := Sizeof(larray_A[0].mdynarr_int[0]);
lsize_real:= Sizeof(larray_A[0].mdynarr_real[0]);
for idx := Low(larray_B) to High(larray_B) do
begin
setlength(larray_B[idx].mdynarr_int,length(larray_A[idx].mdynarr_int));
**MOVE(larray_A[idx].mdynarr_int[0],larray_B[idx].mdynarr_int[0],
lsize_int * length(larray_B[idx].mdynarr_int) );**
setlength(larray_B[idx].mdynarr_real,length(larray_A[idx].mdynarr_real));
MOVE(larray_A[idx].mdynarr_int[0],larray_B[idx].mdynarr_int[0],
lsize_real * length(larray_B[idx].mdynarr_real) );
end;
Writeln;
Writeln;
//Now change values in item of array B
larray_B[0].mcode := 555;
larray_B[0].mname := '2nd Change in B';
larray_B[0].mdynarr_int[0] := 10427;
larray_B[0].mdynarr_real[0] := 10784.96;
Writeln('======= ARRAY B AFTER 2nd CHANGES ========');
PrintArray(larray_B);
readln;
Writeln('====== VERIFYING IMPACT IN ARRAY A =======');
PrintArray(larray_A);
readln;
Writeln('==> It seems that MOVE in record fields of dynamic array type does not work as I expected - WHY ?');
readln;
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
end.
Thank you all !
Your first call to Move takes a copy of the inner array references but does behind the back of the compiler and therefore disrupts reference counting. From that point on everything else that you do it doomed to fail. You cannot use Move on data that is managed.
To do this correctly you need code like this:
type
TMyRec = record
Int: Integer;
Arr: TArray<Integer>;
function Clone: TMyRec;
end;
function TMyRec.Clone: TMyRec;
begin
Result.Int := Int;
Result.Arr := Copy(Arr);
end;
function CloneRecArray(const Arr: array of TMyRec): TArray<TMyRec>;
var
i: Integer;
begin
SetLength(Result, Length(Arr));
for i := 0 to High(Result) do
Result[i] := Arr[i].Clone;
end;
Have you explored internals of copy operation for dynamic arrays - _DynArrayCopy in system.pas?
It checks type of all fields of internal data structures, copies simple data with Move, and recursively calls itself for dynamic arrays fields.
Perhaps you final result will be alike this.

How to concat multiple strings with Move?

How can I concat an array of strings with Move. I tried this but I just cannot figure how to get Move operation working correctly.
program Project2;
{$POINTERMATH ON}
procedure Concat(var S: String; const A: Array of String);
var
I, J: Integer;
Len: Integer;
begin
Len := 0;
for I := 0 to High(A) do
Len := Len + Length(A[I]);
SetLength(S, Length(S) + Len);
for I := 0 to High(A) do
Move(PWideChar(A[I])[0], S[High(S)], Length(A[I]) * SizeOf(WideChar));
end;
var
S: String;
begin
S := 'test';
Concat(S, ['test', 'test2', 'test3']);
end.
I'd write this function like so:
procedure Concat(var Dest: string; const Source: array of string);
var
i: Integer;
OriginalDestLen: Integer;
SourceLen: Integer;
TotalSourceLen: Integer;
DestPtr: PChar;
begin
TotalSourceLen := 0;
OriginalDestLen := Length(Dest);
for i := low(Source) to high(Source) do begin
inc(TotalSourceLen, Length(Source[i]));
end;
SetLength(Dest, OriginalDestLen + TotalSourceLen);
DestPtr := PChar(Pointer(Dest)) + OriginalDestLen;
for i := low(Source) to high(Source) do begin
SourceLen := Length(Source[i]);
Move(Pointer(Source[i])^, DestPtr^, SourceLen*SizeOf(Char));
inc(DestPtr, SourceLen);
end;
end;
It's fairly self-explanatory. The complications are caused by empty strings. Any attempt to index characters of an empty string will lead to exceptions when range checking is enabled.
To handle that complication, you can add if tests for the case where one of the strings involved in the Move call is empty. I prefer a different approach. I'd rather cast the string variable to be a pointer. That bypasses range checking but also allows the if statement to be omitted.
Move(Pointer(Source[i])^, DestPtr^, SourceLen*SizeOf(Char));
One might wonder what happens if Source[i] is empty. In that case Pointer(Source[i]) is nil and you might expect an access violation. In fact, there is no error because the length of the move as specified by the third argument is zero, and the nil pointer is never actually de-referenced.
The other line of note is here:
DestPtr := PChar(Pointer(Dest)) + OriginalDestLen;
We use PChar(Pointer(Dest)) rather than PChar(Dest). The latter invokes code to check whether or not Dest is empty, and if so yields a pointer to a single null-terminator. We want to avoid executing that code, and obtain the address held in Dest directly, even if it is nil.
In the second loop you forget that S already has the right size to get filled with all the elements so you have to use another variable to know the destination parameter of Move
procedure Concat(var S: String; const A: Array of String);
var
I, Len, Sum: Integer;
begin
Len := 0;
for I := 0 to High(A) do
Inc(Len, Length(A[I]));
Sum := Length(S);
SetLength(S, Sum + Len);
for I := 0 to High(A) do
begin
if Length(A[I]) > 0 then
Move(A[I][1], S[Sum+1], Length(A[I]) * SizeOf(Char));
Inc(Sum, Length(A[I]));
end;
end;
Casting the source parameter to PWideChar is totally superfluous since the Move function use a kind of old generic syntax that allows to pass everything you want (const Parameter without type).

Remove same element array in delphi

I'm trying to remove the same element of array in delphi.
For examples :
R[1] := 33332111111111111111111111323333333334378777433333344333333333277
I want to make it become 32132343787434327. and saved in the new array.
Could you give some idea?
I already tried to make each of R[1] element to Array. And tried some code.
for i:=1 to length(NR) do
begin
found:=false;
for k:=i+1 to length(NR) do
begin
if (NR[i]=NR[k]) then
begin
found:=true;
end;
end;
if (not found) then
begin
Memo1.Lines.Add(NR[i]);
end;
end;
But the result is 184327.
could you guys help me? thanks a lot. I'm so desperate to do this.
You appear to be working with strings rather than arrays. In which case you need this function:
function RemoveAdjacentDuplicates(const X: string): string;
var
i, j: Integer;
begin
SetLength(Result, Length(X));
j := 0;
for i := 1 to Length(Result) do
if (i=1) or (X[i]<>X[i-1]) then
begin
inc(j);
Result[j] := X[i];
end;
SetLength(Result, j);
end;
Let's work through this.
First of all I allocate the result variable. This is likely to be an over allocation. We know that the result cannot be larger than the input.
We use two indexing local variables, the rather weakly named i and j. We could give them descriptive names but for such a short function one might decide that it was not necessary. Do feel free to come up with other names if you prefer. You might choose idxIn and idxOut for instance.
One variable indexes the input, the other indexes the output. The input index is used in a simple for loop. The output index is incremented every time we find a unique item.
The if condition tests whether the input index refers to a character that differs from the previous one. The first element has no previous element so we always include it.
Once the loop completes we know how long the output is and can perform the final allocation.
Adapting this for an array is simple. You just need to account for arrays using zero-based indexes. For a bit of fun, here's a generic version for arrays:
type
TMyArrayHelper = class
class function RemoveAdjacentDuplicates<T>(const X: array of T): TArray<T>;
static;
end;
class function TMyArrayHelper.RemoveAdjacentDuplicates<T>
(const X: array of T): TArray<T>;
var
i, j: Integer;
Comparer: IEqualityComparer<T>;
begin
Comparer := TEqualityComparer<T>.Default;
SetLength(Result, Length(X));
j := 0;
for i := 0 to high(Result) do
if (i=0) or not Comparer.Equals(X[i], X[i-1]) then
begin
Result[j] := X[i];
inc(j);
end;
SetLength(Result, j);
end;
Note the subtly different placement of inc(j). This is necessitated by the switch to zero-based indexing.
A slightly more complex alternative with fewer tests would be:
class function TMyArrayHelper.RemoveAdjacentDuplicates<T>
(const X: array of T): TArray<T>;
var
i, j, len: Integer;
Comparer: IEqualityComparer<T>;
begin
Comparer := TEqualityComparer<T>.Default;
len := Length(X);
SetLength(Result, len);
if len=0 then
exit;
Result[0] := X[0];
j := 1;
for i := 1 to len-1 do
if not Comparer.Equals(X[i], X[i-1]) then
begin
Result[j] := X[i];
inc(j);
end;
SetLength(Result, j);
end;

How can I implement a quick sort in Delphi without getting Access violation errors for large numbers of records?

Here is my current code:
function StudentQuickSort(StudentList:TStudentArray;ArrayLength:integer):TStudentArray;
var
Pivot:TstudentArray;
LesserList:TStudentArray;
GreaterList:TstudentArray;
ArrayCount:Integer;
LesserCount:Integer;
GreaterCOunt:integer;
procedure ConcatArrays(const A,B,C: TStudentArray; var D: TStudentArray);
var i, nA,nB,nC: integer;
begin
nA := length(A);
nB := length(B);
nC := Length(C);
SetLength(D,nA+nB+nC);
for i := 0 to nA-1 do
D[i] := A[i];
for i := 0 to nB-1 do
D[i+nA] := B[i];
for i := 0 to nC-1 do
D[i+nA+nB] := C[i];
end;
begin
if Arraylength<=1 then
begin
Result:=(StudentList);
end
else
begin
SetLength(StudentList,ArrayLength);
SetLength(LesserList,ArrayLength);
SetLength(GreaterList,ArrayLength);
SetLength(Pivot,1);
LesserCOunt:=0;
GreaterCount:=0;
Pivot[0]:=StudentList[0];
for ArrayCount := 1 to ArrayLength-1 do
begin
if strtoint(StudentList[ArrayCount].StudentNo)>strtoint(Pivot[0].StudentNo) then
begin
GreaterList[GreaterCOunt]:=StudentList[ArrayCount];
GreaterCount:=GreaterCount+1;
end
else
begin
LesserList[LesserCOunt]:=StudentList[ArrayCount];
LesserCount:=LesserCount+1;
end;
end;
SetLength(LesserLIst,LesserCount);
SetLength(GreaterList,GreaterCount);
ConcatArrays(StudentQuickSort(LesserList,LesserCount),Pivot,StudentQuickSort(GreaterList,GreaterCount),Result)
end;
end;
How can this be stabilized, ideally changing as little code as possible. IS it a problem with using dynamic arrays? I need to be able to sort through at least 600 records without error.
Your code cannot be salvaged. You are going about solving this problem in the wrong way and I advise you to abandon your existing code. Here is how I believe sorting should be done.
Note that I am assuming that you don't have generics available to you. In modern Delphi versions you can use TArray.Sort<T> from Generics.Collections to sort. If you have access to that, you should use it
First of all the key is to separate the sorting from the array being sorted. To achieve that define the following types:
type
TCompareIndicesFunction = function(Index1, Index2: Integer): Integer of object;
TExchangeIndicesProcedure = procedure(Index1, Index2: Integer) of object;
The point is that all the common algorithms that can sort an array need only to be able to compare two items, and exchange two items. These procedural types enable separation of the sorting algorithm from the underlying array storage and types.
With these definitions in place, we are ready to write our general purpose sorting algorithms. For quicksort it looks like this:
procedure QuickSort(Count: Integer; Compare: TCompareIndicesFunction;
Exchange: TExchangeIndicesProcedure);
procedure Sort(L, R: Integer);
var
I, J, P: Integer;
begin
repeat
I := L;
J := R;
P := (L+R) div 2;
repeat
while Compare(I, P)<0 do inc(I);
while Compare(J, P)>0 do dec(J);
if I<=J then
begin
if I<>J then
begin
Exchange(I, J);
//may have moved the pivot so we must remember which element it is
if P=I then
P := J
else if P=J then
P := I;
end;
inc(I);
dec(J);
end;
until I>J;
if L<J then
Sort(L, J);
L := I;
until I>=R;
end;
begin
if Count>0 then
Sort(0, Count-1);
end;
In order to use this you need to wrap your array in a class which exposes compare and exchange methods.

Faster way to split text in Delphi TStringList

I have an app that needs to do heavy text manipulation in a TStringList. Basically i need to split text by a delimiter ; for instance, if i have a singe line with 1000 chars and this delimiter occurs 3 times in this line, then i need to split it in 3 lines. The delimiter can contain more than one char, it can be a tag like '[test]' for example.
I've wrote two functions to do this task with 2 different approaches, but both are slow in big amounts of text (more then 2mbytes usually).
How can i achieve this goal in a faster way ?
Here are both functions, both receive 2 paramaters : 'lines' which is the original tstringlist and 'q' which is the delimiter.
function splitlines(lines : tstringlist; q: string) : integer;
var
s, aux, ant : string;
i,j : integer;
flag : boolean;
m2 : tstringlist;
begin
try
m2 := tstringlist.create;
m2.BeginUpdate;
result := 0;
for i := 0 to lines.count-1 do
begin
s := lines[i];
for j := 1 to length(s) do
begin
flag := lowercase(copy(s,j,length(q))) = lowercase(q);
if flag then
begin
inc(result);
m2.add(aux);
aux := s[j];
end
else
aux := aux + s[j];
end;
m2.add(aux);
aux := '';
end;
m2.EndUpdate;
lines.text := m2.text;
finally
m2.free;
end;
end;
function splitLines2(lines : tstringlist; q: string) : integer;
var
aux, p : string;
i : integer;
flag : boolean;
begin
//maux1 and maux2 are already instanced in the parent class
try
maux2.text := lines.text;
p := '';
i := 0;
flag := false;
maux1.BeginUpdate;
maux2.BeginUpdate;
while (pos(lowercase(q),lowercase(maux2.text)) > 0) and (i < 5000) do
begin
flag := true;
aux := p+copy(maux2.text,1,pos(lowercase(q),lowercase(maux2.text))-1);
maux1.add(aux);
maux2.text := copy(maux2.text,pos(lowercase(q),lowercase(maux2.text)),length(maux2.text));
p := copy(maux2.text,1,1);
maux2.text := copy(maux2.text,2,length(maux2.text));
inc(i);
end;
finally
result := i;
maux1.EndUpdate;
maux2.EndUpdate;
if flag then
begin
maux1.add(p+maux2.text);
lines.text := maux1.text;
end;
end;
end;
I've not tested the speed, but for academic purposes, here's an easy way to split the strings:
myStringList.Text :=
StringReplace(myStringList.Text, myDelimiter, #13#10, [rfReplaceAll]);
// Use [rfReplaceAll, rfIgnoreCase] if you want to ignore case
When you set the Text property of TStringList, it parses on new lines and splits there, so converting to a string, replacing the delimiter with new lines, then assigning it back to the Text property works.
The problems with your code (at least second approach) are
You are constantly using lowecase which is slow if called so many times
If I saw correctly you are copying the whole remaining text back to the original source. This is sure to be extra slow for large strings (eg files)
I have a tokenizer in my library. Its not the fastest or best but it should do (you can get it from Cromis Library, just use the units Cromis.StringUtils and Cromis.Unicode):
type
TTokens = array of ustring;
TTextTokenizer = class
private
FTokens: TTokens;
FDelimiters: array of ustring;
public
constructor Create;
procedure Tokenize(const Text: ustring);
procedure AddDelimiters(const Delimiters: array of ustring);
property Tokens: TTokens read FTokens;
end;
{ TTextTokenizer }
procedure TTextTokenizer.AddDelimiters(const Delimiters: array of ustring);
var
I: Integer;
begin
if Length(Delimiters) > 0 then
begin
SetLength(FDelimiters, Length(Delimiters));
for I := 0 to Length(Delimiters) - 1 do
FDelimiters[I] := Delimiters[I];
end;
end;
constructor TTextTokenizer.Create;
begin
SetLength(FTokens, 0);
SetLength(FDelimiters, 0);
end;
procedure TTextTokenizer.Tokenize(const Text: ustring);
var
I, K: Integer;
Counter: Integer;
NewToken: ustring;
Position: Integer;
CurrToken: ustring;
begin
SetLength(FTokens, 100);
CurrToken := '';
Counter := 0;
for I := 1 to Length(Text) do
begin
CurrToken := CurrToken + Text[I];
for K := 0 to Length(FDelimiters) - 1 do
begin
Position := Pos(FDelimiters[K], CurrToken);
if Position > 0 then
begin
NewToken := Copy(CurrToken, 1, Position - 1);
if NewToken <> '' then
begin
if Counter > Length(FTokens) then
SetLength(FTokens, Length(FTokens) * 2);
FTokens[Counter] := Trim(NewToken);
Inc(Counter)
end;
CurrToken := '';
end;
end;
end;
if CurrToken <> '' then
begin
if Counter > Length(FTokens) then
SetLength(FTokens, Length(FTokens) * 2);
FTokens[Counter] := Trim(CurrToken);
Inc(Counter)
end;
SetLength(FTokens, Counter);
end;
How about just using StrTokens from the JCL library
procedure StrTokens(const S: string; const List: TStrings);
It's open source
http://sourceforge.net/projects/jcl/
As an additional option, you can use regular expressions. Recent versions of Delphi (XE4 and XE5) come with built in regular expression support; older versions can find a free regex library download (zip file) at Regular-Expressions.info.
For the built-in regex support (uses the generic TArray<string>):
var
RegexObj: TRegEx;
SplitArray: TArray<string>;
begin
SplitArray := nil;
try
RegexObj := TRegEx.Create('\[test\]'); // Your sample expression. Replace with q
SplitArray := RegexObj.Split(Lines, 0);
except
on E: ERegularExpressionError do begin
// Syntax error in the regular expression
end;
end;
// Use SplitArray
end;
For using TPerlRegEx in earlier Delphi versions:
var
Regex: TPerlRegEx;
m2: TStringList;
begin
m2 := TStringList.Create;
try
Regex := TPerlRegEx.Create;
try
Regex.RegEx := '\[test\]'; // Using your sample expression - replace with q
Regex.Options := [];
Regex.State := [preNotEmpty];
Regex.Subject := Lines.Text;
Regex.SplitCapture(m2, 0);
finally
Regex.Free;
end;
// Work with m2
finally
m2.Free;
end;
end;
(For those unaware, the \ in the sample expression used are because the [] characters are meaningful in regular expressions and need to be escaped to be used in the regular expression text. Typically, they're not required in the text.)

Resources