TSslHttpCli in multithreading environment

[Mark Lobanov 1]

Hello

 

I'm trying to use TSslHttpCli in multithreading environment (Parallel Programming Library) and getting an error ESocketException with message 'Invalid argument (#10022 in WSACancelAsyncRequest)’ in Get method.

Please, help me. Why does an error occurs?

If I'm calling TSslHttpCli.Get in main application thread this error does not occurs.

program ics_test;

{$APPTYPE CONSOLE}


uses
  Classes,
  IOUtils,
  System.Threading,
  System.SyncObjs,
  System.SysUtils,
  OverbyteIcsWndControl,
  OverbyteIcsHttpProt,
  OverbyteIcsWSocket;

type
  TSslHttpCliHelper = class
  strict private
    hc: TSslHttpCli;
    fCookie: string;
    procedure hcOnCookie(Sender: TObject; const Data: String; var Accept: Boolean);
    function handleHttpResult: string;
  public
    procedure doGet;
    constructor Create;
    destructor Destroy; override;
  end;

  TTestTask = class(TTask)
  private
    fHelper: TSslHttpCliHelper;
  public
    constructor Create(Sender: TObject; Event: TNotifyEvent; const AProc: TProc;
      const APool: TThreadPool; const AParent: TTask);
    destructor Destroy; override;
  end;


function makeFileNameID(Obj: TObject): string;
begin
  Result := IntToHex(Integer( pointer( Obj ) ), 8);
end;


{ TTestTask }

constructor TTestTask.Create(Sender: TObject; Event: TNotifyEvent; const AProc: TProc;
      const APool: TThreadPool; const AParent: TTask);
begin
  inherited Create(Sender, Event, AProc, APool, AParent);
  fHelper := TSslHttpCliHelper( Sender );
end;


destructor TTestTask.Destroy;
begin
  fHelper.Free;
  inherited;
end;

{ TSslHttpCliHelper }

constructor TSslHttpCliHelper.Create;
begin
  hc := TSslHttpCli.Create( nil );
  hc.ContentTypePost := 'application/json';
  hc.Accept := '*/*';
  hc.Connection := 'Keep-Alive';
  hc.Agent := 'User-Agent: Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/74.0.3729.131 Safari/537.36';
  hc.ResponseNoException := True;
//  hc.MultiThreaded := True;
  hc.SendStream := nil;
  hc.RcvdStream := TBytesStream.Create;
  hc.OnCookie := hcOnCookie;

  hc.sslContext := TSslContext.Create( nil );
  hc.sslContext.SslMinVersion := sslVerTLS1_2;
  hc.sslContext.SslMaxVersion := sslVerTLS1_3;
end;

destructor TSslHttpCliHelper.Destroy;
begin
  hc.SendStream.Free;
  hc.RcvdStream.Free;
  hc.SslContext.Free;
  hc.Free;
  inherited;
end;

procedure TSslHttpCliHelper.doGet;
begin
  hc.url := 'https://api.ehealth-ukraine.org/api/dictionaries';
  hc.Get;
  TFile.WriteAllText('test.'+makeFileNameID( Self )+'.json', handleHttpResult, TEncoding.UTF8);
end;

function TSslHttpCliHelper.handleHttpResult: string;
begin
  if Assigned( hc.RcvdStream ) and (hc.RcvdStream.Size > 0)
    then Result := Trim( TEncoding.UTF8.GetString( TBytesStream( hc.RcvdStream ).Bytes ) )
    else Result := EmptyStr;
end;

procedure TSslHttpCliHelper.hcOnCookie(Sender: TObject; const Data: String; var Accept: Boolean);
begin
  fCookie := Data;
  Accept := True;
end;

function createTask(ATaskHelper: TSslHttpCliHelper): TTestTask;
begin
  Result := TTestTask.Create(ATaskHelper, nil,
    procedure()
    begin
      ATaskHelper.doGet;
    end,
    TThreadPool.Default, nil);
end;

var tasks: array of ITask;
    task: ITask;
    hlp: TSslHttpCliHelper;

begin
{
// Normal
  hlp := TSslHttpCliHelper.Create;
  try
    hlp.doGet;
  finally
    hlp.Free;
  end;
}


{
---------------------------
Debugger Exception Notification
---------------------------
Project ics_test.exe raised exception class ESocketException with message 'Invalid argument (#10022 in WSACancelAsyncRequest)'.
---------------------------
Break   Continue   Help
---------------------------
}
  SetLength(tasks, 1);
  tasks[0] := createTask( TSslHttpCliHelper.Create );

  for task in tasks do
      task.Start;

  TTask.WaitForAll( tasks );

  SetLength(tasks, 0);
end.

 

I use Delphi Tokyo 25.0.29899.2631 and ICS 8.61

An example in attachment.

ics_test.zip

Edited July 11, 2019 by Mark Lobanov
code from example added

[FPiette 385]

No sure it is the problem but an ICS component must be created in the context of the thread handling his events. And that thread must have a message pump.

 

[Mark Lobanov 1]

Excuse me, I'm don't understand you ((

How I have to correct my code?

[Clément 148]

Hi Mark,

 

Have you to set USE_SSL and NOFORMS in your project conditional defines?
 

[Mark Lobanov 1]

6 hours ago, Clément said:

Have you to set USE_SSL and NOFORMS in your project conditional defines?

 

No,

I'll try.

[Mark Lobanov 1]

9 hours ago, Clément said:

Have you to set USE_SSL and NOFORMS in your project conditional defines?
 

I applied your advice.
Error still occurs

[FPiette 385]

On 7/10/2019 at 8:18 PM, Mark Lobanov said:

Excuse me, I'm don't understand you ((

How I have to correct my code?

I looked closer to you code. I don't see any message pump. The component cannot work. See multithreaded sample programs delivered with ICS. They all include a message pump (GetMessage/PeekMessage.DispatchMessage and so on).