釋放DLL時訪問沖突

我有一個使用計算機名稱的函式，它位于外部 DLL 中。而在我的程式中，我呼叫了這個函式，但是在使用該函式后我無法釋放DLL。

DLL 函式

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;

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

呼叫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;

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

運行函式

ShowMessage(CALLNAMEPC);

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

使用下面的注釋行，它可以正常作業，以釋放訪問沖突。

FreeLibrary(Handle);

uj5u.com熱心網友回復：

在正常情況下，String跨 DLL 邊界回傳托管是不安全的。您需要確保分配記憶體的同一記憶體管理器與釋放記憶體的管理器相同，但在您的示例中并非如此。

您需要：

• 改變DLL成包（BPL），然后有來電顯示使用LoadPackage()的替代LoadLibrary()。包不會受此記憶體問題的影響，但它們確實會受另一個問題的影響 - Caller 和 BPL 必須在相同的編譯器版本中編譯。如果您將一個版本升級到另一個編譯器版本，則您也必須升級另一個版本。這種方法還阻止了您的 DLL 在非 Delphi/CB 環境中可用（無論如何它現在都不能使用，因為它不能，因為它使用的是特定于 Delphi 的功能）。

• 更改 DLL 和 Caller 以使用 RTL 的共享記憶體管理器。這也是特定于 Delphi/CB 的。

• 重寫 DLL 函式以跨不同的編譯器版本/供應商作業。

在最后一種情況下，更改函式的簽名以使用標準呼叫約定，例如cdeclor stdcall，而不是 Delphi 的默認register約定，并按PChar原樣回傳分配的內容，要求呼叫者在使用完畢后釋放它。要么匯出另一個函式以釋放呼叫者可以使用的記憶體，例如：

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;

或者，通過使用作業系統提供的記憶體管理器分配記憶體，呼叫者可以直接使用它，即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;

標籤：德尔福

上一篇：有什么辦法可以更改我的IDE的字體嗎？（RAD作業室10.4）

下一篇：應用11月補丁后，從在Delphi11上崩潰的EXE檔案獲取版本資訊