unit mainformunit; {$mode objfpc}{$H+} interface uses Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls; type ITest = interface function AddValue(val: integer): integer; end; { TMainForm } TMainForm = class(TForm) Button1: TButton; Button2: TButton; procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); private public end; var MainForm: TMainForm; dllHandle: TLibHandle = 0; implementation {$R *.lfm} { TMainForm } procedure TMainForm.Button1Click(Sender: TObject); type TProc = procedure; stdcall; TTestProc = function: ITest; stdcall; var AProc: TProc; TestProc: TTestProc; begin dllHandle := LoadLibrary('Test.dll'); if dllHandle > 0 then begin color := clred; AProc := TProc(GetProcedureAddress(dllHandle, 'showinfo')); AProc; TestProc := TTestProc(GetProcedureAddress(dllHandle, 'GetTestIntf')); Caption := TestProc.AddValue(9).ToString; //TestProc := nil; 测试中:这行代码注释不注释都无内在泄露 。 end; end; procedure TMainForm.Button2Click(Sender: TObject); begin if dllHandle > 0 then begin UnloadLibrary(dllHandle); dllHandle := 0; end; end; end.
DLL
library Test; {$mode objfpc}{$H+} uses Classes, Dialogs, Interfaces, windows, strutils; type ITest = interface function AddValue(val: integer): integer; end; { TTestObject } TTestObject = class(TInterfacedObject, ITest) public function AddValue(val: integer): integer; end; var TestSub: ITest = nil; procedure showinfo; stdcall; begin ShowMessage('ok'); end; function GetTestIntf: ITest; stdcall; begin if not Assigned(TestSub) then TestSub := TTestObject.Create; Result := TestSub; end; exports showinfo, GetTestIntf; { TTestObject } procedure DLLEntryPoint(dllparam: PtrInt); begin if Assigned(TestSub) then TestSub := nil; end; function TTestObject.AddValue(val: integer): integer; begin result := val + 100; end; begin DLL_PROCESS_DETACH_Hook := @DLLEntryPoint; end.