Вызов одной DLL из нескольких потоков

[darkwellroad]

Привет всем. Не спрашивайте зачем

При создании одного потока - все работает прекрасно и без ошибок. Если потоков 2 и больше - либо вылетает, либо сыпется различного рода ошибками, типа EAccessViolation или EInvalidPointer. Буду очень благодарен, если направите мысли в нужное русло! Всем спасибо!

Код DLL:

library gear;
 
uses
  System.SysUtils,
  System.Net.HttpClientComponent,
  System.Net.HttpClient,
  System.Net.URLClient;
 
{$R *.res}
 
function Execute: Integer; stdcall;
var
  PResponse: IHTTPResponse;
begin
  with TNetHTTPClient.Create(nil) do
    try
      PResponse := GET('https://www.google.com/');
      Result := PResponse.StatusCode;
    finally
      PResponse := nil;
      free
    end;
end;
 
exports Execute;
 
begin
 
end.

Код потока:

unit TestThreadUnit;
 
interface
 
uses
  Windows,
  SysUtils,
  Classes;
 
type
  TExecute = function(): Integer;
 
  TestThread = class(TThread)
  protected
    I: Integer;
    procedure Execute; override;
  public
    constructor Create;
    procedure Sync;
  end;
 
implementation
 
uses TestUnit;
 
constructor TestThread.Create;
begin
  inherited Create(false);
end;
 
 
procedure TestThread.Execute;
var
  hndDLLHandle: THandle;
  Ex: TExecute;
begin
  try
    hndDLLHandle := loadLibrary('gear.dll');
    if hndDLLHandle <> 0 then
      begin
        @Ex := getProcAddress(hndDLLHandle, 'Execute');
        if addr(Ex) <> nil then
          I := Ex()
        else
          I := -1;
      end
    else
      I := -1;
  finally
    freeLibrary(hndDLLHandle);
    Synchronize(Sync);
  end;
end;
 
procedure TestThread.Sync;
begin
  TestForm.Memo1.Lines.Add(I.ToString);
end;
 
end.

Работаю так:

unit TestUnit;
 
interface
 
uses
 
  System.Classes,
  Vcl.Controls,
  Vcl.Forms,
  Vcl.StdCtrls;
 
type
 
  TTestForm = class(TForm)
    ThreadButton: TButton;
    Memo1: TMemo;
    procedure ThreadButtonClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  TestForm: TTestForm;
 
implementation
 
uses TestThreadUnit;
 
{$R *.dfm}
 
procedure TTestForm.ThreadButtonClick(Sender: TObject);
var
  m: integer;
begin
  // for m := 0 to 1 do
  TestThread.Create.FreeOnTerminate := true;
end;
 
end.

[Pavia]

IHTTPResponse это интерфейс. Интерфейсы это не объекты, а указатели которые ссылаются на общий объект. А общий объект должен быть защищен от параллельного доступа. К примеру мьютексом, в вашем случае лучше критической секцией.

А ещё лучше не использовать

Сообщение от darkwellroad

System.Net.HttpClientComponent,
System.Net.HttpClient,
System.Net.URLClient;

А заменить на indy.

[Pavia]

uses ...
IdBaseComponent,
  IdComponent, IdTCPConnection, IdTCPClient, IdHTTP, IdIOHandler,
  IdIOHandlerSocket, IdIOHandlerStack, IdSSL, IdSSLOpenSSL, IdURI;
...
function GetPage(URL:String; var Text:String):Boolean;
var
 HTTP: TIdHTTP;
 IdHandler:TIdSSLIOHandlerSocketOpenSSL;
begin
 Result:=False;
try
 IdHandler := TIdSSLIOHandlerSocketOpenSSL.Create (nil);
 HTTP := TIdHTTP.Create(nil);
 HTTP.IOHandler := IdHandler;
//  HTTP:=IdHTTP1;
  HTTP.HandleRedirects:=true;
  HTTP.ConnectTimeout:=1000;
  HTTP.ReadTimeout:=1000;
  try
    Text:=HTTP.Get(URL);
    if Pos('200', HTTP.ResponseText) <>0 then
       begin
         result:=True;
       end;
  finally
    HTTP.Destroy;
  end;
except

end;
end;

[northener]

del...

[northener]

del...

[darkwellroad]

Сообщение от Pavia

uses ...
IdBaseComponent,
  IdComponent, IdTCPConnection, IdTCPClient, IdHTTP, IdIOHandler,
  IdIOHandlerSocket, IdIOHandlerStack, IdSSL, IdSSLOpenSSL, IdURI;
...
function GetPage(URL:String; var Text:String):Boolean;
var
 HTTP: TIdHTTP;
 IdHandler:TIdSSLIOHandlerSocketOpenSSL;
begin
 Result:=False;
try
 IdHandler := TIdSSLIOHandlerSocketOpenSSL.Create (nil);
 HTTP := TIdHTTP.Create(nil);
 HTTP.IOHandler := IdHandler;
//  HTTP:=IdHTTP1;
  HTTP.HandleRedirects:=true;
  HTTP.ConnectTimeout:=1000;
  HTTP.ReadTimeout:=1000;
  try
    Text:=HTTP.Get(URL);
    if Pos('200', HTTP.ResponseText) <>0 then
       begin
         result:=True;
       end;
  finally
    HTTP.Destroy;
  end;
except

end;
end;

library gear;

uses
  System.SysUtils,
  IdBaseComponent,
  IdComponent,
  IdTCPConnection,
  IdTCPClient,
  IdHTTP,
  IdIOHandler,
  IdIOHandlerSocket,
  IdIOHandlerStack,
  IdSSL,
  IdSSLOpenSSL,
  IdURI;

{$R *.res}

function Execute: Integer; stdcall;
var
  HTTP: TIdHTTP;
  IdHandler: TIdSSLIOHandlerSocketOpenSSL;
begin
  Result := 0;
  try
    IdHandler := TIdSSLIOHandlerSocketOpenSSL.Create(nil);
    HTTP := TIdHTTP.Create(nil);
    HTTP.IOHandler := IdHandler;
    HTTP.HandleRedirects := true;
    HTTP.ConnectTimeout := 5000;
    HTTP.ReadTimeout := 5000;
    try
      HTTP.Get('https://www.google.com/');
      Result := HTTP.ResponseCode;
    finally
      FreeAndNil(IdHandler);
      FreeAndNil(HTTP);
    end;
  except

  end;
end;

exports Execute;

begin

end.

Переписал код dll. Положил libeay, ssleay. Один поток работает - больше одного отваливается. Попробую сегодня другие компоненты, типа Synapse, Overbyte ICS

[Pavia]

Лучше попробуйте ещё сделать синхронным
hndDLLHandle := loadLibrary('gear.dll')
getProcAddress
freeLibrary(hndDLLHandle);