Форум программистов
 
Контакты: о проблемах с регистрацией, почтой и по другим вопросам пишите сюда - alarforum@yandex.ru, проверяйте папку спам! Обязательно пройдите активизацию e-mail.

Вернуться   Форум программистов > Delphi > Общие вопросы Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Здесь нужно купить рекламу за 20 тыс руб в месяц! ) пишите сюда - alarforum@yandex.ru
Без учёта ботов - 20000 человек в день, 350000 в месяц.

Ответ
 
Опции темы
Старый 16.11.2019, 23:18   #1
darkwellroad
Пользователь
 
Регистрация: 01.09.2013
Сообщений: 83
Вопрос Вызов одной DLL из нескольких потоков

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

При создании одного потока - все работает прекрасно и без ошибок. Если потоков 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.
darkwellroad вне форума Ответить с цитированием
Старый 17.11.2019, 00:35   #2
Pavia
Лис
Старожил
 
Аватар для Pavia
 
Регистрация: 18.09.2015
Сообщений: 2,007
По умолчанию

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

А ещё лучше не использовать
Цитата:
Сообщение от darkwellroad Посмотреть сообщение
System.Net.HttpClientComponent,
System.Net.HttpClient,
System.Net.URLClient;
А заменить на indy.
Хорошо поставленный вопрос это уже половина ответа. | Каков вопрос, таков ответ.
У дзен программиста программа делает то что он хотел, а не то что он написал .
Pavia вне форума Ответить с цитированием
Старый 17.11.2019, 00:39   #3
Pavia
Лис
Старожил
 
Аватар для Pavia
 
Регистрация: 18.09.2015
Сообщений: 2,007
По умолчанию

Код:
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;
Хорошо поставленный вопрос это уже половина ответа. | Каков вопрос, таков ответ.
У дзен программиста программа делает то что он хотел, а не то что он написал .
Pavia вне форума Ответить с цитированием
Старый 17.11.2019, 03:17   #4
northener
ПШП
Участник клуба
 
Регистрация: 15.07.2013
Сообщений: 1,595
По умолчанию

del...

Последний раз редактировалось northener; 17.11.2019 в 03:20.
northener на форуме Ответить с цитированием
Старый 17.11.2019, 03:20   #5
northener
ПШП
Участник клуба
 
Регистрация: 15.07.2013
Сообщений: 1,595
По умолчанию

del...
northener на форуме Ответить с цитированием
Старый 17.11.2019, 11:09   #6
darkwellroad
Пользователь
 
Регистрация: 01.09.2013
Сообщений: 83
По умолчанию

Цитата:
Сообщение от 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
darkwellroad вне форума Ответить с цитированием
Старый 17.11.2019, 11:20   #7
Pavia
Лис
Старожил
 
Аватар для Pavia
 
Регистрация: 18.09.2015
Сообщений: 2,007
По умолчанию

Лучше попробуйте ещё сделать синхронным
hndDLLHandle := loadLibrary('gear.dll')
getProcAddress
freeLibrary(hndDLLHandle);
Хорошо поставленный вопрос это уже половина ответа. | Каков вопрос, таков ответ.
У дзен программиста программа делает то что он хотел, а не то что он написал .
Pavia вне форума Ответить с цитированием
Ответ
Опции темы


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Запуск нескольких потоков bilibian Общие вопросы Delphi 41 25.02.2014 16:20
Создание нескольких потоков iKarma Общие вопросы Delphi 9 20.10.2011 18:11
Запуск нескольких потоков bulldog5293 Общие вопросы Delphi 3 11.11.2010 19:24
Работа с файлом из нескольких потоков boris-blade Общие вопросы .NET 2 02.04.2010 17:21