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;initialization
finalization
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 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;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}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 :=
else
Result := E_NOINTERFACE;
end;function TIntObject._AddRef: Integer;
begin
Result := -;
end;function TIntObject._Release: Integer;
begin
Result := -
end;

3.自管理接口对象在Delphi调用注意事项

1）接口赋值

错误代码：（Delphi编译器产生代码会先判断接口指针是否为nil，如果非nil自动调用接口的_Release方法）

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

建议代码：

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, , ,, );
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,
建议代码：

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;