Substrings Extract Delimited Values

[Sequitar]

Ich würde gerne aus einem bestehenden String mit einem Delimiter gekennzeichnete Substrings extrahieren und in eine liste (hier: zu Testzwecken Tstrings, später eine custom DB / Trie exportieren).
Nun habe ich folgende Methode zur Extraktion, die aber extrem langsam scheint. Fällt Euch etwas ein, um die EXtraktion hier zu beschleunigen? Macht es Sinn mit Pchar zu arbeiten?
Vielen Dank für Eure Ideen

Vollst. Testcode:

Delphi-Quellcode:

Program Extractsubstrings;

{$APPTYPE CONSOLE}
{$R *.res}

// {$define unittests}

Uses
  Classes,
  Generics.Collections,
  System.SysUtils

{$IFDEF unittests},
  Unittests{$ENDIF};

Const
  Charsize = 2;

Procedure Testextractsubstrings(Const Str: String; Delimiter: Char;
  Items: Tlist<String> { class to be replaced by custom list or tree class } );
Var
  I, J, Len: Integer;
  P, Q, Oldp: Pchar;
  Itemtoadd: Pchar;
  Newpos, Oldpos: Integer;
Begin
  Assert(Assigned(Items));
  I := 0;
  Len := Length(Str);
  P := Pchar(Str);
  J := 1;
  Oldp := P;
  Oldpos := 0;
  While P <> '' Do
  Begin
    Inc(I);
    If P^ = Delimiter
    Then
    Begin
      Q := Oldp - I + 1;
      Getmem(Itemtoadd, (I - 1) * Charsize);
      Strlcopy(Itemtoadd, Q, I - 1);
      Items.Add(Itemtoadd);
      Freemem(Itemtoadd);
      Oldpos := Length(Itemtoadd);
      I := 0;
    End;
    Oldp := P + 1;
    Inc(P);
  End;
  // add last item
  While P^ <> Delimiter Do
    Dec(P);
  Itemtoadd := P + 1;
  Items.Add(Itemtoadd);
  // Writeln(Itemtoadd);
End;

Var
  I: Integer;
  S: String;
  List: Tlist<String>;

Const
  _max = 100000;

Begin
  Writeln('Extracting comma-delimited substrings. Testprogram');
  Try
    S := '';
    For I := 1 To _max Do
      S := S + Inttostr(I) + ',';
    Delete(S, Length(S), 1);
    // Writeln(S);
    List := Tlist<String>.Create;

{$IFDEF unittests} Tester.Test_leakProc(
      Procedure {$ENDIF}

      Begin
        Writeln('Starting test. Please wait');
        Testextractsubstrings(S, ',', List);
        Assert(List.Count = _max);
        List.Free;
      End{$IFDEF unittests}){$ENDIF};
    Writeln('Test finished');
    { TODO -oUser -cConsole Main : Insert code here }
  Except
    On E: Exception Do
      Writeln(E.ClassName, ': ', E.Message);
  End;
  Writeln('Test finished. Press any key to quit');
  ReadlN;

End.

Ebenfalls beigefügt.