码迷,mamicode.com
首页 > Windows程序 > 详细

Delphi采用接口实现DLL调用

时间:2017-03-19 13:19:52      阅读:216      评论:0      收藏:0      [点我收藏+]

标签:pass   setvalue   模块   tcp   tar   sign   版本   client   begin   

Delphi使用模块化开发,可以采用DLL或者BPL,两者的区别是BPL只能被同版本的Delphi使用,DLL可以被不同版本和不同开发工具的开发的软件调用。

因此我们的软件大多使用Delphi作为界面以及部分DLL模块的开发工具。

DLL模块之间通过接口方式调用。

1.对象创建采用工厂模式,每个DLL负责某个对象或若干个对象的创建及释放,例如:

DLL工程为http客户端(prjHttp.DLL)模块,通过DLL导出的GetHttpClientFactory获取http客户端工厂接口,通过接口创建Http客户端和释放Http客户端,工程

包括3个文件:工程文件,实现单元,接口单元。

调用此DLL的程序仅需要包含接口单元。

DLL工程文件

library prjHttp;

uses   System.SysUtils,   System.Classes,   utHTTPClient in utHTTPClient.pas;

{$R *.res}

exports   
  GetHttpClientFactory;
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;

 

Delphi采用接口实现DLL调用

标签:pass   setvalue   模块   tcp   tar   sign   版本   client   begin   

原文地址:http://www.cnblogs.com/xieyunc/p/6579628.html

(0)
(0)
   
举报
评论 一句话评论(0
登录后才能评论!
© 2014 mamicode.com 版权所有  联系我们:gaon5@hotmail.com
迷上了代码!