zoukankan      html  css  js  c++  java
  • lazarus windows下 dll 导出接口测试

    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.
    View Code

    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.
    View Code
  • 相关阅读:
    分布式任务调度 xxl-job
    【线上】 select * from xxoo where 1=1应用挂掉
    【死磕ES】七、基础检索
    【死磕ES】四、基本操作
    【死磕ES】三、基本概念
    【死磕ES】二、搭建环境
    Mac共享文件夹
    微信小程序下拉刷新,上拉加载
    微信小程序textarea输入框出现[object Object]
    微信小程序official-account的使用
  • 原文地址:https://www.cnblogs.com/Jiaojiawang/p/14342346.html
Copyright © 2011-2022 走看看