仅按需从 TThread 动态初始化和调用 LoadLibrary 一次

Dynamically initialize and call LoadLibrary from a TThread by demand only once

我有一个 Delphi DLL,需要从我的主 UI 应用程序或工作线程调用它。

我不想在每次调用 DLL 时都调用 LoadLibrary/FreeLibrary。但是,我也不想在我的应用程序初始化部分加载它。因为我可能在应用程序的生命周期内根本不会使用 DLL。

所以我需要的是第一个调用者(thread 或 main UI)来初始化和加载 DLL。 DLL 将在终结部分卸载。我意识到我需要一些同步。所以我使用了一个关键部分,但我似乎无法让它工作。

只有 一个 线程应尝试加载 DLL。如果失败,其他线程不应尝试一次又一次地加载 DLL。

同步没有按预期工作
有人可以提出原因吗?

MCVE:

program Project1;
{$APPTYPE CONSOLE}
uses
  Windows,
  SysUtils,
  Classes;

const
  MyDLL = 'MyDLL.dll';

type
  TDLLProcessProc = function(A: Integer): Integer; stdcall;

var
  DLLProc: TDLLProcessProc = nil;
  DLLModule: HMODULE = 0;
  DLLInitialized: Boolean = False;
  DLLInitialized_OK: Boolean = False;
  CS: TRTLCriticalSection;

procedure InitDLLByFirstCall;
begin
  if DLLModule = 0 then
  begin
    if DLLInitialized then Exit;
    EnterCriticalSection(CS);
    try
      if DLLInitialized then Exit;
      DLLInitialized := True;
      DLLModule := LoadLibrary(MyDLL);
      if DLLModule = 0 then RaiseLastWin32Error;
      DLLProc := GetProcAddress(DLLModule, 'Process');
      if @DLLProc = nil then RaiseLastWin32Error;
      DLLInitialized_OK := True;
    finally
      LeaveCriticalSection(CS);
    end;
  end;
end;

function DLLProcess(A: Integer): Integer;
begin
  InitDLLByFirstCall;
  if not DLLInitialized_OK then
    raise Exception.Create('DLL was not initialized OK');
  Result := DLLProc(A);
end;

type
  TDLLThread = class(TThread)
  private
    FNum: Integer;
  public
    constructor Create(CreateSuspended: Boolean; ANum: Integer);
    procedure Execute; override;
  end;

constructor TDLLThread.Create(CreateSuspended: Boolean; ANum: Integer);
begin
  FreeOnTerminate := True;
  FNum := ANum;
  inherited Create(CreateSuspended);
end;

procedure TDLLThread.Execute;
var
  RetValue: Integer;
begin
  try
    RetValue := DLLProcess(FNum);
    Sleep(0);
    Writeln('TDLLThread Result=> ' + IntToStr(RetValue));
  except
    on E: Exception do
    begin
      Writeln('TDLLThread Error: ' + E.Message);
    end;
  end;
end;

var
  I: Integer;

begin
  InitializeCriticalSection(CS);
  try
    // First 10 thread always fail!  
    for I := 1 to 10 do
      TDLLThread.Create(False, I);
    Readln;

    for I := 1 to 10 do
      TDLLThread.Create(False, I);
    Readln;
  finally
    DeleteCriticalSection(CS);
  end;
end. 

DLL:

library MyDLL;

uses
  Windows;

{$R *.res}        

function Process(A: Integer): Integer; stdcall;
begin
  Result := A;
end;

exports
  Process;

begin
  IsMultiThread := True;
end.

您的双重检查锁定实施不正确。在分配给 DLLProc 之前分配给 DLLModule。所以 DLLModule 可以是非零的,而 DLLProc 仍然是空的。

你在锁外测试的变量必须在所有初始化完成后修改。

模式是这样的:

if not Initialised then begin
  Lock.Enter;
  if not Initialised then begin
    // Do initialisation
    Initialised := True; // after initialisation complete
  end;
  Lock.Leave;
end;

请记住,此处实现的双重检查锁定仅在强大的 x86 内存模型下才有效。如果您将这段代码移动到具有弱内存模型的硬件上,它就不会像实现的那样工作。你需要实施障碍。可以做到,但并非完全微不足道。

不过,双重检查锁定在这里毫无意义。删除它并使用单个关键部分保护所有内容。您正在启动一个线程,这是一项非常昂贵的任务。关键部分的潜在争用可以忽略不计。

您需要修改代码,使 InitDLLByFirstCall 开头检查的条件变量仅在所有初始化完成后设置。因此,DLL 句柄是一个糟糕的选择。

其次,您需要在临界区内外使用相同的条件变量 - 如果为此使用 DLLInitialized,那么 DLLInitialized_OK 和 [= 都没有实际用途14=].

为了让事情更容易推理,您应该尝试使用最少数量的变量。像下面这样的东西应该可以工作:

var
  DLLProc: TDLLProcessProc = nil;
  DLLInitialized: Boolean = False;
  CS: TRTLCriticalSection;

procedure InitDLLByFirstCall;
var
  DLLModule: HMODULE;
begin
  if DLLInitialized then
    Exit;

  EnterCriticalSection(CS);
  try
    if not DLLInitialized then
    try
      DLLModule := LoadLibrary(MyDLL);
      Win32Check(DLLModule <> 0);

      DLLProc := GetProcAddress(DLLModule, 'Process');
      Win32Check(Assigned(DLLProc));
    finally
      DLLInitialized := True;
    end;
  finally
    LeaveCriticalSection(CS);
  end;
end;

function DLLProcess(A: Integer): Integer;
begin
  InitDLLByFirstCall;
  if @DLLProc = nil then
    raise Exception.Create('DLL was not initialized OK');
  Result := DLLProc(A);
end;

如果您不想检查 DLLProcess 中的函数地址,那么您也可以对 DLLInitialized 变量使用整数或枚举,对 [=25= 使用不同的值]未初始化、失败成功