TNameValuePair = record
    Name: string;
    Value: string;
    constructor Create(const AName, AValue: string);
  end;
 
  TNameValueArray = TArray<TNameValuePair>;

unit UUriHelper;
 
interface
uses System.NetEncoding, System.Net.URLClient;
 
type
  TURIHelper = record helper for TURI
    function FindParameterIndex(const AName: string): Integer;
    function ParamExists(const AName:string): Boolean;
    procedure AddOrSetParamByName(const AName,AValue: string);
  end;
 
 
implementation
 
uses
  System.SysUtils;
 
{ TURIHelper }
 
procedure TURIHelper.AddOrSetParamByName(const AName, AValue: string);
var
  LIndex: Integer;
begin
  LIndex := FindParameterIndex(AName);
  if LIndex >= 0 then
    Parameter[LIndex] := TURIParameter.Create( TNetEncoding.URL.EncodeQuery(AName), TNetEncoding.URL.EncodeQuery(AValue))
  else
    AddParameter(AName, AValue);
end;
 
function TURIHelper.FindParameterIndex(const AName: string): Integer;
var
  I: Integer;
  LName: string;
begin
  Result := -1;
  LName := TNetEncoding.URL.EncodeQuery(AName);
  for I := 0 to Length(Params) - 1 do
    if Params[I].Name = LName then
      Exit(I);
end;
 
function TURIHelper.ParamExists(const AName: string): Boolean;
begin
  Result := FindParameterIndex(AName)<>-1;
end;
 
end.

function THttpApi.MakeUrl: string;
var
  s : String;
  name : String;
  i : integer;
begin
  s := IncludeTrailingPathDelimiter(BaseURL) + UrlParams.DelimitedText;
  // FURI это RECORD поэтому не нужно FURI := TUri.Create(s).
  // можно просто вызвать Create для инициализации полей
  FURI.Create(s);
  for i := 0 to QueryParams.Count-1 do
  begin
    name := QueryParams.Names[i];
    FURI.AddOrSetParamByName(name,QueryParams.Values[name]);
  end;
  result := FURI.ToString;
end;

unit HttpApi;
 
interface
uses
  System.Classes,
  System.SysUtils,
 
  system.Net.HttpClient,
  system.Net.URLClient,
 
  XSuperObject
  ;
 
type
  THttpApi = class
  protected
    FURI: TURI;
  public
    BaseURL : string;
    Headers: TNameValueArray;
    ResStream: TStringStream;
    SrcStream: TStringStream;
    Token : string;
    Response : IHTTPResponse;
    ResultString : string;
    ResultJson : ISuperObject;
 
    UrlParams : TStringList;
    QueryParams : TStringList;
 
    constructor Create(ABaseUrl: string); virtual;
    destructor Destroy(); override;
 
    procedure ClearParams;
    procedure SetHeaders(); virtual;
    function MakeUrl : string;
 
    procedure Request(AHttpMethod: string);
  end;
 
 
implementation
 
{ THttpApi }
 
constructor THttpApi.Create(ABaseUrl : string);
begin
  BaseURL := ABaseUrl;
  UrlParams := TStringList.Create;
  UrlParams.Delimiter := '/';
  QueryParams := TStringList.Create;
  QueryParams.Delimiter := '&';
  ResStream := TStringStream.Create('', TEncoding.UTF8);
  SrcStream := TStringStream.Create('', TEncoding.UTF8);
end;
 
destructor THttpApi.Destroy;
begin
  FreeAndNil(UrlParams);
  FreeAndNil(QueryParams);
  FreeAndNil(SrcStream);
  FreeAndNil(ResStream);
  inherited;
end;
 
 
function THttpApi.MakeUrl: string;
var
  s : String;
  name : String;
  i : integer;
begin
  s := IncludeTrailingPathDelimiter(BaseURL) + UrlParams.DelimitedText;
  // FURI это RECORD поэтому не нужно FURI := TUri.Create(s).
  // можно просто вызвать Create для инициализации полей
  FURI.Create(s);
  for i := 0 to QueryParams.Count-1 do
  begin
    name := QueryParams.Names[i];
    FURI.AddOrSetParamByName(name,QueryParams.Values[name]);
  end;
  result := FURI.ToString;
end;
 
// перед вызовом Request уже подготовлены все данные в SrcStream 
// и заданы UrlParams и QueruParams
procedure THttpApi.Request(AHttpMethod: string);
var
  http : THttpClient;
  url : string;
begin
  http := THttpClient.Create;
  try
 
    url := MakeUrl();
    SetHeaders();
 
    if AHttpMethod = 'POST' then
    begin
      Response := http.Post(url, SrcStream, ResStream, Headers);
    end
    else if AHttpMethod = 'GET' then
    begin
      /// Response := http.get .....
    end
    else if AHttpMethod = 'PUT' then
    begin
      /// Response := http.put .....
    end;
 
    if (Response.StatusCode div 100) <> 2 then
    begin
       // если все прошло нормально, код должен быть 2xx (201, 202...) https://ru.wikipedia.org/wiki/Список_кодов_состояния_HTTP
      raise Exception.Create('Http request error');
    end;
 
    ResultString := Response.ContentAsString(TEncoding.UTF8);
    /// Если все хорошо, то можно попытаться из ResultString получить ResultJson
    try
      ResultJson := SO(ResultString);
    except
      /// если строка - не JSON, здесь можно обработать ошибку
    end;
 
  finally
    FreeAndNil(http);
  end;
end;
 
procedure THttpApi.SetHeaders;
begin
  SetLength(Headers, 3);
  Headers[0].Name := 'Content-Type';
  Headers[0].Value := 'application/json';
  Headers[1].Name := 'Accept';
  Headers[1].Value := 'application/json';
  Headers[2].Name := 'Authorization';
  Headers[2].Value := Token;
end;
 
procedure THttpApi.ClearParams;
begin
  UrlParams.Clear;
  QueryParams.Clear;
  SrcStream.Clear;
end;
 
end.

unit My.Api;
 
interface
uses
  System.Classes,
  System.SysUtils,
 
  system.Net.HttpClient,
 
  HttpApi,
  MyClasses
  ;
 
type
  TMyApi = class(THttpApi)
  public
    constructor Create();
  end;
 
implementation
 
{ TMyApi }
 
constructor TMyApi.Create;
begin
  inherited Create('https://server.com/api/v2/');
  token := 'Bearer XXX-XXX-YYYY';
end;
 
 
end.

unit UMyClasses; 
 
interface
 
uses
  Classes, Types, Sysutils;
 
type
  TQuestion = record
    Q: string;
    A: array[0..3] of string;
    Right: integer;
  end;
 
  TDBSettings = record
    server: string;
    db: string;
  end;
 
  TMySettings = class
  public
    Login: string;
    Role: string;
    DBSettings: TDBSettings;
  end;
 
var
  Settings: TMySettings;
  Questions: array of TQuestion;
  Answers: array of integer;
 
function ReadQuestionsFromFile(FName: string): string;
 
implementation
 
function ReadQuestionsFromFile(FName: string): string;
var
  List: TStringList;
  VCount, I: integer;
begin
  List := TStringList.Create();
  List.LoadFromFile(FName); //прочитаем весь файл в список строк
  result := List[0]; // В первой строке у вас какой-то текст для заголовка
  VCount := StrToInt(List[1]); // во второй строке - кол-во записей
  SetLength(Questions, VCount);  // теперь,зная это количество, установим размер массива Questions
  SetLength(Answers, VCount); // и массива Answers
  I := 0;
  /// начиная с третьей строки, читаем вопросы
  while I < VCount do
  begin
    Questions[I].Q := List[2 + I * 6 + 0];
    Questions[I].A[0] := List[2 + I * 6 + 1];
    Questions[I].A[1] := List[2 + I * 6 + 2];
    Questions[I].A[2] := List[2 + I * 6 + 3];
    Questions[I].A[3] := List[2 + I * 6 + 4];
    Questions[I].Right := strToInt(List[2 + I * 6 + 5]);
    I := I + 1;
  end;
  List.Free;
end;
 
initialization
  Settings := TMySettings.Create;
 
finalization
  FreeAndNil(Settings);
 
end.

type
  TfMainForm = class(TForm)
    grp1: TGroupBox;
    eLogin: TEdit;
    ePass: TEdit;
    bOk: TButton;
    lbl1: TLabel;
    lbl2: TLabel;
    procedure bOkClick(Sender: TObject);
  private
    procedure GoTest;
  public
  end;
 
var
  fMainForm: TfMainForm;
 
implementation
 
uses
  UTestForm;
 
{$R *.dfm}
 
procedure TfMainForm.bOkClick(Sender: TObject);
begin
  // здесь будет проверка логина, но пока просто переход к тесту
  GoTest();
end;
 
procedure TfMainForm.GoTest;
var f:TfTestForm;
begin
  Hide;
  f:=TfTestForm.Create(self);
  try
    f.ShowModal;
  finally
    show;
    FreeAndNil(F);
  end;
end;

unit UTestForm;
 
interface
 
uses
  classes, types, forms, Controls, UMyClasses, ExtCtrls, StdCtrls;
 
type
 
  TfTestForm = class(TForm)
    pnl1: TPanel;
    lblQuestion: TLabel;
    bNext: TButton;
    rgVariants: TRadioGroup;
    pnlQuectionNo: TPanel;
    procedure FormCreate(Sender: TObject);
  private
    procedure ShowCurQuestion;
  public
    CurQuestion : integer;
  end;
 
var
  fTestForm: TfTestForm;
 
implementation
 
uses
  sysutils;
 
{$R *.dfm}
 
{ TMainForm }
procedure TfTestForm.FormCreate(Sender: TObject);
var
  Filename: string;
begin
  Filename := extractFilePath(ParamStr(0))+'questions.dat';
  Caption := ReadQuestionsFromFile(Filename);
  CurQuestion := 0;
  ShowCurQuestion;
end;
 
procedure TfTestForm.ShowCurQuestion;
var
  i: Integer;
begin
  pnlQuectionNo.Caption := Format('Вопрос %d / %d',[curQuestion+1, Length(Questions)]);
  lblQuestion.Caption := questions[CurQuestion].Q;
  rgVariants.Items.Clear;
  for i := 0 to 3 do
    rgVariants.Items.Add(questions[CurQuestion].A[i]);
  rgVariants.ItemIndex := -1;
end;
end.

procedure TfMain.ParseParams;
var
  i:integer;
begin
  Settings.Database.ParseParams;
 
  i := 1;
  while i <= ParamCount do
  begin
    if AnsiSameText(paramstr(i), '-ClearReports') then
      Settings.ClearReports := true
    else if AnsiSameText(paramstr(i), '-lang') and (i<paramcount) then
    begin
      Settings.reportuiresource := paramstr(i+1);
      inc(i);
    end;
    inc(i);
  end;
end;

  fSettings:=tfsettings.Create(Self);
  try
    // форма настроек заполняется из хранилища этих самых настроек
    // которое передано в этот метод через параметр Settings
    fSettings.LoadFrom(Settings); 
    repeat
      if fsettings.showModal()=mrOk then
      begin
        // форма сохраняет то, что навводил пользователь, в хранилище нестроек
        fsettings.saveTo(Settings);
        try
          // пробуем подключиться к БД с теми настройками, что получились, включая логин/пароль 
          fSettings.fDBSettingsFrame.TryConnect(Settings.Database);
          Break;
        except
          on e:Exception do
            ShowMessage(e.Message);
        end;
      end
      else
        Application.Terminate;
    until Application.Terminated;
  finally
    fSettings.free;
  end;

unit AS_Settings;
interface
uses SysUtils , classes, XSuperObject, JsonableObject, UDBSettings;
type
  TASFTPServerOptions = record
  public
    Host: string;
    Folder: string;
    Login: string;
    Pass: string;
  end;
 
  TASPersCardFormOptions = record
  public
    BaseCode: Integer;
  end;
 
  TASCommonRegFormOptions = record
  public
    Filter: string;
    PrintNum: Boolean;
    Preview: Boolean;
  end;
 
  TAS_Settings = class(TJsonableObject)
  private
  public
    Database:TDBSettings;
    LastImportDatabase:TDBSettings;
    FTP:TASFTPServerOptions;
 
    [DISABLE] // для JSON
    RecentConnections: TStringList;
    [ALIAS('RecentConnections')]
    _RecentConnections:TStringArray;
 
    PersCardForm: TASPersCardFormOptions;
    CommonRegForm: TASCommonRegFormOptions;
 
    procedure BeforeSave(X:ISuperObject); override;
    procedure Afterload(X:ISuperObject); override;
 
 
    constructor Create;  override;
    destructor Destroy; override;
  end;
 
const
  TargetNamespace = '';
 
var
  Settings : TAS_Settings;
 
function GetSettingsFilename():string;
 
implementation
 
function GetSettingsFilename():string;
begin
  result := ExtractFilePath(ParamStr(0))+'settings.json';
end;
 
{ TAS_Settings }
 
procedure TAS_Settings.Afterload(X:ISuperObject);
var
  i: Integer;
begin
  Setter_ArrayToList(_RecentConnections, RecentConnections);
end;
 
procedure TAS_Settings.BeforeSave(X:ISuperObject);
var
  i: Integer;
begin
  _RecentConnections:=Getter_ListToArray(RecentConnections);
end;
 
constructor TAS_Settings.Create;
begin
  inherited;
  RecentConnections:=TStringList.Create;
end;
 
destructor TAS_Settings.Destroy;
begin
  FreeAndNil(RecentConnections);
  inherited;
end;
 
end.

unit UDBSettings;
 
interface
type
  TDBSettings = record
    server:String;
    port:string;
    db:string;
    lib:string;
 
    user:string;
    pass:string;
    role:string;
    procedure parseParams;
    procedure ParseConnectionString(s: string);
    function ConnectionString:string;
    function Equals(d:TDBSettings):Boolean;
  end;
 
implementation
uses System.SysUtils;
 
{ TDBSettings }
 
function TDBSettings.ConnectionString: string;
begin
  if server<>'' then
    result:=server
  else
    Result := 'localhost';
  if port<>'' then
    result:=result+'/'+port;
  Result := result + ':' + db;
end;
 
procedure TDBSettings.ParseConnectionString(s:string);
var
  s1,s2:string;
  p:integer;
  a:TArray<string>;
begin
  p:=Pos(':',s);
  if p>0 then
  begin
    server:=Copy(s,1,p-1);
    db:=Copy(s,p+1,s.Length);
  end
  else
  begin
    server:='localhost';
    db:=s;
  end;
  a:=server.Split(['/']);
  if Length(a)>1 then
  begin
    server:=a[0];
    port:=a[1];
  end;
end;
 
function TDBSettings.Equals(d: TDBSettings): Boolean;
begin
  Result := (server = d.server)
      and (port = d.port)
      and (db = d.db)
end;
 
procedure TDBSettings.parseParams;
var
  i:integer;
begin
  i := 1;
  while i <= ParamCount do
  begin
    if AnsiSameText(ParamStr(i), '-D') and (i<paramCount) then
    begin
      ParseConnectionString(ParamStr(i + 1));
      inc(i);
    end
    else if AnsiSameText(ParamStr(i), '-R') and (i<paramCount) then
    begin
      role := ParamStr(i + 1);
      inc(i);
    end
    else if AnsiSameText(ParamStr(i), '-U') and (i<paramCount) then
    begin
      user := ParamStr(i + 1);
      inc(i);
    end
    else if AnsiSameText(ParamStr(i), '-P') and (i<paramCount) then
    begin
      pass :=ParamStr(i + 1);
      inc(i);
    end
    else if AnsiSameText(ParamStr(i), '-L') and (i<paramCount) then
    begin
      lib :=ParamStr(i + 1);
      inc(i);
    end;
    inc(i);
  end;
 
end;
 
end.

unit UMainForm;
 
interface
 
uses
  classes, types, forms, Controls, StdCtrls, Dialogs, SysUtils;
 
type
  TMainForm = class(TForm)
    bStart: TButton;
    m1: TMemo;
    procedure bStartClick(Sender: TObject);
  private
    procedure Log(const s: string);
    procedure ThreadTerm(Sender: TObject);
  public
    Started:integer;
    Finished:integer;
    procedure RunThread();
  end;
 
var
  MainForm: TMainForm;
 
implementation
 
uses
  UMyThread;
 
 
const
  MAX_THREADS=100;
  SAME_TIME=25;
 
{$R *.dfm}
 
 
 
 
{ TMainForm }
 
 
procedure TMainForm.Log(const s:string);
begin
  m1.Lines.Add(s);
end;
 
procedure TMainForm.ThreadTerm(Sender: TObject);
var
  th:TMyThread absolute Sender; // очень древняя магия. обозначает th:=TMyThread(Sender)
begin
  log(th.URL + ':'+th.answer);
  inc(Finished);
  if Started<MAX_THREADS then
    RunThread;
  if Finished=MAX_THREADS then
  begin
    log('===========================');
    log('Работа окончена');
    bStart.Enabled := true;
  end;
end;
 
procedure TMainForm.bStartClick(Sender: TObject);
var
  i: Integer;
begin
  bStart.enabled:=false;
  for i := 0 to SAME_TIME-1 do
    RunThread;
end;
 
procedure TMainForm.RunThread;
var
  th:TMyThread;
begin
  inc(Started);
  th:=TMyThread.Create('URL '+inttostr(Started), ThreadTerm );
  Log('запущен '+th.url);
  th.Resume;
end;
 
end.

unit UMyThread;
 
interface
uses Classes;
type
  TMyThread=class(TThread)
  public
    URL:string;
    answer:string;
    procedure Execute;override;
    constructor Create(AURL:string; TermProc:TNotifyEvent);
  end;
 
implementation
uses Sysutils;
 
{ TMyThread }
 
constructor TMyThread.Create(AURL:string; TermProc:TNotifyEvent);
begin
  inherited Create(true);
  URL := AURL;
  FreeOnTerminate := true;
  OnTerminate := TermProc;
end;
 
procedure TMyThread.Execute;
var g:TGUID;
begin
  // предположим, что здесь мы сходили в интернет и забрали с адреса URL
  // что-то очень нужное. Ответ поместили в Answer
  // сейчас просто генерируем уникальный ответ
  CreateGuid(g);
  Answer:=g.ToString;
  // сымитируем, что все потоки получат ответ с разной скоростью
  Sleep(Random(50));
end;
 
end.

while i<1000 do
begin
  doSomething();
  inc(i);
end;

while (i<1000) and (not Terminated) do
begin
  doSomething();
  inc(i);
end;

th:=TMyThread.Create(true);
th.Resume;

th.Terminate;

TMyThread=class
  Terminated2:^boolean;
  ...
end;
 
procedure TMyThread.Execute;
begin
  while not Terminated2^ do
  begin
      .....
  end;
end;

TForm1=class(TForm)
 ...
  stopThreads:boolean;
end;
...
th := TMyThread.Create(...);
th.Terminated2:=@stopThread;
...
...
 
stopThread := true;

th:=TMyThread.Create;
th.paramXXX := checkBox1.Checked;

procedure TMyThread.Execute;
begin
  if paramXXX then
    Proc1()
  else
    Proc2();
end;

th := TMyThread.Create(...);
...
procedure TForm1.CheckBox1Checked(Sender:TObject);
begin
  th.paramXXX := checkBox1.Checked;
end;

th:=TMyThread.Create(...);
th.progressBar := progressBar1;
...
procedure TMyThread.ShowProgress;
begin
  progressBar.position := FIndex div 1000;
end;
 
procedure TMyThread.Execute();
begin
  FIndex:=0;
  while FIndex < 100000 do
  begin
    if index mod 1000 = 0 then
      Synchronize(ShowProgress);
   ....
    inc(FIndex);
  end
end;

unit UMainForm;
 
interface
 
uses
  classes, types, forms, Controls, StdCtrls, Dialogs, SysUtils;
 
type
  TMainForm = class(TForm)
  private
    procedure CheckLogin;
    function LoginCorrect(login, pass: String): Boolean;
  public
    constructor Create(AOwner: TComponent); override;
  end;
 
var
  MainForm: TMainForm;
 
implementation
 
uses
  ULoginForm;
 
 
{$R *.dfm}
 
function TMainForm.LoginCorrect(login,pass:String):Boolean;
begin
  result := true;
end;
 
procedure TMainForm.CheckLogin();
var
  f:TLoginForm;
  r:TModalResult;
begin
  f:=TLoginForm.Create(NIL);
  try
    repeat
      r:=f.ShowModal;
      if r=mrOk then
      begin
        // придумаем функцию LoginCorrect() которая возвращает нам True или False
        // откуда она берет эти данные, из базы или файла или придумывает сама, нам все равно
        if LoginCorrect(f.eLogin.text, f.ePassword.text) then
          Break
      end;
    until r=mrCancel;
    if r=mrCancel then
    begin
      ShowMessage('Отказ от авторизации. Программа завершает свою работу.');
      Application.Terminate();
      Abort;
    end;
  finally
    f.free;
  end;
end;
 
 
constructor TMainForm.Create(AOwner: TComponent);
begin
  inherited;
  CheckLogin;
end;
 
end.

unit ULoginForm;
 
interface
 
uses
  Windows, Messages, Forms, StdCtrls, Classes, Controls;
 
type
  TLoginForm = class(TForm)
    eLogin: TEdit;
    ePassword: TEdit;
    bOk: TButton;
    bCancel: TButton;
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
 
implementation
 
{$R *.dfm}
 
end.