碼上快樂

相關內容    簡體    繁體

Delphi采用接口實現DLL調用

本文轉載自   查看原文   2013-08-19 13:51   5594    接口/ DLL/ Delphi

Delphi使用模塊化開發，可以采用DLL或者BPL，兩者的區別是BPL只能被同版本的Delphi使用，DLL可以被不同版本和不同開發工具的開發的軟件調用。

因此我們的軟件大多使用Delphi作為界面以及部分DLL模塊的開發工具。

DLL模塊之間通過接口方式調用。

 

1.對象創建采用工廠模式，每個DLL負責某個對象或若干個對象的創建及釋放，例如：

DLL工程為http客戶端(prjHttp.DLL)模塊，通過DLL導出的GetHttpClientFactory獲取http客戶端工廠接口，通過接口創建Http客戶端和釋放Http客戶端，工程

包括3個文件：工程文件，實現單元，接口單元。

調用此DLL的程序僅需要包含接口單元。

 

DLL工程文件

1 library prjHttp;
2 
3 uses   System.SysUtils,   System.Classes,   utHTTPClient in 'utHTTPClient.pas';
4 
5 {$R *.res}
6 
7 exports   
8   GetHttpClientFactory; 
9 end.


utHttpClient示例

unit utHttpClient;

interface

uses utBaseObject, utHttpInterface, Classes, SysUtils;

type
  .........

  THTTPClientConnection = class(TIntObject, IHTTPClientConnection)
  public
    function Connect: Boolean;
    function Info: IHTTPClientConnectionInfo;
    function TcpConnection: ITcpConnection;
    function DataConnection: IConnection;
    function Param:IHttpClientConnectionParam;
  public
    constructor Create;
    destructor Destroy; override;
  end;


  THttpClientConnectionFactory = class(TIntObject, IHttpClientConnectionFactory)
  protected
    FObjectPool: THTTPClientConnectionPool;
  public
    constructor Create;
    destructor Destroy; override;
    procedure CreateHttpClient(out Conn: IHTTPClientConnection);
    procedure DestroyHttpClient(var aClient);
  end;

function GetHttpClientFactory: IHttpClientConnectionFactory;

implementation

............

var
  HttpClients: THttpClientConnectionFactory;

function GetHttpClientFactory: IHttpClientConnectionFactory;
begin
  if not Assigned(HttpClients) then
    HttpClients := THttpClientConnectionFactory.Create;
  Result        := HttpClients;
end;

initialization
finalization
  if Assigned(HttpClients) then FreeAndNil(HttpClients);
end.

 

utHttpInterface接口文件示例

unit utHttpInterface;

interface

uses utBaseInterface;

const
  IID_IHTTPClientConnectionInfo            = '{24C3D6BF-EC3D-4783-AD98-A5C6E4F24F19}';
  IID_IHTTPClientConnectionParam           = '{0FA49A71-48BF-40CD-9D77-63B233C4F717}';
  IID_IHTTPClientConnection                = '{78C39E26-A690-4022-9E97-6035768CE75C}';
  IID_IHTTPClientConnectionEvent           = '{2FB0AC19-9994-4E77-B105-121192943EBC}';
  IID_IHttpClientConnectionFactory         = '{429C5C2B-C1E3-4871-9631-E3B943619EFD}';


  GUID_IHTTPClientConnectionInfo: TGUID    = IID_IHTTPClientConnectionInfo;
  GUID_IHTTPClientConnectionParam: TGUID   = IID_IHTTPClientConnectionParam;
  GUID_IHTTPClientConnection: TGUID        = IID_IHTTPClientConnection;
  GUID_IHTTPClientConnectionEvent: TGUID   = IID_IHTTPClientConnectionEvent;
  GUID_IHttpClientConnectionFactory        = IID_IHttpClientConnectionFactory;
type
  IHttpClientConnectionParam = interface
    ['{0FA49A71-48BF-40CD-9D77-63B233C4F717}']
    function TcpParam: ITcpConnectionParam;
    function GetMethod: PAnsiChar;
    function GetPathAndParams: PAnsiChar;
    function GetAgent: PAnsiChar;
    function GetHeader: PAnsiChar;
    function GetData: PAnsiChar;
    function GetUserName: PAnsiChar;
    function GetPassword: PAnsiChar;
    procedure SetValue(const ServerAddr: PAnsiChar; const ServerPort: Integer; const UserName, Password, Method, PathAndParams, Agent, Header, Data: PAnsiChar);
  end;

  IHTTPClientConnectionInfo = interface(ITcpConnectionInfo)
    ['{24C3D6BF-EC3D-4783-AD98-A5C6E4F24F19}']
    function Auth: PAnsiChar;
  end;

  IHTTPClientConnection = interface;
  IHTTPClientConnectionEvent=interface
    ['{2FB0AC19-9994-4E77-B105-121192943EBC}']
    procedure OnHeader(const Http:IHTTPClientConnection; const Header:Pointer; const HeaderLenght:NativeInt);
    procedure OnStartReceiveContent(const Http:IHTTPClientConnection; const ContentLength:NativeInt);
    procedure OnReceiveProgress(const Http:IHTTPClientConnection; const ContentLenght, ContentReceived:NativeInt);
    procedure OnError(const Http:IHTTPClientConnection; const ErrStr:PAnsiChar);
  end;

  THttpClientConnectionEvent = (heHeader, heStartReceiveContent, heReceiveProgress, heError);

  IHTTPClientConnection = interface
    [IID_IHTTPClientConnection]
    function Connect: Boolean;
    function Info: IHTTPClientConnectionInfo;
    function TcpConnection: ITcpConnection;
    function DataConnection: IConnection;
    function Param:IHttpClientConnectionParam;
  end;

  IHttpClientConnectionFactory = interface
    [IID_IHttpClientConnectionFactory]
    procedure CreateHttpClient(out Conn: IHTTPClientConnection);
    procedure DestroyHttpClient(var aClient);
  end;

implementation


end.


調用prjHttp.DLL的Delphi工程可以包含下面的單元以及上面的接口單元utHttpInterface.pas即可

將utHttpDLL.pas中的

//{$define utHttpDLL)

去掉注釋，即可以將http客戶端這些代碼包含到Delphi工程中。

unit utHttpDLL;

//{$define utHttpDLL}
interface

uses utHttpInterface, utBaseInterface;

var
  HttpClientFactory: IHttpClientConnectionFactory;

implementation

{$ifdef utHttpDLL}

uses Windows, SysUtils;

const
  DLLName = 'prjHttp.DLL';

type
  Proc = function: IInterface;

var
  LibHandle: THandle;


function GetHttpClientFactory: IHttpClientConnectionFactory;
begin
  Result := HttpClientFactory;
end;

procedure Init;
var
  P: Proc;
begin
  LibHandle := SafeLoadLibrary(DLLName);
  if LibHandle <> INVALID_HANDLE_VALUE then
  begin
    P                  := GetProcAddress(LibHandle, 'GetHttpClientFactory');
    if Assigned(P) then
      HttpClientFactory := IHttpClientConnectionFactory(P);
  end
  else
    raise Exception.Create('無法打開庫文件' + DLLName);
  if not Assigned(HttpClientFactory) then
    raise Exception.Create(DLLName + '找不到指定函數');
end;

procedure Done;
begin
  if LibHandle <> INVALID_HANDLE_VALUE then
    FreeLibrary(LibHandle);
  Pointer(HttpClientFactory)  := nil;
end;

{$else}
uses utHttpClient;

procedure Init;
begin
  HttpClientFactory:= GetHttpClientFactory;
end;

procedure Done;
begin
  Pointer(HttpClientFactory):=nil;
end;

{$endif}

initialization
Init;
finalization
Done;
end.


2.DLL中輸出接口對象的生命周期管理

Delphi對接口采用引用計數的方法管理對象生命周期，但是DLL中輸出的對象可能不是被Delphi調用，其引用計數不一定正確，因此DLL中接口對象的生命周期不由Delphi編譯器自動生成的代碼管理，而是程序員自己控制，所以上面

的工廠包括構造和解析兩個接口對象的生命周期管理方法。

所有接口對象應該集成自下面的接口，而不應該繼承自Delphi自帶的TInterfacedObject：

  TIntObject = class(TObject, IInterface)
  protected
    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
  end;

function TIntObject.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
  if GetInterface(IID, Obj) then
    Result := 0
  else
    Result := E_NOINTERFACE;
end;

function TIntObject._AddRef: Integer;
begin
  Result := -1;
end;

function TIntObject._Release: Integer;
begin
  Result := -1
end;


3.自管理接口對象在Delphi調用注意事項

1）接口賦值

　　錯誤代碼：（Delphi編譯器產生代碼會先判斷接口指針是否為nil，如果非nil自動調用接口的_Release方法）

  var P1:IHttpServer
。。。。。。。。。。。。
　　  P1:=FServer.Param;
 　　 P1.SetValue(PWideChar(aName), PAnsiChar(AnsiString(ServerAddr)), ServerPort, 10000, 10,0, 40000);

　　

　　建議代碼：

  var P1:IHttpServer
................
  Pointer(P1):=nil;　　  
  P1:=FServer.Param;  //如果賦值前P1不是nil,程序會線調用P1._Release后再賦值

　　

2）局部接口變量
　　錯誤代碼：

constructor TTcpServerSplitter.Create(aName:String; ServerAddr: String; ServerPort: Integer;
  RemoteAddr: String; RemotePort: Integer);
var
  Service:IInterfaceObservable;
  P1:ITcpConnectionServerParam;
  P2:ITcpConnectionParam;
begin
  inherited Create;
  FServerEvent:=TTcpConnectionServerEventAdapter.Create(Self as ITcpConnectionServerEvent);
  FTcpConnectionEvent:=TTcpConnectionEventAdapter.Create(Self as ITcpConnectionEvent);
  FConnectionEvent:=TConnectionEventAdapter.Create(Self as IConnectionEvent);

  TcpServerFactory.CreateTcpConnectionServer(FServer);
  P1:=FServer.Param;
  P1.SetValue(PWideChar(aName), PAnsiChar(AnsiString(ServerAddr)), ServerPort, 10000, 10,0, 40000);
  RegistObserver(FServer, FServerEvent);
  TcpClientFactory.CreateTcpConnection(FRemote);
  P2:=FRemote.Param;
  P2.SetValue(PAnsiChar(AnsiString(RemoteAddr)), RemotePort, Self);
  RegistObserver(FRemote,FTcpConnectionEvent);
end;

上面代碼中運行退出后，Delphi編譯器會在此代碼后面自動調用P1._Release; P2._Release,
　　建議代碼：

constructor TTcpServerSplitter.Create(aName:String; ServerAddr: String; ServerPort: Integer;
  RemoteAddr: String; RemotePort: Integer);
var
  Service:IInterfaceObservable;
  P1:ITcpConnectionServerParam;
  P2:ITcpConnectionParam;
begin
  inherited Create;
  FServerEvent:=TTcpConnectionServerEventAdapter.Create(Self as ITcpConnectionServerEvent);
  FTcpConnectionEvent:=TTcpConnectionEventAdapter.Create(Self as ITcpConnectionEvent);
  FConnectionEvent:=TConnectionEventAdapter.Create(Self as IConnectionEvent);

  TcpServerFactory.CreateTcpConnectionServer(FServer);
  P1:=FServer.Param;
  P1.SetValue(PWideChar(aName), PAnsiChar(AnsiString(ServerAddr)), ServerPort, 10000, 10,0, 40000);
  RegistObserver(FServer, FServerEvent);
  TcpClientFactory.CreateTcpConnection(FRemote);
  P2:=FRemote.Param;
  P2.SetValue(PAnsiChar(AnsiString(RemoteAddr)), RemotePort, Self);
  RegistObserver(FRemote,FTcpConnectionEvent);
  Pointer(P1):=nil;
 Pointer(P2):=nil;
end;

 

3)函數返回值為接口指針

如下面的示例中FServer.Param定義為function THttpServer.Param:IHttpServerParam，返回的是接口類型，下面的代碼直接調用Param.SetValue方法：

constructor TTcpServerSplitter.Create(aName:String; ServerAddr: String; ServerPort: Integer;
  RemoteAddr: String; RemotePort: Integer);
var
  Service:IInterfaceObservable;
  P1:ITcpConnectionServerParam;
  P2:ITcpConnectionParam;
begin
  inherited Create;
  FServerEvent:=TTcpConnectionServerEventAdapter.Create(Self as ITcpConnectionServerEvent);
  FTcpConnectionEvent:=TTcpConnectionEventAdapter.Create(Self as ITcpConnectionEvent);
  FConnectionEvent:=TConnectionEventAdapter.Create(Self as IConnectionEvent);

  TcpServerFactory.CreateTcpConnectionServer(FServer);
  FServer.Param.SetValue(PWideChar(aName), PAnsiChar(AnsiString(ServerAddr)), ServerPort, 10000, 10,0, 40000);   RegistObserver(FServer, FServerEvent);
  TcpClientFactory.CreateTcpConnection(FRemote);
  FRemote.Param.SetValue(PAnsiChar(AnsiString(RemoteAddr)), RemotePort, Self);  RegistObserver(FRemote,FTcpConnectionEvent);
end;

 上面的代碼，Delphi編譯器會自動生成兩個接口變量，保存FServer.Param和FRemote.Param，由於FServer和FRemote為TTcpServerSplitter對象的全局變量，所以接口在TTcpServerSplitter對象釋放時，被調用_Release

將導致內存訪問異常。

constructor TTcpServerSplitter.Create(aName:String; ServerAddr: String; ServerPort: Integer;
  RemoteAddr: String; RemotePort: Integer);
var
  Service:IInterfaceObservable;
  P1:ITcpConnectionServerParam; P2:ITcpConnectionParam; begin
  inherited Create;
  FServerEvent:=TTcpConnectionServerEventAdapter.Create(Self as ITcpConnectionServerEvent);
  FTcpConnectionEvent:=TTcpConnectionEventAdapter.Create(Self as ITcpConnectionEvent);
  FConnectionEvent:=TConnectionEventAdapter.Create(Self as IConnectionEvent);

  TcpServerFactory.CreateTcpConnectionServer(FServer);
  P1:=FServer.Param;
  P1.SetValue(PWideChar(aName), PAnsiChar(AnsiString(ServerAddr)), ServerPort, 10000, 10,0, 40000);   RegistObserver(FServer, FServerEvent);
  TcpClientFactory.CreateTcpConnection(FRemote);
  P2:=FRemote.Param; P2.SetValue(PAnsiChar(AnsiString(RemoteAddr)), RemotePort, Self);   RegistObserver(FRemote,FTcpConnectionEvent);
  Pointer(P1):=nil;  
 Pointer(P2):=nil; 
end;

4）對象中的接口變量，在對象釋放時，需要將接口變量清空。

destructor TTcpServerSplitter.Destroy;
begin
  Stop;
  Pointer(FServer):=nil;
  Pointer(FRemote):=nil;
  inherited;
end;

 

 


免責聲明！

本站轉載的文章為個人學習借鑒使用，本站對版權不負任何法律責任。如果侵犯了您的隱私權益，請聯系本站郵箱yoyou2525@163.com刪除。



猜您在找 java調用接口實現文件上傳 Delphi 調用VC的DLL delphi dll調用問題 delphi dll創建及調用 python調用zabbix接口實現Action配置 Spring Cloud開發實踐 - 03 - 接口實現和下游調用 asp調用短信接口實現用戶注冊 java調用 webservices接口實現天氣預報 調用接口實現郵箱驗證碼 RestTemplate調用第三方接口實現方式
 
粵ICP備18138465號   © 2018-2025 CODEPRJ.COM