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.

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.