freepascal.ru

Код: Выделить всё

program project1;

uses
  unit1;

var
  MYThread: array[0..2] of TMyHTTPRequest;
  i: integer;
begin
  for i := 0 to 2 do
  begin
    MYThread[i] := TMyHTTPRequest.Create(True);
    MYThread[i].FreeOnTerminate := True;
    MYThread[i].Start;
  end;
  ReadLn;
end.         

Код: Выделить всё

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, fphttpclient, sslsockets, fpopenssl;

type

  { TMyHTTPRequest }

  TMyHTTPRequest = class(TThread)
  public
    procedure Execute; override;
  end;

implementation

{ TMyHTTPRequest }

procedure TMyHTTPRequest.Execute;
var
  Client: TFPHTTPClient;
  res: string;
begin
  Client := TFPHTTPClient.Create(nil);
  res := Client.Get('https://google.com');
  FreeAndNil(Client);
end;

end.

Код: Выделить всё

program project1;

uses
  unit1,
  openssl;
.....
var
  MYThread: array[0..2] of TMyHTTPRequest;
  i: integer;
begin
  InitSSLInterface;  

Код: Выделить всё

program project1;

uses
  sysutils,
  Unit1,
  openssl,
  Math,
  fgl;

type
  TMYThread = specialize TFPGList<TMyHTTPRequest>;

  TURLTable = array[0..4] of string;

const
  URLTable : TURLTable = (
                          'https://google.com.ru/',
                          'https://translate.google.com.ru/',
                          'https://sourceforge.net',
                          {ну а чё? :)}
                          'http://www.freepascal.ru/',
                          'https://lenta.ru/'
                          );

var
  MYThread : TMYThread;
  tmp_arr  : TMyHTTPRequest;
  i, z, arr_c : integer;
  can_free : Boolean;

function GetUrl : string;
begin
  result := URLTable[Random(High(URLTable))];
end;

begin
  Randomize;
  InitSSLInterface;
  arr_c := 2;
  Write('Count: ');
  Read(arr_c);
  MYThread := TMYThread.Create;
  for i := 0 to arr_c - 1 do
  begin
    tmp_arr  := TMyHTTPRequest.Create(true);
    tmp_arr.URL := GetUrl;
    MYThread.Add(tmp_arr);
    MYThread.Items[i].Start;
  end;
  {не сильно верный вариант}
  can_free := false;
  While not can_free do
  begin
    z := 0;
    for i := 0 to arr_c - 1 do
    begin
      if MYThread.Items[i].Active then
        inc(z);
    end;
    if z = 0 then
      can_free := true;
    Sleep(2);
  end;
  MYThread.Clear;
  FreeAndNil(MYThread);
  WriteLn('End works');
end.

Код: Выделить всё

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes,
  SysUtils,
  fphttpclient;

type

  { TMyHTTPRequest }

  TMyHTTPRequest = class(TThread)
  private
    Client    : TFPHTTPClient;
    fsteam    : TMemoryStream;
    f_url     : string;
    f_active  : Boolean;
  protected
    procedure Execute; override;
  public
    constructor Create(CreateSuspended : boolean);
    destructor Destroy; override;
    property URL : string write f_url;
    property Active : Boolean read f_active;
  end;

implementation

{ TMyHTTPRequest }

constructor TMyHTTPRequest.Create(CreateSuspended: boolean);
begin
  inherited Create(CreateSuspended);
  FreeOnTerminate := True;
  Client := TFPHTTPClient.Create(nil);
  fsteam := TMemoryStream.Create;
  With Client do
  begin
    HTTPversion := '1.1';
  end;
  f_active := true;
end;

procedure TMyHTTPRequest.Execute;
begin
  try
    try
      Client.HTTPMethod('GET', f_url, fsteam, [200, 301, 302])
    except
      on e : Exception do
        WriteLn(e.Message);
    end;
  finally
    WriteLn(Client.ResponseStatusCode, ' from url ', f_url);
  end;
  f_active := false;
end;


destructor TMyHTTPRequest.Destroy;
begin
  FreeAndNil(Client);
  FreeAndNil(fsteam);
  inherited Destroy;
end;
end.

Код: Выделить всё

InitSSLInterface;

Код: Выделить всё

{==============================================================================}

initialization
  if InitSSLInterface then
    SSLImplementation := TSSLOpenSSL;