从TDll派生出TClientDll；
根据真实的动态库接口添加相关属性；
unit untClientDll;
interface
uses
Windows, Classes, SysUtils, untDllManager, untProcDefine;
type
EClientDllError = Class(Exception);
{ TClientDll
o 继承自 TDll;
o 自动获取 ClientInitialize 地址并保存在 ClientInitialize 属性中；
o 自动获取 ClientInsertTrigger 地址并保存在 ClientInsertTrigger 属性中；
}
TClientDll = Class(TDll)
private
FClientInitialize: TClientInitialize;
FClientInsertTrigger: TClientInsertTrigger;
FClientGetDescription: TClientGetDescription;
FClientSetup: TClientSetup;
FDescription: String;
FUseTrigger: Bool;
protected
procedure DoDllLoaded; override;
procedure DoDllUnLoaded; override;
public
constructor Create; override;
property ClientGetDescription: TClientGetDescription read FClientGetDescription;
property ClientInitialize: TClientInitialize read FClientInitialize;
property ClientInsertTrigger: TClientInsertTrigger read FClientInsertTrigger;
property ClientSetup: TClientSetup read FClientSetup;
property Description: String read FDescription write FDescription;
property UseTrigger: Bool read FUseTrigger write FUseTrigger;
end;
implementation
{ TClientDll }
constructor TClientDll.Create;
begin
inherited;
FClientInitialize := nil;
FClientInsertTrigger := nil;
FClientGetDescription := nil;
FClientSetup := nil;
end;
procedure TClientDll.DoDllLoaded;
begin
FClientInitialize := GetProcAddress(csClientInitialize);
if not Assigned(FClientInitialize) then
raise EClientDllError.Create('No found of Proc "ClientInitialize".');
FClientInsertTrigger := GetProcAddress(csClientInsertTrigger);
if not Assigned(FClientInsertTrigger) then
raise EClientDllError.Create('No found of Proc "ClientInsertTrigger".');
//可选接口，即使不存在也不报错。
FClientGetDescription := GetProcAddress(csClientGetDescription);
FClientSetup := GetProcAddress(csClientSetup);
inherited;
end;
procedure TClientDll.DoDllUnLoaded;
begin
inherited;
FClientInitialize := nil;
FClientInsertTrigger := nil;
FClientGetDescription := nil;
FClientSetup := nil;
end;
end.
procedure TXXXXServer.LoadClientDll(const FileName: String);
//功能：加载一个ClientDll，并将相关数据传递进去
var
Index: Integer;
Description: String;
UseTrigger: Bool;
AClientDll: TClientDll;
begin
Index := FClientDlls.Add(FileName);
if Index < 0 then
raise EXXXXError.CreateFmt('ClientDll "%s" 之前已经装载.', [FileName]);
//尝试读取地址
try
FClientDlls[Index].Loaded := True;
finally
if not FClientDlls[Index].Loaded then
FClientDlls[Index].Free;
end;
//初始化该Client，同时将相关信息传入
UseTrigger := False;
AClientDll := TClientDll(FClientDlls[Index]);
if Assigned(AClientDll.ClientSetup) then
AClientDll.ClientSetup(mscAppPath + 'Client/', False);
end;
unit untServerDll;
interface
uses
Windows, Classes, SysUtils, untDllManager, untProcDefine;
type
EServerDllError = Class(Exception);
{ TServerDll
o 继承自 TDll;
o 自动获取 QueryInterface 地址并保存在QueryInterface属性中；
}
TServerDll = Class(TDll)
private
FFunctions: TObject;
FQueryInterface: TProcQueryInterface;
protected
procedure DoDllLoaded; override;
procedure DoDllUnLoaded; override;
public
procedure RefreshAllFunctionsPermit;
property Functions: TObject read FFunctions write FFunctions;
property QueryInterface: TProcQueryInterface read FQueryInterface;
end;
implementation
uses
untFunctionProc;
{ TServerDll }
procedure TServerDll.DoDllLoaded;
begin
FQueryInterface := GetProcAddress(csQueryInterface);
if not Assigned(FQueryInterface) then
raise EServerDllError.Create('No found of "QueryInterface" Proc.');
inherited; //此句需要放在后面
end;
procedure TServerDll.DoDllUnLoaded;
begin
inherited;
FQueryInterface := nil;
end;
procedure TServerDll.RefreshAllFunctionsPermit;
var
I: Integer;
begin
Assert(FFunctions <> nil);
for I := 0 to TFunctionList(FFunctions).Count - 1 do
if TFunction(TFunctionList(FFunctions)[I]).Dll = Self then
TFunction(TFunctionList(FFunctions)[I]).Permit := Permit;
end;
end.
略。
[文终]
