DCOM,连接服务器的问题 使用三层数据库,客户端使用DCOM,连接服务器,现在我把两台机子连接起来,一台作为客户端,一台作为服务器,但是当客户端DCOM 的SERVER NAME 选择其他主机时,却告之 RPC不可用 或者 拒绝访问。这怎么解决? 解决方案 » 免费领取超大流量手机卡,每月29元包185G流量+100分钟通话, 中国电信官方发货 2000下的配置:DCOM配置 如果在Windows NT环境下正常运行应用服务器,必须进行DCOM配置。配置方法如下: 1.运行NT服务器上的dcomcnfg程序,进行DCOM配置。 2.进入DCOM的总体默认属性页面,将“在这台计算机上启用分布式COM”打上勾,将默认身份级别改为“无”。 3.进入DCOM的总体默认安全机制页面,确认默认访问权限和默认启动权限中的默认值无EveryOne,如果不去掉EveryOne,应用服务器不能正常启动。 4.在常规页面中,双击你的应用服务器,打开你的应用服务器DCOM属性设置。 5.将常规页面中的身份验证级别改为“无”。 6.位置页面中选上“在这台计算机上运行应用程序”。 7.将安全性页面设置中,均选择“使用自定义访问权限”,编辑每一个权限,将EveryOne加入用户列表中。 8.身份标识页面中,选择“交互式用户”。 9.NT的GUEST用户不能禁用。注意:关键所在,在控制面板--用户和密码里administrators用户的属性--隶属于里添加power users,其它用户也这样做,guest用户绝对不可以禁用 以远程计算机上的用户身份访问Com+应用 DELPHI程序员开发com+应用的速度是非常快的,其主要原因是其较好地封装了com+的windows底层功能,开发人员通过较为简单的类继承就避开了复杂的com+底层技术细节,使开发人员将精力放在应用本身的功能上面。Delphi在封装com+应用时采取了许多折衷,在保留通用性的同时也避开了一些实现起来困难但是应用面不太广的com+底层特性。这些避开的特性中最令delphi com开发人员关心的就是安全特性。从delphi 5开始,有许多人都面临过这样的问题:com应用开发出来并且在本机上运行一切正常,但是一旦分发出去实施远程访问时,就无法正常运行了。我自己有段时间在看到“拒绝访问”错误提示时会本能的头晕。其实认真追究起来,还是因为自己对windows安全技术了解不多造成的。多年来我一直没有发现国内有windows安全方面比较系统的资料和书籍,直到Keith Brownr的<windows安全性编程>中文版的出现。正是基于这本书我才有了下面的一些试验,也知道了为什么我老是被拒绝的原因。下面的讨论只是我在解决自身现有代码的安全访问问题时,总结出的几个小经难方法。建议愿意了解windows安全性的朋友去看一看<windows安全性编程>一书,你会发现windows的安全不再神秘。这篇文章将会说明如何以远程工作站上的用户身份激活com+对象,并以此用户身份访问Interface。1、Delphi默认com+对象的远程激活 Delph中远程com+对象激活一般通过TdispatchConnection及其子类来实现,实际代码中多用TDCOMConnection或TsocketConnectoion这两个组件,TDCOMConnection组件最终调用CoCreateInstanceEx创建com+对象。CoCreateInstanceEx(const clsid: TCLSID; unkOuter: IUnknown; dwClsCtx: Longint;ServerInfo:PCoServerInfo;dwCount: Longint; rgmqResults: PMultiQIArray): HResult。TDCOMConnection在调用CoCreateInstanceEx时为pCoServerInfo参数中的pAuthInfo传递了Null值,因此TdcomConnection在创建Com对象时使用的是本地计算机登录者的用户令牌。假若A计算机上的登录用户Auser使用TDCOMConnection类连接远程计算机B上的com+对象,则B计算机会使用Auser的用户名/密码在B计算机上建立登录会话并最终创建com+对象。但是一台windows工作站上的本地用户只能在本地登录而无法在别的计算机上登录,因此A计算机上的Auser就无法在B工作站上建立登录会话,当然也就无法创建com+对象,此时远程工作站B会尝试用Guest帐户建立会话并使用该账户激活com+对象。在这种情况下,如果B工作站上的Guest账户没有启用或Guest没有激活com+对象的权限,你就会看见令人头晕的提示“拒绝访问”。看到这里你是不对现在网上最“流行”的dcom配置方法有所悟了呢。那个方法就是允许everyone访问、激活com对象、并且将“默认身份验证级别”设置成无。这种方法能够使你的com应用可以“用了”,但是,它可以上“任何人”访问。而且这种设置你将无法利用com+基于角色的安全访问控制功能。2、怎样不用GUEST账户激活 这个问题的实际上应该是:怎样用远程工作站上的用户激活远程com对象。解决这个问题其实很简单:只要你在调用CoCreateInstanceEx时为它指定远程工作站上的用户名和密码,只要用户名/密码通过远程计算机的验证,并且该用户被授予了“远程激活”com+对象的权限,那么远程工作站会用该用户身份激活com+对象。看一下代码:var mts:IMTSXjpimsDB; ov:Variant; i:integer; cai:_CoAuthInfo; cid:_CoAuthIdentity; csi:COSERVERINFO; mqi:MULTI_QI; iid_unk:TGUID; idsp:IDispatch; wUser,wDomain,wPsw:WideString;begin wUser:=eduser.text;//用户名 wDomain:=edSvr.Text;//远程计算机名 wPsw:=edPsw.Text;//密码 cid.user:=pUnshort(@wUser[1]); cid.UserLength:=length(wUser); cid.Domain:=pUnshort(@wDomain[1]); cid.DomainLength:=length(wDomain); cid.password:=pUnshort(@wPsw[1]); cid.PasswordLength:=length(wPsw); cid.Flags:=2; //以上填充_CoAuthIdentity结构 cai.dwAuthnSvc:=10;//winNt默认的鉴证服务 cai.dwAuthzSvc:=0; cai.pwszServerPrincName:=wDomain; cai.dwAuthnLevel:=0; cai.dwImpersonationLevel:=3;//必须设置成模拟 cai.pAuthIdentityData:=@cid; cai.dwCapabilities:=$0800; //以上填充_CoAuthInfo结构 FillChar(csi, sizeof(csi), 0); csi.dwReserved1:=0; csi.pwszName:=pwidechar(wdomain); csi.pAuthInfo:=@cai; //以上填充COSERVERINFO结构 iid_unk:=IUnknown; mqi.IID:=@iid_unk;mqi.Itf:=nil;mqi.hr:=0; Screen.Cursor:=crHourGlass; olecheck(CoCreateInstanceEx(CLASS_MTSXjpimsDB,nil, CLSCTX_REMOTE_SERVER,@csi,1,@mqi));这段代码中除了最后实际调用CoCreateInstanceEx外,前面的代码都是设置参数。这些参数的含义请大家参考msdn,除了用户名、主机名、密码外,只有一个重要要部分要说明:cai.dwImpersonationLevel必须设置成允许模拟(值为3),否则远程计算机将无法按提供的用户/密码建议网络会话。3、不修改现有代码,可以实现用远程用户身份激活吗?当然可以,我扩展了TDcomConnection类,为其加入了用户名和密码,并修改其默认的DoConnect方法,使其在调用CoCreateInstanceEx时用指定的用户名和密码填充参数。代码如下: unit SecDComConnection;interfaceuses windows,SysUtils, Classes,ActiveX, DB, DBClient, MConnect,comobj,Midas;type{typedef struct _SEC_WINNT_AUTH_IDENTITY unsigned short __RPC_FAR* User; unsigned long UserLength; unsigned short __RPC_FAR* Domain; unsigned long DomainLength; unsigned short __RPC_FAR* Password; unsigned long PasswordLength; unsigned long Flags; SEC_WINNT_AUTH_IDENTITY, *PSEC_WINNT_AUTH_IDENTITY;} {typedef struct _COAUTHIDENTITY USHORT * User; ULONG UserLength; USHORT * Domain; ULONG DomainLength; USHORT * Password; ULONG PasswordLength; ULONG Flags;COAUTHIDENTITY;}{#define RPC_C_AUTHN_NONE 0#define RPC_C_AUTHN_DCE_PRIVATE 1#define RPC_C_AUTHN_DCE_PUBLIC 2#define RPC_C_AUTHN_DEC_PUBLIC 4#define RPC_C_AUTHN_GSS_NEGOTIATE 9#define RPC_C_AUTHN_WINNT 10#define RPC_C_AUTHN_GSS_SCHANNEL 14#define RPC_C_AUTHN_GSS_KERBEROS 16#define RPC_C_AUTHN_MSN 17#define RPC_C_AUTHN_DPA 18#define RPC_C_AUTHN_MQ 100#define RPC_C_AUTHN_DEFAULT 0xFFFFFFFFL}{#define RPC_C_AUTHZ_NONE 0#define RPC_C_AUTHZ_NAME 1#define RPC_C_AUTHZ_DCE 2#define RPC_C_AUTHZ_DEFAULT 0xFFFFFFFF }{#define RPC_C_AUTHN_LEVEL_DEFAULT 0#define RPC_C_AUTHN_LEVEL_NONE 1#define RPC_C_AUTHN_LEVEL_CONNECT 2#define RPC_C_AUTHN_LEVEL_CALL 3#define RPC_C_AUTHN_LEVEL_PKT 4#define RPC_C_AUTHN_LEVEL_PKT_INTEGRITY 5#define RPC_C_AUTHN_LEVEL_PKT_PRIVACY 6 }{SEC_WINNT_AUTH_IDENTITY_UNICODE=2 } pUnShort=^Word; pCoAuthIdentity=^_CoAuthIdentity; _CoAuthIdentity=record user:pUnShort; UserLength:ULONG; Domain:pUnShort; DomainLength:Ulong; password:pUnShort; PasswordLength:ulong; Flags:ulong; end; _CoAuthInfo=record dwAuthnSvc:DWORD; dwAuthzSvc:DWORD; pwszServerPrincName:WideString; dwAuthnLevel:Dword; dwImpersonationLevel:dword; pAuthIdentityData:pCoAuthIdentity; dwCapabilities:DWORD; end; TSecDComConnection = class(TDCOMConnection) private FCai:_CoAuthInfo; FCid:_CoAuthIdentity; FSvInfo:COSERVERINFO; FUser:WideString; FPassWord:WideString; procedure SetPassword(const Value: wideString); procedure SetUser(const Value: wideString); procedure SetSvInfo(const Value: COSERVERINFO); protected procedure DoConnect; override; public property SvInfo:COSERVERINFO read FSvInfo write SetSvInfo; constructor Create(AOwner: TComponent); override; procedure MySetBlanket(itf:IUnknown;const vCai:_CoAuthInfo); function GetServer: IAppServer; override; published property User:wideString read FUser write SetUser; Property Password:wideString read FPassword write SetPassword; end;procedure Register;implementationconstructor TSecDCOMConnection.Create(AOwner: TComponent);begin inherited Create(AOwner); FillMemory(@Fcai,sizeof(Fcai),0); FillMemory(@FCid,sizeof(FCid),0); FillMemory(@FSvInfo,sizeof(FSvInfo),0); with FCai do begin dwAuthnSvc:=10;//RPC_C_AUTHN_WINNT dwAuthzSvc:=0;// RPC_C_AUTHZ_NONE dwAuthnLevel:=0;//RPC_C_AUTHN_LEVEL_DEFAULT dwImpersonationLevel:=3; pAuthIdentityData:=@fcid; dwCapabilities:=$0800; end;end;procedure TSecDCOMConnection.DoConnect;var tmpCmpName:widestring; IID_IUnknown:TGUID; iiu:IDispatch; Mqi:MULTI_QI; qr:HRESULT;begin if (ObjectBroker) <> nil then begin repeat if ComputerName = '' then ComputerName := ObjectBroker.GetComputerForGUID(GetServerCLSID); try SetAppServer(CreateRemoteComObject(ComputerName, GetServerCLSID) as IDispatch); ObjectBroker.SetConnectStatus(ComputerName, True); except ObjectBroker.SetConnectStatus(ComputerName, False); ComputerName := ''; end; until Connected; end else if (ComputerName <> '') then begin with fcid do begin user:=pUnshort(@fuser[1]); UserLength:=length(fuser); tmpCmpName:=ComputerName; Domain:=pUnshort(@tmpCmpName[1]); DomainLength:=length(TmpCmpName); password:=pUnShort(@FPassword[1]); PasswordLength:=length(FPassword); Flags:=2;//Unicode end; FSvInfo.pwszName:=pwidechar(tmpCmpName); FSvinfo.pAuthInfo:=@Fcai; IID_IUnknown:=IUnknown; mqi.IID:=@IID_IUnknown;mqi.Itf:=nil;mqi.hr:=0; olecheck(CoCreateInstanceEx(GetServerCLSID,nil,CLSCTX_REMOTE_SERVER,@FSvinfo,1,@mqi)); olecheck(mqi.hr); MySetBlanket(mqi.Itf,Fcai); qr:=mqi.Itf.QueryInterface(idispatch,iiu); olecheck(qr); MySetBlanket(IUnknown(iiu),FCai); SetAppServer(iiu); end else inherited DoConnect;end;function TSecDComConnection.GetServer: IAppServer;var QIResult: HResult;begin Connected := True; QIResult := IDispatch(AppServer).QueryInterface(IAppServer, Result); if QIResult <> S_OK then begin Result := TDispatchAppServer.Create(IAppServerDisp(IDispatch(AppServer))); end; MySetBlanket(IUnknown(Result),FCai);end;procedure TSecDCOMConnection.MySetBlanket(itf: IUnknown; const vCai: _CoAuthInfo);begin with vCai do CoSetProxyBlanket(Itf,dwAuthnSvc,dwAuthzSvc,pwidechar(pAuthIdentityData^.Domain), dwAuthnLevel,dwImpersonationLevel,pAuthIdentityData,dwCapabilities);end;procedure TSecDCOMConnection.SetPassword(const Value: wideString);begin FPassword := Value;end;procedure TSecDCOMConnection.SetSvInfo(const Value: COSERVERINFO);begin FSvInfo := Value;end;procedure TSecDCOMConnection.SetUser(const Value: wideString);begin FUser := Value;end;procedure Register;begin RegisterComponents('DataSnap', [TSecDComConnection]);end;end. 请教下谁有VNC开发的DLL? 如何实现批量输出memo内容? 只有强迫才能行吗? 为什么我在D7中安装了Indy10 后,编译程序的时候,系统报错!在线等哈………………………… 求一个TDDBGrid这样的控件 请高手指教 在线等待 烂尾程序搞得我郁闷至极。。。。。。 100分求救!当DLL Form关闭的时候主程序的MainForm就跟着最小化。烦死人! xp 的那種銀白色介面的rgb是多少 如果程序做到一半,发现数据表的结构有问题,改动时,在程序里应该注意什么地方? 关于TList.Sort的问题 ActiveX相关(在线等待。。。。。。。。。。)
DCOM配置 如果在Windows NT环境下正常运行应用服务器,必须进行DCOM配置。配置方法如下: 1.运行NT服务器上的dcomcnfg程序,进行DCOM配置。 2.进入DCOM的总体默认属性页面,将“在这台计算机上启用分布式COM”打上勾,将默认
身份级别改为“无”。 3.进入DCOM的总体默认安全机制页面,确认默认访问权限和默认启动权限中的默认值无EveryOne,
如果不去掉EveryOne,应用服务器不能正常启动。 4.在常规页面中,双击你的应用服务器,打开你的应用服务器DCOM属性设置。 5.将常规页面中的身份验证级别改为“无”。 6.位置页面中选上“在这台计算机上运行应用程序”。 7.将安全性页面设置中,均选择“使用自定义访问权限”,编辑每一个权限,将EveryOne加入用
户列表中。 8.身份标识页面中,选择“交互式用户”。 9.NT的GUEST用户不能禁用。
注意:关键所在,在控制面板--用户和密码里administrators用户的属性--隶属于里添加power users,其它用户也这样做,guest用户绝对不可以禁用
开发人员通过较为简单的类继承就避开了复杂的com+底层技术细节,使开发人员将精力放在应用本身的
功能上面。Delphi在封装com+应用时采取了许多折衷,在保留通用性的同时也避开了一些实现起来困难
但是应用面不太广的com+底层特性。这些避开的特性中最令delphi com开发人员关心的就是安全特性。
从delphi 5开始,有许多人都面临过这样的问题:com应用开发出来并且在本机上运行一切正常,
但是一旦分发出去实施远程访问时,就无法正常运行了。我自己有段时间在看到“拒绝访问”错误提示时
会本能的头晕。其实认真追究起来,还是因为自己对windows安全技术了解不多造成的。多年来我一直
没有发现国内有windows安全方面比较系统的资料和书籍,直到Keith Brownr的<windows安全性编程>
中文版的出现。正是基于这本书我才有了下面的一些试验,也知道了为什么我老是被拒绝的原因。下面的讨论只是我在解决自身现有代码的安全访问问题时,总结出的几个小经难方法。
建议愿意了解windows安全性的朋友去看一看<windows安全性编程>一书,你会发现windows的安全不再神秘。
这篇文章将会说明如何以远程工作站上的用户身份激活com+对象,并以此用户身份访问Interface。1、Delphi默认com+对象的远程激活 Delph中远程com+对象激活一般通过TdispatchConnection及其子类来实现,实际代码中多用
TDCOMConnection或TsocketConnectoion这两个组件,TDCOMConnection组件最终调用CoCreateInstanceEx
创建com+对象。CoCreateInstanceEx(const clsid: TCLSID; unkOuter: IUnknown; dwClsCtx: Longint;
ServerInfo:PCoServerInfo;dwCount: Longint; rgmqResults: PMultiQIArray): HResult。
TDCOMConnection在调用CoCreateInstanceEx时为pCoServerInfo参数中的pAuthInfo传递了Null值,
因此TdcomConnection在创建Com对象时使用的是本地计算机登录者的用户令牌。假若A计算机上的登录用户
Auser使用TDCOMConnection类连接远程计算机B上的com+对象,则B计算机会使用Auser的用户名/密码在B计
算机上建立登录会话并最终创建com+对象。但是一台windows工作站上的本地用户只能在本地登录而无法在
别的计算机上登录,因此A计算机上的Auser就无法在B工作站上建立登录会话,当然也就无法创建com+对象,
此时远程工作站B会尝试用Guest帐户建立会话并使用该账户激活com+对象。在这种情况下,如果B工作站上
的Guest账户没有启用或Guest没有激活com+对象的权限,你就会看见令人头晕的提示“拒绝访问”。看到这里
你是不对现在网上最“流行”的dcom配置方法有所悟了呢。那个方法就是允许everyone访问、激活com对象、
并且将“默认身份验证级别”设置成无。这种方法能够使你的com应用可以“用了”,但是,它可以上“任何人”
访问。而且这种设置你将无法利用com+基于角色的安全访问控制功能。2、怎样不用GUEST账户激活 这个问题的实际上应该是:怎样用远程工作站上的用户激活远程com对象。解决这个问题其实很简单:
只要你在调用CoCreateInstanceEx时为它指定远程工作站上的用户名和密码,只要用户名/密码通过远程
计算机的验证,并且该用户被授予了“远程激活”com+对象的权限,那么远程工作站会用该用户身份激活com+
对象。看一下代码:var
mts:IMTSXjpimsDB;
ov:Variant;
i:integer;
cai:_CoAuthInfo;
cid:_CoAuthIdentity;
csi:COSERVERINFO;
mqi:MULTI_QI;
iid_unk:TGUID;
idsp:IDispatch;
wUser,wDomain,wPsw:WideString;
begin
wUser:=eduser.text;//用户名
wDomain:=edSvr.Text;//远程计算机名
wPsw:=edPsw.Text;//密码
cid.user:=pUnshort(@wUser[1]);
cid.UserLength:=length(wUser);
cid.Domain:=pUnshort(@wDomain[1]);
cid.DomainLength:=length(wDomain);
cid.password:=pUnshort(@wPsw[1]);
cid.PasswordLength:=length(wPsw);
cid.Flags:=2;
//以上填充_CoAuthIdentity结构
cai.dwAuthnSvc:=10;//winNt默认的鉴证服务
cai.dwAuthzSvc:=0;
cai.pwszServerPrincName:=wDomain;
cai.dwAuthnLevel:=0;
cai.dwImpersonationLevel:=3;//必须设置成模拟
cai.pAuthIdentityData:=@cid;
cai.dwCapabilities:=$0800;
//以上填充_CoAuthInfo结构
FillChar(csi, sizeof(csi), 0);
csi.dwReserved1:=0;
csi.pwszName:=pwidechar(wdomain);
csi.pAuthInfo:=@cai;
//以上填充COSERVERINFO结构
iid_unk:=IUnknown;
mqi.IID:=@iid_unk;mqi.Itf:=nil;mqi.hr:=0;
Screen.Cursor:=crHourGlass; olecheck(CoCreateInstanceEx(CLASS_MTSXjpimsDB,nil,
CLSCTX_REMOTE_SERVER,@csi,1,@mqi));这段代码中除了最后实际调用CoCreateInstanceEx外,前面的代码都是设置参数。这些参数的含义请大家
参考msdn,除了用户名、主机名、密码外,只有一个重要要部分要说明:cai.dwImpersonationLevel必须
设置成允许模拟(值为3),否则远程计算机将无法按提供的用户/密码建议网络会话。
3、不修改现有代码,可以实现用远程用户身份激活吗?
当然可以,我扩展了TDcomConnection类,为其加入了用户名和密码,并修改其默认的DoConnect方法,
使其在调用CoCreateInstanceEx时用指定的用户名和密码填充参数。代码如下:
windows,SysUtils, Classes,ActiveX, DB, DBClient, MConnect,comobj,Midas;type{typedef struct _SEC_WINNT_AUTH_IDENTITY
unsigned short __RPC_FAR* User;
unsigned long UserLength;
unsigned short __RPC_FAR* Domain;
unsigned long DomainLength;
unsigned short __RPC_FAR* Password;
unsigned long PasswordLength;
unsigned long Flags;
SEC_WINNT_AUTH_IDENTITY, *PSEC_WINNT_AUTH_IDENTITY;
}
{typedef struct _COAUTHIDENTITY
USHORT * User;
ULONG UserLength;
USHORT * Domain;
ULONG DomainLength;
USHORT * Password;
ULONG PasswordLength;
ULONG Flags;
COAUTHIDENTITY;}{#define RPC_C_AUTHN_NONE 0
#define RPC_C_AUTHN_DCE_PRIVATE 1
#define RPC_C_AUTHN_DCE_PUBLIC 2
#define RPC_C_AUTHN_DEC_PUBLIC 4
#define RPC_C_AUTHN_GSS_NEGOTIATE 9
#define RPC_C_AUTHN_WINNT 10
#define RPC_C_AUTHN_GSS_SCHANNEL 14
#define RPC_C_AUTHN_GSS_KERBEROS 16
#define RPC_C_AUTHN_MSN 17
#define RPC_C_AUTHN_DPA 18
#define RPC_C_AUTHN_MQ 100
#define RPC_C_AUTHN_DEFAULT 0xFFFFFFFFL
}{#define RPC_C_AUTHZ_NONE 0
#define RPC_C_AUTHZ_NAME 1
#define RPC_C_AUTHZ_DCE 2
#define RPC_C_AUTHZ_DEFAULT 0xFFFFFFFF }{
#define RPC_C_AUTHN_LEVEL_DEFAULT 0
#define RPC_C_AUTHN_LEVEL_NONE 1
#define RPC_C_AUTHN_LEVEL_CONNECT 2
#define RPC_C_AUTHN_LEVEL_CALL 3
#define RPC_C_AUTHN_LEVEL_PKT 4
#define RPC_C_AUTHN_LEVEL_PKT_INTEGRITY 5
#define RPC_C_AUTHN_LEVEL_PKT_PRIVACY 6 }{SEC_WINNT_AUTH_IDENTITY_UNICODE=2 } pUnShort=^Word; pCoAuthIdentity=^_CoAuthIdentity;
_CoAuthIdentity=record
user:pUnShort;
UserLength:ULONG;
Domain:pUnShort;
DomainLength:Ulong;
password:pUnShort;
PasswordLength:ulong;
Flags:ulong;
end; _CoAuthInfo=record
dwAuthnSvc:DWORD;
dwAuthzSvc:DWORD;
pwszServerPrincName:WideString;
dwAuthnLevel:Dword;
dwImpersonationLevel:dword;
pAuthIdentityData:pCoAuthIdentity;
dwCapabilities:DWORD;
end; TSecDComConnection = class(TDCOMConnection)
private
FCai:_CoAuthInfo;
FCid:_CoAuthIdentity;
FSvInfo:COSERVERINFO;
FUser:WideString;
FPassWord:WideString;
procedure SetPassword(const Value: wideString);
procedure SetUser(const Value: wideString);
procedure SetSvInfo(const Value: COSERVERINFO);
protected
procedure DoConnect; override; public
property SvInfo:COSERVERINFO read FSvInfo write SetSvInfo;
constructor Create(AOwner: TComponent); override;
procedure MySetBlanket(itf:IUnknown;const vCai:_CoAuthInfo);
function GetServer: IAppServer; override;
published
property User:wideString read FUser write SetUser;
Property Password:wideString read FPassword write SetPassword;
end;procedure Register;implementationconstructor TSecDCOMConnection.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FillMemory(@Fcai,sizeof(Fcai),0);
FillMemory(@FCid,sizeof(FCid),0);
FillMemory(@FSvInfo,sizeof(FSvInfo),0);
with FCai do begin
dwAuthnSvc:=10;//RPC_C_AUTHN_WINNT
dwAuthzSvc:=0;// RPC_C_AUTHZ_NONE
dwAuthnLevel:=0;//RPC_C_AUTHN_LEVEL_DEFAULT
dwImpersonationLevel:=3;
pAuthIdentityData:=@fcid;
dwCapabilities:=$0800;
end;
end;procedure TSecDCOMConnection.DoConnect;
var
tmpCmpName:widestring;
IID_IUnknown:TGUID;
iiu:IDispatch;
Mqi:MULTI_QI;
qr:HRESULT;
begin
if (ObjectBroker) <> nil then
begin
repeat
if ComputerName = '' then
ComputerName := ObjectBroker.GetComputerForGUID(GetServerCLSID);
try
SetAppServer(CreateRemoteComObject(ComputerName, GetServerCLSID) as IDispatch);
ObjectBroker.SetConnectStatus(ComputerName, True);
except
ObjectBroker.SetConnectStatus(ComputerName, False);
ComputerName := '';
end;
until Connected;
end
else if (ComputerName <> '') then
begin
with fcid do begin
user:=pUnshort(@fuser[1]);
UserLength:=length(fuser);
tmpCmpName:=ComputerName;
Domain:=pUnshort(@tmpCmpName[1]);
DomainLength:=length(TmpCmpName);
password:=pUnShort(@FPassword[1]);
PasswordLength:=length(FPassword);
Flags:=2;//Unicode
end;
FSvInfo.pwszName:=pwidechar(tmpCmpName);
FSvinfo.pAuthInfo:=@Fcai;
IID_IUnknown:=IUnknown;
mqi.IID:=@IID_IUnknown;mqi.Itf:=nil;mqi.hr:=0;
olecheck(CoCreateInstanceEx(GetServerCLSID,nil,CLSCTX_REMOTE_SERVER,@FSvinfo,1,@mqi));
olecheck(mqi.hr);
MySetBlanket(mqi.Itf,Fcai);
qr:=mqi.Itf.QueryInterface(idispatch,iiu);
olecheck(qr);
MySetBlanket(IUnknown(iiu),FCai);
SetAppServer(iiu);
end
else
inherited DoConnect;
end;function TSecDComConnection.GetServer: IAppServer;
var
QIResult: HResult;
begin
Connected := True;
QIResult := IDispatch(AppServer).QueryInterface(IAppServer, Result);
if QIResult <> S_OK then
begin
Result := TDispatchAppServer.Create(IAppServerDisp(IDispatch(AppServer)));
end;
MySetBlanket(IUnknown(Result),FCai);
end;procedure TSecDCOMConnection.MySetBlanket(itf: IUnknown;
const vCai: _CoAuthInfo);
begin
with vCai do
CoSetProxyBlanket(Itf,dwAuthnSvc,dwAuthzSvc,pwidechar(pAuthIdentityData^.Domain),
dwAuthnLevel,dwImpersonationLevel,pAuthIdentityData,dwCapabilities);
end;procedure TSecDCOMConnection.SetPassword(const Value: wideString);
begin
FPassword := Value;
end;procedure TSecDCOMConnection.SetSvInfo(const Value: COSERVERINFO);
begin
FSvInfo := Value;
end;procedure TSecDCOMConnection.SetUser(const Value: wideString);
begin
FUser := Value;
end;procedure Register;
begin
RegisterComponents('DataSnap', [TSecDComConnection]);
end;end.