windwos的安全机制规定：windows接收远程的com+调用的时候，会验证这个调用的权限。如果权限不够就出现经典的“拒绝访问”错误。

解决这个问题已知访问方式有：

1、匿名访问；在应用服务器（简称AP）启用guest，并且设置guest具有激活和访问COM+的权限。这条路是可行，不过安全性不能得到保证。

2、客户端电脑的登录用户和密码和AP上的一个用户一致，并且这个用户在AP上也具有相应的访问COM+的权限。这种方式要比第一种好一些，但是哪个单位的IT系统会是这种样子呢。肯定是每台机器都有自己的帐户密码。这个方式也不好。注：这种方式在不需要发布客户端软件到诺干多的机器上的时候也是可行的，比如访问COM+ 的是webServer.

3、在域管理的网络环境中，同样可以实现，但是有个问题，如果您的客户不愿意改造成域环境呢。所以这种方法也是有局限性的。

最后，我想到如果远程访问COM+的时候能够显式的给定用于AP验证权限的用户名和密码不是就可以解决这个问题了吗？事实上这个方式是可行的。不过在delphi7中还没有现成的函数可以达到这个目的。

comobj.pas 中有个函数 function CreateRemoteComObject(const MachineName: WideString;
const ClassID: TGUID): IUnknown; 这个是用来创建远程的com+接口的。我要改造的主要是这个函数。

function CoCreateInstanceEx(const clsid: TCLSID;
unkOuter: IUnknown; dwClsCtx: Longint; ServerInfo: PCoServerInfo;
dwCount: Longint; rgmqResults: PMultiQIArray): HResult; stdcall; 这个函数可以用来创建远程的com+

ServerInfo 用来存储远程的服务器信息，包括访问和激活com+服务的帐户和密码。

我们来分析一下PCoServerInfo;
PCoServerInfo = ^TCoServerInfo;
_COSERVERINFO = record
dwReserved1: Longint;
pwszName: LPWSTR;
pAuthInfo: Pointer;
dwReserved2: Longint;
end;

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;
TSocInfo=class(Tobject)
public
fcid:_CoAuthIdentity;
fcai:_CoAuthInfo;
ServerInfo: TCoServerInfo;
end;

我们在CreateRemoteComObject中调用CoCreateInstanceEx的时候，首先给ServerInfo赋值如下

function CreateRemoteComObjectwh(const MachineName: WideString;
const ClassID: TGUID): IUnknown;
const
LocalFlags =CLSCTX_LOCAL_SERVER or CLSCTX_REMOTE_SERVER or CLSCTX_INPROC_SERVER;
RemoteFlags = CLSCTX_REMOTE_SERVER;
var
MQI: TMultiQI;
ServerInfo: TCoServerInfo;
IID_IUnknown: TGuid;
Flags, Size: DWORD;
LocalMachine: array [0..MAX_COMPUTERNAME_LENGTH] of char;
add by wanghui 2007-07-24
Fcai:_CoAuthInfo;
Fcid:_CoAuthIdentity;
wUser,wDomain,wPsw:WideString;
iiu:idispatch;
fr:HRESULT;
begin
if (GetObjectContext = nil) then
begin
if @CoCreateInstanceEx =nil then
raise Exception.CreateRes(@SDCOMNotInstalled);

wUser:=getAppUserid();//用户名
wDomain:=getappserver();//远程计算机名
wPsw:=getAppPassword();//密码

FillMemory(@Fcai,sizeof(Fcai),0);
FillMemory(@FCid,sizeof(FCid),0);

with fcid do begin
user:=pUnshort(@wUser[1]);
UserLength:=length(wUser);
Domain:=pUnshort(@wDomain[1]);
DomainLength:=length(wDomain);
password:=pUnshort(@wPsw[1]);
PasswordLength:=length(wPsw);
Flags:=2;
end;

with fcai do begin
dwAuthnSvc:=10;//winNt默认的鉴证服务 RPC_C_AUTHN_WINNT
dwAuthzSvc:=$FFFFFF;//0; //RPC_C_AUTHZ_NONE
//pwszServerPrincName:=pwidechar(wDomain);
dwAuthnLevel:=3;//0;
dwImpersonationLevel:=3;//必须设置成模拟
pAuthIdentityData:=@fcid;
dwCapabilities:=$0;//$0800;
end;
FillMemory(@ServerInfo, sizeof(ServerInfo), 0);
ServerInfo.pwszName := PWideChar(wDomain);
ServerInfo.dwReserved1:=0;
ServerInfo.pAuthInfo:=@fcai;

IID_IUnknown := IUnknown;
MQI.IID := @IID_IUnknown;
MQI.itf := nil;
MQI.hr := 0;

if Length(MachineName) > 0 then
begin
Size := Sizeof(LocalMachine); // Win95 is hypersensitive to size
if GetComputerName(LocalMachine, Size) and (AnsiCompareText(LocalMachine, MachineName) = 0) then
Flags := LocalFlags
else
Flags := RemoteFlags;
end else Flags := LocalFlags;
OleCheck(CoCreateInstanceEx(ClassID, nil, CLSCTX_REMOTE_SERVER, @(ServerInfo), 1, @MQI));
OleCheck(MQI.HR);
Result := MQI.itf;
end else
begin
GetObjectContext.CreateInstance(ClassID, IUnknown, Result);
end;
end;

以上代码 确保获取远程的com+的接口，接口类型为Iunkown

但是要访问其中的方法还需要用下面的函数来设置远程com本地引用的访问权限。

with fcai do
CoSetProxyBlanket(iu,dwAuthnSvc,dwAuthzSvc,pwidechar(pAuthIdentityData^.Domain),
dwAuthnLevel,dwImpersonationLevel,pAuthIdentityData,dwCapabilities);

将这个函数封装后得到一个新函数

function SetProxyBlanket(iu:IUnknown):boolean;
var
Fcai:_CoAuthInfo;
Fcid:_CoAuthIdentity;
wUser,wDomain,wPsw:WideString;
iiu:idispatch;

si:Tsocinfo;
begin

wUser:=getAppUserid();//用户名
wDomain:=getappserver();//远程计算机名
wPsw:=getAppPassword();//密码
if wDomain='127.0.0.1' then exit;
FillMemory(@Fcai,sizeof(Fcai),0);
FillMemory(@FCid,sizeof(FCid),0);
// FillMemory(@FSvInfo,sizeof(FSvInfo),0);
with fcid do begin
user:=pUnshort(@wUser[1]);
UserLength:=length(wUser);
Domain:=pUnshort(@wDomain[1]);
DomainLength:=length(wDomain);
password:=pUnshort(@wPsw[1]);
PasswordLength:=length(wPsw);
Flags:=2; //SEC_WINNT_AUTH_IDENTITY_UNICODE
end;
//以上填充_CoAuthIdentity结构
with fcai do begin
dwAuthnSvc:=10;//winNt默认的鉴证服务 RPC_C_AUTHN_WINNT
dwAuthzSvc:=$FFFFFF;//0; //RPC_C_AUTHZ_NONE
//pwszServerPrincName:=pwidechar(wDomain);
dwAuthnLevel:=3;//0;
dwImpersonationLevel:=3;//必须设置成模拟
pAuthIdentityData:=@fcid;
dwCapabilities:=$0;//$0800;
end;

with fcai do
CoSetProxyBlanket(iu,dwAuthnSvc,dwAuthzSvc,pwidechar(pAuthIdentityData^.Domain),
dwAuthnLevel,dwImpersonationLevel,pAuthIdentityData,dwCapabilities);
end;

最后我们改造delphi自动生成的*_TLB.pas 中的函数CreateRemote 如下

class function Comymenu.CreateRemote(const MachineName: string): Imymenu;
var iu:IUnknown;
begin
iu:=CreateRemoteComObjectwh(MachineName, CLASS_mymenu);
SetProxyBlanket(iu);
result:=iu as Imymenu;
SetProxyBlanket(IUnknown(result));
end;

参考了一些资料：MSDN，《windows安全性编程》。

软件环境：

client winXP SP2

AP： win2003 sp1

=====================================================================================================

=====================================================================================================

unit USecMConn;

interface

uses
MConnect, Classes, Activex, Windows, Sysutils, ComConst, ComObj;

const
RPC_C_AUTHN_NONE = 0;
RPC_C_AUTHN_DCE_PRIVATE = 1;
RPC_C_AUTHN_DCE_PUBLIC = 2;
RPC_C_AUTHN_DEC_PUBLIC = 4;
RPC_C_AUTHN_WINNT = 10;
RPC_C_AUTHN_DPA = 16;
RPC_C_AUTHN_MSN = 17;
RPC_C_AUTHN_GSS_KERBEROS = 18;
RPC_C_AUTHN_MQ = 100;
RPC_C_AUTHN_DEFAULT = $FFFFFFFF;

RPC_C_AUTHN_LEVEL_DEFAULT = 0;
RPC_C_AUTHN_LEVEL_NONE = 1;
RPC_C_AUTHN_LEVEL_CONNECT = 2;
RPC_C_AUTHN_LEVEL_CALL = 3;
RPC_C_AUTHN_LEVEL_PKT = 4;
RPC_C_AUTHN_LEVEL_PKT_INTEGRITY= 5;
RPC_C_AUTHN_LEVEL_PKT_PRIVACY = 6;

RPC_C_IMP_LEVEL_ANONYMOUS = 1;
RPC_C_IMP_LEVEL_IDENTIFY = 2;
RPC_C_IMP_LEVEL_IMPERSONATE = 3;
RPC_C_IMP_LEVEL_DELEGATE = 4;

SEC_WINNT_AUTH_IDENTITY_ANSI = $1;
SEC_WINNT_AUTH_IDENTITY_UNICODE = $2;

EOAC_NONE = 0;
type
PCoAuthIdentity = ^TCoAuthIdentity;
_COAUTHIDENTITY = record
User : LPWSTR;
UserLength : DWORD;
Domain : LPWSTR;
DomainLength : DWORD;
Password : LPWSTR;
PasswordLength : DWORD;
Flags : DWORD;
end;
TCoAuthIdentity = _COAUTHIDENTITY;

PCoAuthInfo = ^TCoAuthInfo;
_COAUTHINFO = record
dwAuthnSvc : DWORD;
dwAuthzSvc : DWORD;
pwszServerPrincName : LPWSTR;
dwAuthnLevel : DWORD;
dwImpersonationLevel : DWORD;
pAuthIdentityData : PCoAuthIdentity;
dwCapabilities : DWORD;
end;
TCoAuthInfo = _COAUTHINFO;

TSecDCOMConnection = class(TDCOMConnection)
private
FUserName: string;
FPassword : String;
protected
procedure DoConnect; override;
public
constructor Create(AOwner: TComponent); override;
published
property ComputerName;
property ObjectBroker;
property Username : String read FUserName write FUserName;
property Password : String read FPassword write FPassword;
end;

implementation

procedure SetProxyBlanket(itf: IUnknown; const AuthInfo: TCoAuthInfo);
var
Qr : HResult;
begin
with AuthInfo do
Qr := CoSetProxyBlanket(Itf, dwAuthnSvc, dwAuthzSvc, pWideChar(pAuthIdentityData^.Domain),
dwAuthnLevel, dwImpersonationLevel, pAuthIdentityData, dwCapabilities);
OleCheck(Qr);
end;

function CreateRemoteSecComObject(const MachineName, UserName, Password: WIDEString;
const ClassID: TGUID): IDispatch;
const
LocalFlags = CLSCTX_LOCAL_SERVER or CLSCTX_REMOTE_SERVER or CLSCTX_INPROC_SERVER;
RemoteFlags = CLSCTX_REMOTE_SERVER;
var
MQI: TMultiQI;
ServerInfo: TCoServerInfo;
AuthInfo: TCoAuthInfo;
AuthIdent : TCoAuthIdentity;
IID_IUnknown: TGuid;
Flags, Size: DWORD;
LocalMachine: array [0..MAX_COMPUTERNAME_LENGTH] of char;
iiu:IDispatch;
qr:HRESULT;
begin
if @CoCreateInstanceEx = nil then
raise Exception.CreateRes(@SDCOMNotInstalled);
FillChar(ServerInfo, sizeof(ServerInfo), 0);
ServerInfo.pwszName := PWideChar(MachineName);
ServerInfo.pAuthInfo := @AuthInfo;
ServerInfo.dwReserved1 := 0;
ServerInfo.dwReserved2 := 0;

FillChar(AuthInfo, sizeof(AuthInfo), 0);
AuthInfo.dwAuthnSvc := RPC_C_AUTHN_WINNT;
AuthInfo.dwAuthzSvc := RPC_C_AUTHN_NONE;
AuthInfo.pwszServerPrincName := nil;
AuthInfo.dwAuthnLevel := RPC_C_AUTHN_LEVEL_DEFAULT;
AuthInfo.dwImpersonationLevel := RPC_C_IMP_LEVEL_IMPERSONATE;
AuthInfo.pAuthIdentityData := @AuthIdent;
AuthInfo.dwCapabilities := EOAC_NONE;

FillChar(AuthIdent, sizeof(AuthIdent), 0);
AuthIdent.User := PWideChar(UserName);
AuthIdent.UserLength := Length(UserName);
AuthIdent.Domain := PWideChar(MachineName);
AuthIdent.DomainLength := Length(MachineName);
AuthIdent.Password := PWideChar(Password);
AuthIdent.PasswordLength := Length(Password);
AuthIdent.Flags := SEC_WINNT_AUTH_IDENTITY_UNICODE;

IID_IUnknown := IUnknown;
MQI.IID := @IID_IUnknown;
MQI.itf := nil;
MQI.hr := 0;
{ If a MachineName is specified check to see if it the local machine.
If it isn't, do not allow LocalServers to be used. }
if Length(MachineName) > 0 then
begin
Size := Sizeof(LocalMachine); // Win95 is hypersensitive to size
if GetComputerName(LocalMachine, Size) and
(AnsiCompareText(LocalMachine, MachineName) = 0) then
Flags := LocalFlags else
Flags := RemoteFlags;
end else
Flags := LocalFlags;

OleCheck(CoCreateInstanceEx(ClassID, nil, Flags, @ServerInfo, 1, @MQI));
OleCheck(MQI.HR);

SetProxyBlanket(mqi.Itf, AuthInfo);
qr:=mqi.Itf.QueryInterface(idispatch, iiu);
OleCheck(qr);
SetProxyBlanket(IUnknown(iiu), AuthInfo);
Result := iiu;
end;

{ TSecDCOMConnection }

constructor TSecDCOMConnection.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
end;

procedure TSecDCOMConnection.DoConnect;
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 begin
if (ComputerName <> '') then begin
if UserName <> '' then begin
SetAppServer(CreateRemoteSecComObject(ComputerName, UserName, Password, GetServerCLSID));
end else begin
SetAppServer(CreateRemoteComObject(ComputerName, GetServerCLSID) as IDispatch);
end;
end else
inherited DoConnect;
end;
end;

end.