Free Pascal: пример - тестирование класса TStringList

---

Текст программы с комментариями

program teststrings; // Тестируем работу класса TStringList

{$mode objfpc}{$h+}

Uses classes,sysutils;

Procedure DoRef (P : Pointer);

Type PLongint = ^Longint;

begin
  If P=Nil then
    Writeln ('(Ref : Empty string)')
  else
{$ifdef fpc}
    Writeln (' (Ref: ',Plongint(Longint(P)-4)^,',Len: ',PLongint(Longint(P)-8)^,')');
{$else}
    Writeln (' (Ref: ',Plongint(Longint(P)-8)^,',Len: ',PLongint(Longint(P)-4)^,')');
{$endif}
end;

Procedure test;

var S,TS : ANsiSTring;
    T : TStringList;
    I,J : Longint;
    A : String[255];

begin
  S:='An Ansi string ';
  T:=TStringList.create;   //Создаем объект T класса TStringList
  Writeln ('Count : ',T.Count,' Capacity : ',T.Capacity);  //Выводим ёмкость объекта 
  For I:=1 to 10 do  // цикл по I от 1 до 10 
    begin
    str (I,TS);      // преобразуем число I в строку TS (текстовое представление числа)
    T.Add(S+TS);     // Добавляем в список (объект T) сумму строк S+TS
    end;             // И так 10 раз - для I = 1,2,...10
  Writeln ('Count : ',T.Count,' Capacity : ',T.Capacity); //Выводим количество 
 // строк в списке и ёмкость списка
  J:=T.Count-1;
  Writeln ('J : ',J);
  For I:=0 to J do
    Writeln(I,'/',J,' : ',T.Strings[I]); // Выводим эти строки (индекс первой = 0)
  T.SaveToFile ('strings.dat');   // Сохраняем этот список в файле strings.dat
  T.Clear;                        // Очищаем список
  T.LoadFromFile('strings.dat');  // Вводим список из файла 
  J:=T.Count-1;
  // Writeln ('Count = ',J);  По-моему, это неверная идея, заменяю

  Writeln ('Count = ',T.Count);
  For I:=0 to J do
    Writeln(I,'/',J,' : ',T.Strings[I]); // Выводим эти строки (индекс первой = 0)
  Writeln ('IndexOf(''An Ansi string 6'') = ',T.IndexOf('An Ansi string 6'));
  Writeln ('IndexOf(''An Ansi string 11'') = ',T.IndexOf('An Ansi string 11'));
  T.Clear;
  For I:=1 to 10 do
    T.Values['Var'+IntToStr(I)]:='Val'+IntToSTr(I);
  J:=T.Count-1;
  Writeln ('J = ',J);
  For I:=0 to J do
    Writeln(I,'/',J,' : ',T.Strings[I]);
  Writeln ('Indexof(''Var6'') = ',T.IndexOfName('Var6'));
  Writeln ('Indexof(''Var13'') = ',T.IndexOfName('Var13'));
  Writeln ('Value[''Var6'']  = ',T.Values['Var6']);
  Writeln ('Value[''Var13'']  = ',T.Values['Var13']);
  Try   // Блок локализации ошибок
    Writeln ('String 100 = ');
    S:=T.Strings[100];    // Запрашиваем несуществующую строку ( 100 - вне диапазона )
  except
    On e: exception do Writeln ('Caught exception : ',e.message);
  end;
  T.Free; // Освобождаем память, выделенную списку
end;

Var Data : longint;
    t    : THeapStatus;
begin
  Data:=getfpcheapstatus.currheapused;
  test;
  Writeln ('Lost ',getfpcheapstatus.currheapused-data);
  // Выводим - сколько байт памяти потеряно (результат = 0)
end.

Работает нормально.