以遠程計算機上的用戶身份訪問Com+應(yīng)用

Delph中遠程com+對象激活一般通過TdispatchConnection及其子類來實現(xiàn)，實際代碼中多用TDCOMConnection或TsocketConnectoion這兩個組件，TDCOMConnection組件最終調(diào)用CoCreateInstanceEx創(chuàng)建com+對象。CoCreateInstanceEx (const clsid: TCLSID; unkOuter: IUnknown; dwClsCtx: Longint; ServerInfo:PCoServerInfo;dwCount: Longint; rgmqResults: PMultiQIArray): HResult。

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結(jié)構(gòu)

  cai.dwAuthnSvc:=10;//winNt默認的鑒證服務(wù)

  cai.dwAuthzSvc:=0;

  cai.pwszServerPRincName:=wDomain;

  cai.dwAuthnLevel:=0;

  cai.dwImpersonationLevel:=3;//必須設(shè)置成模擬

  cai.pAuthIdentityData:=@cid;

  cai.dwCapabilities:=$0800;

  FillChar(csi, sizeof(csi), 0);

  csi.dwReserved1:=0;

  csi.pwszName:=pwidechar(wdomain);

  csi.pAuthInfo:=@cai;

  //以上填充COSERVERINFO結(jié)構(gòu)

  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));

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 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.

      MySetBlanket(mqi.Itf,Fcai);

      qr:=mqi.Itf.QueryInterface(idispatch,iiu);

      olecheck(qr);

      MySetBlanket(IUnknown(iiu),FCai);