发布 DLL 时访问冲突

Question

我有一个使用计算机名称的 function，它位于外部 DLL 中。 在我的程序中，我称之为 function，但在使用 function 后，我无法释放 DLL。

DLL + function

function NAMEPC: String;
var lpBuffer : PChar;
    nSize : DWord;
const Buff_Size = MAX_COMPUTERNAME_LENGTH + 1;
begin
  nSize := Buff_Size;
  lpBuffer := StrAlloc(Buff_Size);
  GetComputerName(lpBuffer,nSize);
  Result := String(lpBuffer);
  StrDispose(lpBuffer);
end;

exports
 NAMEPC;

// ****************************************

Function 调用 DLL

function CALLNAMEPC: String;
var Handle: THandle;
    mFDolly: function: String;
begin
 Handle := LoadLibrary(PChar('DLL.dll'));
 try
   mFDolly := GetProcAddress(Handle, 'NAMEPC');

   if Assigned(mFDolly) then
    Result := mFDolly

 else
  Application.MessageBox(PChar('ERROR!'), PChar('Microsoft Windows'), MB_ICONERROR);
 finally
  FreeLibrary(Handle);
 end;
end;

// ****************************************

运行 function

ShowMessage(CALLNAMEPC);

// ****************************************

使用下面的注释行，可以正常释放访问冲突。

FreeLibrary(Handle);

Answer 1

在正常情况下，跨 DLL 边界返回托管String是不安全的。 您需要确保分配 memory 的相同 memory 管理器是释放它的相同管理器，在您的示例中不是这种情况。

您需要：

• 将 DLL 更改为 Package (BPL)，然后让调用者使用LoadPackage()而不是LoadLibrary() 。 包不会受到 memory 问题的影响，但它们确实会遇到另一个问题 - 调用者和 BPL 都必须在相同的编译器版本中编译。 如果您将一个编译器升级到另一个编译器版本，您也必须升级另一个。 这种方法还可以防止您的 DLL 在非 Delphi/CB 环境中使用（不是说它现在可以，因为它不能，因为它使用的是 Delphi 特定的功能）。

• 更改 DLL 和 Caller 以使用 RTL 的共享 memory 管理器。 这也是 Delphi/CB 特有的。

• 重写 DLL function 以跨不同的编译器版本/供应商工作。

在最后一种情况下，更改函数的签名以使用标准调用约定，如cdecl或stdcall ，而不是 Delphi 的默认register约定，并按原样返回分配的PChar ，要求调用者在使用完成时释放它。 导出另一个 function 以释放调用者可以使用的 memory，例如：

function NAMEPC: PChar; stdcall;
var
  nSize : DWord;
const
  Buff_Size = MAX_COMPUTERNAME_LENGTH + 1;
begin
  nSize := Buff_Size;
  Result := StrAlloc(Buff_Size);
  if Result <> nil then
    GetComputerName(Result, nSize);
end;
    
procedure FreeNAMEPC(Ptr: PChar); stdcall;
begin
  StrDispose(Ptr);
end;

exports
  NAMEPC,
  FreeNAMEPC;

function CALLNAMEPC: String;
var
  Handle: THandle;
  p_NAMEPC: function: PChar; stdcall;
  p_FreeNAMEPC: procedure(Ptr: PChar); stdcall;
  P: PChar;
begin
  Result := '';

  Handle := LoadLibrary(PChar('DLL.dll'));
  if Handle = 0 then
    RaiseLastOSError;

  try
    p_NAMEPC := GetProcAddress(Handle, 'NAMEPC');
    if p_NAMEPC = nil then
      RaiseLastOSError;

    p_FreeNAMEPC := GetProcAddress(Handle, 'FreeNAMEPC');
    if p_FreeNAMEPC = nil then
      RaiseLastOSError;
    
    P := p_NAMEPC();
    if P = nil then
      raise Exception.Create('ERROR from NAMEPC!');

    try
      Result := P;
    finally
      p_FreeNAMEPC(P);
    end;

  finally
    FreeLibrary(Handle);
  end;
end;

或者，通过使用调用者可以直接使用的操作系统提供的 memory 管理器分配 memory ，即LocalAlloc() / LocalFree()或CoTaskMemAlloc() / CoTaskMemFree() ，例如：

function NAMEPC: PChar; stdcall;
var
  nSize : DWord;
const
  Buff_Size = MAX_COMPUTERNAME_LENGTH + 1;
begin
  nSize := Buff_Size;
  Result := PChar(LocalAlloc(LMEM_FIXED, nSize * SizeOf(Char)));
  if Result <> nil then
    GetComputerName(Result, nSize);
end;
    
exports
  NAMEPC;

function CALLNAMEPC: String;
var
  Handle: THandle;
  p_NAMEPC: function: PChar; stdcall;
  P: PChar;
begin
  Result := '';

  Handle := LoadLibrary(PChar('DLL.dll'));
  if Handle = 0 then
    RaiseLastOSError;

  try
    p_NAMEPC := GetProcAddress(Handle, 'NAMEPC');
    if p_NAMEPC = nil then
      RaiseLastOSError;
    
    P := p_NAMEPC;
    if P = nil then
      raise Exception.Create('ERROR from NAMEPC!');

    try
      Result := P;
    finally
      LocalFree(P);
    end;

  finally
    FreeLibrary(Handle);
  end;
end;

或者，通过让调用者分配自己的缓冲区，然后将其传递给 DLL 以填充数据，例如：

function NAMEPC(Buffer: PChar; nSize: DWord): DWord; stdcall;
var
  C: Char;
begin
  Result := $FFFFFFFF;
  if Buffer = nil then
  begin
    nSize := 0;
    if not GetComputerName(@C, nSize) then
    begin
      if GetLastError = ERROR_BUFFER_OVERFLOW then
        Result := nSize;
    end;
  end else
  begin
    if GetComputerName(Buffer, nSize) then
      Result := nSize;
  end;
end;
    
exports
  NAMEPC;

function CALLNAMEPC: String;
var
  Handle: THandle;
  p_NAMEPC: function(Buffer: PChar; nSize: Dword): DWord; stdcall;
  Buf: array[0..16] of Char;
  Len: Dword;
begin
  Result := '';

  Handle := LoadLibrary(PChar('DLL.dll'));
  if Handle = 0 then
    RaiseLastOSError;

  try
    p_NAMEPC := GetProcAddress(Handle, 'NAMEPC');
    if p_NAMEPC = nil then
      RaiseLastOSError;
    
    Len := p_NAMEPC(@Buf[0], Length(Buf));
    if Len = $FFFFFFFF then
      raise Exception.Create('ERROR from NAMEPC!');

    SetString(Result, Buf, Len);

    { alternatively:

    Len := p_NAMEPC(nil, 0);
    if Len = $FFFFFFFF then
      raise Exception.Create('ERROR from NAMEPC!');

    SetLength(Result, Len);

    Len := p_NAMEPC(PChar(Result), Len);
    if Len = $FFFFFFFF then
      raise Exception.Create('ERROR from NAMEPC!');

    SetLength(Result, Len);
    }

  finally
    FreeLibrary(Handle);
  end;
end;