客户端如何delphi编程以远程用户身份访问win2003服务器的com+服务

这篇文章将会说明如何以远程工作站上的用户身份激活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:=edusertext;//用户名
wDomain:=edSvrText;//远程计算机名
wPsw:=edPswText;//密码
ciduser:=pUnshort(@wUser[1]);
cidUserLength:=length(wUser);
cidDomain:=pUnshort(@wDomain[1]);
cidDomainLength:=length(wDomain);
cidpassword:=pUnshort(@wPsw[1]);
cidPasswordLength:=length(wPsw);
cidFlags:=2;
//以上填充_CoAuthIdentity结构
caidwAuthnSvc:=10;//winNt默认的鉴证服务
caidwAuthzSvc:=0;
caipwszServerPrincName:=wDomain;
caidwAuthnLevel:=0;
caidwImpersonationLevel:=3;//必须设置成模拟
caipAuthIdentityData:=@cid;
caidwCapabilities:=$0800;
//以上填充_CoAuthInfo结构
FillChar(csi, sizeof(csi), 0);
csidwReserved1:=0;
csipwszName:=pwidechar(wdomain);
csipAuthInfo:=@cai;
//以上填充COSERVERINFO结构
iid_unk:=IUnknown;
mqiIID:=@iid_unk;mqiItf:=nil;mqihr:=0;
ScreenCursor:=crHourGlass; olecheck(CoCreateInstanceEx(CLASS_MTSXjpimsDB,nil,CLSCTX_REMOTE_SERVER,@csi,1,@mqi));
这段代码中除了最后实际调用CoCreateInstanceEx外，前面的代码都是设置参数。这些参数的含义请大家参考msdn，除了用户名、主机名、密码外，只有一个重要要部分要说明：caidwImpersonationLevel必须设置成允许模拟(值为3)，否则远程计算机将无法按提供的用户/密码建议网络会话。
3、不修改现有代码，可以实现用远程用户身份激活吗？
当然可以，我扩展了TDcomConnection类，为其加入了用户名和密码，并修改其默认的DoConnect方法，使其在调用CoCreateInstanceEx时用指定的用户名和密码填充参数。代码如下：
unit SecDComConnection;
interface
uses
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;
implementation
constructor TSecDCOMConnectionCreate(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 TSecDCOMConnectionDoConnect;
var
tmpCmpName:widestring;
IID_IUnknown:TGUID;
iiu:IDispatch;
Mqi:MULTI_QI;
qr:HRESULT;
begin
if (ObjectBroker) <> nil then
begin
repeat
if ComputerName = '' then
ComputerName := ObjectBrokerGetComputerForGUID(GetServerCLSID);
try
SetAppServer(CreateRemoteComObject(ComputerName, GetServerCLSID) as IDispatch);
ObjectBrokerSetConnectStatus(ComputerName, True);
except
ObjectBrokerSetConnectStatus(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;
FSvInfopwszName:=pwidechar(tmpCmpName);
FSvinfopAuthInfo:=@Fcai;
IID_IUnknown:=IUnknown;
mqiIID:=@IID_IUnknown;mqiItf:=nil;mqihr:=0;
olecheck(CoCreateInstanceEx(GetServerCLSID,nil,CLSCTX_REMOTE_SERVER,@FSvinfo,1,@mqi));
olecheck(mqihr);
MySetBlanket(mqiItf,Fcai);
qr:=mqiItfQueryInterface(idispatch,iiu);
olecheck(qr);
MySetBlanket(IUnknown(iiu),FCai);
SetAppServer(iiu);
end
else
inherited DoConnect;
end;
function TSecDComConnectionGetServer: IAppServer;
var
QIResult: HResult;
begin
Connected := True;
QIResult := IDispatch(AppServer)QueryInterface(IAppServer, Result);
if QIResult <> S_OK then
begin
Result := TDispatchAppServerCreate(IAppServerDisp(IDispatch(AppServer)));
end;
MySetBlanket(IUnknown(Result),FCai);
end;
procedure TSecDCOMConnectionMySetBlanket(itf: IUnknown;
const vCai: _CoAuthInfo);
begin
with vCai do
CoSetProxyBlanket(Itf,dwAuthnSvc,dwAuthzSvc,pwidechar(pAuthIdentityData^Domain),
dwAuthnLevel,dwImpersonationLevel,pAuthIdentityData,dwCapabilities);
end;
procedure TSecDCOMConnectionSetPassword(const Value: wideString);
begin
FPassword := Value;
end;
procedure TSecDCOMConnectionSetSvInfo(const Value: COSERVERINFO);
begin
FSvInfo := Value;
end;
procedure TSecDCOMConnectionSetUser(const Value: wideString);
begin
FUser := Value;
end;
procedure Register;
begin
RegisterComponents('DataSnap', [TSecDComConnection]);
end;
end
代码中有一些C风格的注释，是因为delphi没有为我们预定义这些变量和数据结构。
如何使用呢？将这个组件安装在IDE中，并将其放到你的现有代码的远程数据模块中去，将原有指向TDOCMConnection的数据集控件设置成这个新的TSecDCOMConnection控件。然后你可以在远程计算机中设置最严格的安全选项。但是要记住应该为你要使用的用户设置合适的权限：给予远程激活权限、给予远程访问权限。
4、到现在还没有谈到访问的问题。首先激活和访问并不是一回事。一个用户可能拥有激活权限但没有访问权限，也有可能只有访问权限却无激活权限。前面谈到CoCreateInstacnceEx可以用另一身份激活对象并取得IunKnown指针的一个本地引用。如果你直接用这个指针去取得IappServer接口并调用方法，那么你很可能又会见到“拒绝访问”信息。这是IUnKnown指针的本地引用存在于客户机的进程中，再没有做特殊设置前，该指针继承了客户机进程的本地令牌，也就是说当用这个指针获取远程IappServer接口时，会用客户机当前登录令牌调用QueryInterface，在调用过程中远程计算机将有此令牌中缓存的用户名和密码进行再次登录验证，当然此时又会被拒绝，而后远程计算机再次尝试用GUEST帐户登录并获取com对象接口，此时若没有找开GUEST访问权限，则客户端访问失败，windows返回“拒绝访问”信息。那么怎样才能使QueryInterface调用也使用远程用户身份呢，这就要调用CoSetProxyBlanket强制设置本地接口引用使用远程用户的令牌。在上面的代码中，我用MySetBlanket包装了该API，以便使用激活时的用户身份调用QueryInterface。而后在取得的IappServer接口上再次调用MySetBlanket，保证在使用该接口时也采用远程用户身份。
MySetBlanket(mqiItf,Fcai);
qr:=mqiItfQueryInterface(idispatch,iiu);
olecheck(qr);
MySetBlanket(IUnknown(iiu),FCai);
为保证直接引用DataProvider的TclientDataSet也能按上述要求工作，在扩展的TSecDCOMConnection控件中，重载了GetServer方法。这样TSecDCOMConnection已能完全替换TDCOMConnection实现便利的com+应用编程了。
由于时间仓促，写这篇时很多术语没有做解释交待，因此可能会有一些不太好理解，但是出于为delphi Fans提供一个简单的实现安全性com访问的方法，我还是将这篇贴上来，主要是可以让需要的朋友直接复制代码用在自己的应用上。使用TSecDCOMConnection后，服务器方的com+对象可以强制找开访问检查，并打开组件级的访问检查。在打开访问检查的情况下，必须将服务器中允许访问com+对象的用户名加入到角色中才能正确访问。
(上述代码在delphi7/winXP sp2中调试通过，对于windows98和windows nt40及以下 *** 作系统，由于CoCreateInstanceEx不能直接生成com+对象的安全上下文，因此代码不可用)

先改几个设置：选项-常规-关联ed2k链接，选项-连接-启动时自动连接，服务器选项里：移除无响应服务器的重试次数设大一点，然后，禁止自动移除静态服务器。
目前安全有效的emule服务器很少，也就这些：>