非匿名方式访问远程的COM+

COM+的部署一直是个非常头疼的事情，往往在同一台电脑上开发客户端和应用层端时，运行的好好的，可是一旦把客户端部署到其它电脑上去，麻烦就接踵而来。


今天要讨论的只是其中的一个经常会遇到的麻烦：“拒绝访问”，通常发生这种问题的原因是客户端调用者的身份不符合服务器端的要求，因此需要修改服务器端的验证规则，或者在客户端提交连接时，将服务器端的帐户提供给服务器，而不是想往常那样简单的置为NULL。

{重载连接方法}

unit uJZCom;

interface

uses windows, comobj, activex;

type

    pUnShort = ^Word;

    pCoAuthIdentity = ^_CoAuthIdentity;

    _CoAuthIdentity = record
        user: PWideChar;
        UserLength: ULONG;
        Domain: PWideChar;
        DomainLength: ULONG;
        password: PWideChar;
        PasswordLength: ULONG;
        Flags: ULONG;
    end;

    _CoAuthInfo = record
        dwAuthnSvc: DWORD;
        dwAuthzSvc: DWORD;
        pwszServerPrincName: PWideChar;
        dwAuthnLevel: DWORD;
        dwImpersonationLevel: DWORD;
        pAuthIdentityData: pCoAuthIdentity;
        dwCapabilities: DWORD;
    end;

Function MySetBlanket(var itf: IUnknown; const vCai: _CoAuthInfo): HRESULT;
function DoConnect(const Class_IID, itf_iid: PIID;
    computer, username, psw: WideString): IUnknown;

implementation

uses
    SysUtils,
    StrUtils;

Function MySetBlanket(var itf: IUnknown; const vCai: _CoAuthInfo): HRESULT;
begin
    with vCai do
    begin
        result := CoSetProxyBlanket(itf, dwAuthnSvc, dwAuthzSvc,
            PWideChar(pAuthIdentityData^.Domain), dwAuthnLevel,
            dwImpersonationLevel, pAuthIdentityData, dwCapabilities);
    end;
end;

function DoConnect(const Class_IID, itf_iid: PIID;
    computer, username, psw: WideString): IUnknown;
var
    FCai: _CoAuthInfo;
    FCid: _CoAuthIdentity;
    FSvInfo: COSERVERINFO;
    Mqi: MULTI_QI;
    Size: DWORD;
    LocalMachine: array [0 .. MAX_COMPUTERNAME_LENGTH] of char;
begin
    result := nil;
    if Length(computer) > 0 then
    begin
        Size := sizeof(LocalMachine);
        if GetComputerName(LocalMachine, Size) and
            (UpperCase(computer) <> UpperCase(LocalMachine)) then
        // 电脑名称比较时大小写敏感
        begin
            FillMemory(@FCai, sizeof(FCai), 0);
            FillMemory(@FCid, sizeof(FCid), 0);
            FillMemory(@FSvInfo, sizeof(FSvInfo), 0);
            with FCid do
            begin
                user := PWideChar(username); // pUnshort(@userName[1]);
                UserLength := Length(username);
                Domain := PWideChar(computer); // pUnshort(@computer[1]);
                DomainLength := Length(computer);
                password := PWideChar(psw); // pUnShort(@psw[1]);
                PasswordLength := Length(psw);
                Flags := 2; // Unicode 字符串
            end;
            with FCai do
            begin
                dwAuthnSvc := 10; // RPC_C_AUTHN_WINNT  NTML认证服务
                dwAuthzSvc := 0; // RPC_C_AUTHZ_NONE
                dwAuthnLevel := 0; // RPC_C_AUTHN_LEVEL_DEFAULT 默认级别

                dwImpersonationLevel := 3; // 身份模拟
                pAuthIdentityData := @FCid;
                dwCapabilities := $0800; // 静态跟踪
            end;
            FSvInfo.pwszName := PWideChar(computer);
            FSvInfo.pAuthInfo := @FCai;

            with Mqi do
            begin
                iid := itf_iid;
                itf := nil;
                hr := 0;
            end;
            // 以远程用户身份激活并取得接口引用
            olecheck(CoCreateInstanceEx(Class_IID^, nil, CLSCTX_REMOTE_SERVER,
                    @FSvInfo, 1, @Mqi));
            olecheck(Mqi.hr);
            // 对取得的接口引用，要再次设置其安全属性为远程用户，否则返回的指针将仍然
            // 使用本地用户进程的安全属性向远程发起调用，此时的结果就是"拒绝访问"
            olecheck(MySetBlanket(Mqi.itf, FCai));
            result := Mqi.itf;
        end
        else // 原文遗漏，造成客户端与服务器端在同一台电脑上时，出现AV错误
            olecheck(CoCreateInstance(Class_IID^, nil,
                    CLSCTX_INPROC_SERVER or CLSCTX_LOCAL_SERVER, itf_iid^,
                    result));
    end
    else
        olecheck(CoCreateInstance(Class_IID^, nil,
                CLSCTX_INPROC_SERVER or CLSCTX_LOCAL_SERVER, itf_iid^,
                result));
end;

end.


客户端调用方法：

procedure TForm1.Button1Click(Sender: TObject);
begin
    svr := IBizRules(DoConnect(@class_bizrules, @iid_ibizrules, 'WINSEVEn',
            'admin', '******'));
    ClientDataSet1.Data := svr.GetEmployees;
    ClientDataSet1.Open;
end;