Привет всем. Не спрашивайте зачем
При создании одного потока - все работает прекрасно и без ошибок. Если потоков 2 и больше - либо вылетает, либо сыпется различного рода ошибками, типа EAccessViolation или EInvalidPointer. Буду очень благодарен, если направите мысли в нужное русло! Всем спасибо!
Код DLL:
Код:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 | 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
Result := PResponse.StatusCode;
finally
PResponse := nil;
free
end;
end;
exports Execute;
begin
end.
|
Код потока:
Код:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 | 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.
|
Работаю так:
Код:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 | 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
public
end;
var
TestForm: TTestForm;
implementation
uses TestThreadUnit;
{$R *.dfm}
procedure TTestForm.ThreadButtonClick(Sender: TObject);
var
m: integer;
begin
TestThread.Create.FreeOnTerminate := true;
end;
end.
|
16.11.2019, 22:12
Вызов одной DLL из нескольких потоков
Линейный вид
