Function V1(s: TStringList): Integer;
Var
  i: Integer;
  x: String;

Begin
  x := '';
  For i := 0 To s.count - 1 Do
    x := x + s[i];
  Result := Length(x)
End;

Function V2(s: TStringList): Integer;
Var
  l, i, j, n: Integer;
  z, x: String;

Begin
  n := 0;
  For i := 0 To s.count - 1 Do
    inc(n, Length(s[i]));
  SetLength(x, n);
  j := 1;
  For i := 0 To s.count - 1 Do Begin
    z := s[i];
    l := Length(z);
    Move(z[1], x[j], l);
    inc(j, l);
  End;
 Result := Length (x);
End;

Function V2(s: TStringList): Integer;
Var
  l, i, j, n: Integer;
  z, x: String;

Begin
  n := 0;
  For i := 0 To s.count - 1 Do
    inc(n, Length(s[i]));
  result := n;

  {
  SetLength(x, n);
  j := 1;
  For i := 0 To s.count - 1 Do Begin
    z := s[i];
    l := Length(z);
    Move(z[1], x[j], l);
    inc(j, l);
  End;
  Result := Length (x);
}
End;

function TStrings.GetTextStr: string;
var
  I, L, Size, Count: Integer;
  P: PChar;
  S, LB: string;
begin
  Count := GetCount;
  Size := 0;
  LB := LineBreak;
  for I := 0 to Count - 1 do Inc(Size, Length(Get(I)) + Length(LB));
  SetString(Result, nil, Size);
  P := Pointer(Result);
  for I := 0 to Count - 1 do
  begin
    S := Get(I);
    L := Length(S);
    if L <> 0 then
    begin
      System.Move(Pointer(S)^, P^, L);
      Inc(P, L);
    end;
    L := Length(LB);
    if L <> 0 then
    begin
      System.Move(Pointer(LB)^, P^, L);
      Inc(P, L);
    end;
  end;
end;

Function V2(s: TStringList): Integer;
Var
  l, i, j, n: Integer;
  z: PChar;
  x: String;
  Arr: array of record
    Data: PChar;
    Len: Integer;
  end;
Begin
  n := 0;
  SetLength(Arr, s.Count);
  For i := 0 To s.count - 1 Do
  begin
    Arr[i].Data := PChar(s[i]); // nur einmal in s.Get(i) wird LStrAsg ausgeführt => 3x LOCK
    Arr[i].Len := Length(PString(@Arr[i].Data)^);
    inc(n, Arr[i].Len);
  end;

  SetLength(x, n);
  j := 0; // PChar startet bei 0
  For i := 0 To High(Arr) Do Begin
    z := Arr[i].Data;
    l := Arr[i].Len;
    Move(z^, PChar(PChar(Pointer(x)) + j)^, l * SizeOf(Char)); // kein UniqueString aufrufen
    inc(j, l);
  End;
 Result := Length (x);
End;

procedure TForm1.btClick(Sender: TObject);
Var
  s: TStringList;
  i : IntegeR;
  t0 : Cardinal;
  z0: Int64;
  z1: Int64;
  Freq: Int64;
begin
  QueryPerformanceFrequency(Freq);
  s := TStringlist.Create;
  try
    for i:=1 to 1000000 do s.add(IntToStr(i));

    QueryPerformanceCounter(z0);
    v1(s);
    QueryPerformanceCounter(z1);
    Memo.Lines.Add('Stringkonkatenation: '+FloatToStr((z1 - z0) / Freq));

    QueryPerformanceCounter(z0);
    v2(s);
    QueryPerformanceCounter(z1);
    Memo.Lines.Add('Direktes Einkopieren: '+FloatToStr((z1 - z0) / Freq));
  finally
    s.free;
  end;
end;