首页 > 代码库 > Delphi采用接口实现DLL调用
Delphi采用接口实现DLL调用
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;interfaceuses 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;initializationfinalization if Assigned(HttpClients) then FreeAndNil(HttpClients);end.
utHttpInterface接口文件示例
unit utHttpInterface;interfaceuses 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 one rror(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;implementationend.
调用prjHttp.DLL的Delphi工程可以包含下面的单元以及上面的接口单元utHttpInterface.pas即可
将utHttpDLL.pas中的 //{$define utHttpDLL) 去掉注释,即可以将http客户端这些代码包含到Delphi工程中。
unit utHttpDLL;//{$define utHttpDLL}interfaceuses 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}initializationInit;finalizationDone;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 := -1end;
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调用