HTTP Manager (Threaded HTTP requests)

untHTTPManager.pas

unit untHTTPManager;

interface

uses
  System.Classes, System.SysUtils, System.Generics.Collections, System.Threading, IdHTTP, IdSSLOpenSSL,
  Winapi.Windows, Winapi.Messages;

type
  THTTPThreadManager = class;

  THTTPMethod = (GET, POST, PUT, PATCH, DELETE, HEAD);

  THTTPRequestData = record
    URL: string;
    Method: THTTPMethod;
    Headers: TStrings;
    Data: TStrings; // TStrings to hold JSON data for POST requests
    UserAgent: string;
    RequestTimeout: Integer;
    ResponseTimeout: Integer;
    FollowRedirects: Boolean;
    HandleRedirects: Boolean;
    AllowCookies: Boolean;
    MaxRedirects: Integer;
  end;

  TProxyServer = record
    IPAddress: string;
    Port: Integer;
  end;

  THTTPResponseData = record
    StatusCode: Integer;
    Response: string;
  end;

  TThreadProgressType = (ThreadStarted, DoHTTPRequest, ParseHTTPResponse, ReturnToMain);
  TThreadProgressEvent = procedure(Sender: TObject; ThreadIndex: Integer; ProgressType: TThreadProgressType; Progress: Integer) of object;
  TThreadResponseEvent = procedure(Sender: TObject; ThreadIndex: Integer; const ResponseData: THTTPResponseData) of object;
  TThreadErrorEvent = procedure(Sender: TObject; ThreadIndex: Integer; ErrorMsg: string) of object;
  TThreadExceptionEvent = procedure(Sender: TObject; ThreadIndex: Integer; E: Exception) of object;

const
  WM_THREAD_PROGRESS = WM_USER + 1;
  WM_THREAD_RESPONSE = WM_USER + 2;
  WM_THREAD_ERROR = WM_USER + 3;
  WM_THREAD_EXCEPTION = WM_USER + 4;

type
  THTTPThread = class(TThread)
  private
    FManagerHandle: HWND;
    FThreadIndex: Integer;
    FRequestData: THTTPRequestData;
    FHTTP: TIdHTTP;
    FSSLIOHandler: TIdSSLIOHandlerSocketOpenSSL;
    FUseProxy: Boolean;
    FProxy: TProxyServer;
    procedure HTTPWorkBegin(ASender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Int64);
    procedure HTTPWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);
    procedure HTTPWorkEnd(ASender: TObject; AWorkMode: TWorkMode);
    procedure PostProgressMessage(ProgressType: TThreadProgressType; Progress: Integer);
    procedure PostErrorMessage(ErrorMsg: string);
    procedure PostExceptionMessage(E: Exception);
  public
    constructor Create(ManagerHandle: HWND; ThreadIndex: Integer; const RequestData: THTTPRequestData; UseProxy: Boolean; const Proxy: TProxyServer);
    destructor Destroy; override;
    procedure Execute; override;
  end;

  THTTPThreadManager = class
  private
    FThreadList: TList<THTTPThread>;
    FRequestList: TList<THTTPRequestData>;
    FMaxThreads: Integer;
    FUseProxy: Boolean;
    FProxyServers: TList<TProxyServer>;
    FCurrentProxyIndex: Integer;
    FOnProgress: TThreadProgressEvent;
    FOnResponse: TThreadResponseEvent;
    FOnError: TThreadErrorEvent;
    FOnException: TThreadExceptionEvent;
    FRunning: Boolean;
    FPaused: Boolean;
    FPauseEvent: TEvent;
    FResponseLock: TCriticalSection;
    FHandle: HWND;
    function GetRequests(Index: Integer): THTTPRequestData;
    function GetRequestsCount: Integer;
    procedure DoThreadProgress(ThreadIndex: Integer; ProgressType: TThreadProgressType; Progress: Integer);
    procedure DoThreadResponse(ThreadIndex: Integer; const ResponseData: THTTPResponseData);
    procedure DoThreadError(ThreadIndex: Integer; ErrorMsg: string);
    procedure DoThreadException(ThreadIndex: Integer; E: Exception);
    procedure StartNextThread;
    procedure HandleProgressMessage(var Msg: TMessage); message WM_THREAD_PROGRESS;
    procedure HandleResponseMessage(var Msg: TMessage); message WM_THREAD_RESPONSE;
    procedure HandleErrorMessage(var Msg: TMessage); message WM_THREAD_ERROR;
    procedure HandleExceptionMessage(var Msg: TMessage); message WM_THREAD_EXCEPTION;
  public
    constructor Create(MaxThreads: Integer; Handle: HWND);
    destructor Destroy; override;
    procedure AddRequest(const RequestData: THTTPRequestData);
    procedure RemoveRequest(Index: Integer);
    procedure MoveRequest(FromIndex, ToIndex: Integer);
    procedure Start;
    procedure Pause;
    procedure Stop;
    procedure AddProxyServer(const IPAddress: string; Port: Integer);
    procedure ClearProxyServers;
    property MaxThreads: Integer read FMaxThreads write FMaxThreads;
    property UseProxy: Boolean read FUseProxy write FUseProxy;
    property OnProgress: TThreadProgressEvent read FOnProgress write FOnProgress;
    property OnResponse: TThreadResponseEvent read FOnResponse write FOnResponse;
    property OnError: TThreadErrorEvent read FOnError write FOnError;
    property OnException: TThreadExceptionEvent read FOnException write FOnException;
    property Requests[Index: Integer]: THTTPRequestData read GetRequests;
    property RequestsCount: Integer read GetRequestsCount;
  end;

implementation

uses
  IdIOHandlerSocket;

{ THTTPThread }

constructor THTTPThread.Create(ManagerHandle: HWND; ThreadIndex: Integer; const RequestData: THTTPRequestData;
  UseProxy: Boolean; const Proxy: TProxyServer);
begin
  inherited Create(True);
  FManagerHandle := ManagerHandle;
  FThreadIndex := ThreadIndex;
  FRequestData := RequestData;
  FHTTP := TIdHTTP.Create(nil);
  FHTTP.OnWorkBegin := HTTPWorkBegin;
  FHTTP.OnWork := HTTPWork;
  FHTTP.OnWorkEnd := HTTPWorkEnd;

  // Set properties from THTTPRequestData
  FHTTP.Request.UserAgent := FRequestData.UserAgent;
  FHTTP.ConnectTimeout := FRequestData.RequestTimeout;
  FHTTP.ReadTimeout := FRequestData.ResponseTimeout;
  FHTTP.HandleRedirects := FRequestData.HandleRedirects;
  FHTTP.AllowCookies := FRequestData.AllowCookies;
  FHTTP.MaxRedirects := FRequestData.MaxRedirects;

  // Create SSL handler and assign it to the TIdHTTP component
  FSSLIOHandler := TIdSSLIOHandlerSocketOpenSSL.Create(nil);
  FHTTP.IOHandler := FSSLIOHandler;

  FUseProxy := UseProxy;
  FProxy := Proxy;
end;

destructor THTTPThread.Destroy;
begin
  FRequestData.Headers.Free;
  FRequestData.Data.Free; // Free TStrings that holds JSON data
  FHTTP.Free;
  FSSLIOHandler.Free;
  inherited;
end;

procedure THTTPThread.Execute;
var
  Response: string;
  StatusCode: Integer;
begin
  try
    // Post thread started message
    PostProgressMessage(TThreadProgressType.ThreadStarted, 0);

    // Apply headers to the HTTP component
    FHTTP.Request.CustomHeaders.AddStrings(FRequestData.Headers);

    if FUseProxy then
    begin
      // Apply proxy settings
      FHTTP.ProxyParams.ProxyServer := FProxy.IPAddress;
      FHTTP.ProxyParams.ProxyPort := FProxy.Port;
    end;

    PostProgressMessage(TThreadProgressType.DoHTTPRequest, 0);
    case FRequestData.Method of
      GET: Response := FHTTP.Get(FRequestData.URL);
      POST: Response := FHTTP.Post(FRequestData.URL, FRequestData.Data);
      PUT: Response := FHTTP.Put(FRequestData.URL, FRequestData.Data);
      PATCH: Response := FHTTP.Patch(FRequestData.URL, FRequestData.Data);
      DELETE: Response := FHTTP.Delete(FRequestData.URL);
      HEAD: Response := FHTTP.Head(FRequestData.URL);
    else
      raise Exception.Create('Invalid HTTP Method');
    end;

    StatusCode := FHTTP.ResponseCode;
    PostProgressMessage(TThreadProgressType.ParseHTTPResponse, 50);

    // Create the response data record and pass it to the manager
    var ResponseData: THTTPResponseData;
    ResponseData.StatusCode := StatusCode;
    ResponseData.Response := Response;
    PostMessage(FManagerHandle, WM_THREAD_RESPONSE, FThreadIndex, LParam(@ResponseData));

    PostProgressMessage(TThreadProgressType.ReturnToMain, 100);
  except
    on E: Exception do
    begin
      PostErrorMessage(E.Message);
      PostExceptionMessage(E);
    end;
  end;
end;

procedure THTTPThread.HTTPWorkBegin(ASender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Int64);
begin
  PostProgressMessage(TThreadProgressType.DoHTTPRequest, 0);
end;

procedure THTTPThread.HTTPWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);
var
  Progress: Integer;
begin
  if AWorkCountMax > 0 then
    Progress := MulDiv(AWorkCount, 100, AWorkCountMax)
  else
    Progress := 0;

  PostProgressMessage(TThreadProgressType.DoHTTPRequest, Progress);
end;

procedure THTTPThread.HTTPWorkEnd(ASender: TObject; AWorkMode: TWorkMode);
begin
  PostProgressMessage(TThreadProgressType.ParseHTTPResponse, 50);
end;

procedure THTTPThread.PostProgressMessage(ProgressType: TThreadProgressType; Progress: Integer);
begin
  PostMessage(FManagerHandle, WM_THREAD_PROGRESS, FThreadIndex, ProgressType or (Progress shl 16));
end;

procedure THTTPThread.PostErrorMessage(ErrorMsg: string);
begin
  PostMessage(FManagerHandle, WM_THREAD_ERROR, FThreadIndex, LPARAM(PChar(ErrorMsg)));
end;

procedure THTTPThread.PostExceptionMessage(E: Exception);
begin
  PostMessage(FManagerHandle, WM_THREAD_EXCEPTION, FThreadIndex, LPARAM(E));
end;

{ THTTPThreadManager }

constructor THTTPThreadManager.Create(MaxThreads: Integer; Handle: HWND);
begin
  FThreadList := TList<THTTPThread>.Create;
  FRequestList := TList<THTTPRequestData>.Create;
  FMaxThreads := MaxThreads;
  FUseProxy := False;
  FProxyServers := TList<TProxyServer>.Create;
  FCurrentProxyIndex := 0;
  FOnProgress := nil;
  FOnResponse := nil;
  FOnError := nil;
  FOnException := nil;
  FRunning := False;
  FPaused := False;
  FPauseEvent := TEvent.Create(nil, False, False, '');
  FResponseLock := TCriticalSection.Create;
  FHandle := Handle;
end;

destructor THTTPThreadManager.Destroy;
begin
  Stop;
  ClearProxyServers;
  FThreadList.Free;
  FRequestList.Free;
  FProxyServers.Free;
  FPauseEvent.Free;
  FResponseLock.Free;
  inherited;
end;

procedure THTTPThreadManager.AddRequest(const RequestData: THTTPRequestData);
begin
  FRequestList.Add(RequestData);
  if FRunning and not FPaused then
    StartNextThread;
end;

procedure THTTPThreadManager.RemoveRequest(Index: Integer);
begin
  FRequestList.Delete(Index);
end;

procedure THTTPThreadManager.MoveRequest(FromIndex, ToIndex: Integer);
begin
  FRequestList.Move(FromIndex, ToIndex);
end;

procedure THTTPThreadManager.Start;
begin
  if not FRunning then
  begin
    FRunning := True;
    FPaused := False;
    StartNextThread;
  end;
end;

procedure THTTPThreadManager.Pause;
begin
  FPaused := True;
  FPauseEvent.ResetEvent;
end;

procedure THTTPThreadManager.Stop;
begin
  FRunning := False;
  FPaused := False;
  FPauseEvent.SetEvent;
end;

procedure THTTPThreadManager.AddProxyServer(const IPAddress: string; Port: Integer);
var
  Proxy: TProxyServer;
begin
  Proxy.IPAddress := IPAddress;
  Proxy.Port := Port;
  FProxyServers.Add(Proxy);
end;

procedure THTTPThreadManager.ClearProxyServers;
begin
  FProxyServers.Clear;
  FCurrentProxyIndex := 0;
end;

function THTTPThreadManager.GetRequests(Index: Integer): THTTPRequestData;
begin
  Result := FRequestList[Index];
end;

function THTTPThreadManager.GetRequestsCount: Integer;
begin
  Result := FRequestList.Count;
end;

procedure THTTPThreadManager.DoThreadProgress(ThreadIndex: Integer; ProgressType: TThreadProgressType; Progress: Integer);
begin
  if Assigned(FOnProgress) then
    FOnProgress(Self, ThreadIndex, ProgressType, Progress);
end;

procedure THTTPThreadManager.DoThreadResponse(ThreadIndex: Integer; const ResponseData: THTTPResponseData);
begin
  if Assigned(FOnResponse) then
    FOnResponse(Self, ThreadIndex, ResponseData);
end;

procedure THTTPThreadManager.DoThreadError(ThreadIndex: Integer; ErrorMsg: string);
begin
  if Assigned(FOnError) then
    FOnError(Self, ThreadIndex, ErrorMsg);
end;

procedure THTTPThreadManager.DoThreadException(ThreadIndex: Integer; E: Exception);
begin
  if Assigned(FOnException) then
    FOnException(Self, ThreadIndex, E);
end;

procedure THTTPThreadManager.StartNextThread;
var
  Thread: THTTPThread;
  RequestData: THTTPRequestData;
  ProxyServer: TProxyServer;
begin
  if FPaused then
  begin
    FPauseEvent.WaitFor(INFINITE);
    if not FRunning then
      Exit;
  end;

  if FThreadList.Count < FMaxThreads then
  begin
    if FRequestList.Count > 0 then
    begin
      RequestData := FRequestList[0];
      FRequestList.Delete(0);

      if FUseProxy and (FProxyServers.Count > 0) then
      begin
        ProxyServer := FProxyServers[FCurrentProxyIndex];
        Inc(FCurrentProxyIndex);
        if FCurrentProxyIndex >= FProxyServers.Count then
          FCurrentProxyIndex := 0;
      end
      else
      begin
        ProxyServer.IPAddress := '';
        ProxyServer.Port := 0;
      end;

      Thread := THTTPThread.Create(FHandle, FThreadList.Count, RequestData, FUseProxy, ProxyServer);
      FThreadList.Add(Thread);
      Thread.Start;
    end
    else
      FRunning := False;
  end;
end;

procedure THTTPThreadManager.HandleProgressMessage(var Msg: TMessage);
var
  ThreadIndex, ProgressType, Progress: Integer;
begin
  ThreadIndex := Msg.WParam;
  ProgressType := Msg.LParam and $FFFF;
  Progress := (Msg.LParam shr 16) and $FFFF;

  DoThreadProgress(ThreadIndex, TThreadProgressType(ProgressType), Progress);
end;

procedure THTTPThreadManager.HandleResponseMessage(var Msg: TMessage);
var
  ThreadIndex: Integer;
  ResponseData: THTTPResponseData;
begin
  ThreadIndex := Msg.WParam;
  ResponseData := PHTTPResponseData(Msg.LParam)^;
  DoThreadResponse(ThreadIndex, ResponseData);

  FResponseLock.Acquire;
  try
    FThreadList[ThreadIndex].Free;
    FThreadList.Delete(ThreadIndex);
  finally
    FResponseLock.Release;
  end;

  StartNextThread;
end;

procedure THTTPThreadManager.HandleErrorMessage(var Msg: TMessage);
var
  ThreadIndex: Integer;
  ErrorMsg: string;
begin
  ThreadIndex := Msg.WParam;
  ErrorMsg := PChar(Msg.LParam);
  DoThreadError(ThreadIndex, ErrorMsg);
end;

procedure THTTPThreadManager.HandleExceptionMessage(var Msg: TMessage);
var
  ThreadIndex: Integer;
  E: Exception;
begin
  ThreadIndex := Msg.WParam;
  E := Exception(Msg.LParam);
  DoThreadException(ThreadIndex, E);
end;

end.