轻松搞定DCOM在局域网中连接问题！(20分)

把你的成果发到这儿，让更多人分享，岂不是更好？

hj_3000@126.com
谢谢

hi0769@126.com
謝謝

5xl@163.com
谢谢

kjzzn@sina.com 谢谢

请给我发一个：
xie6996@163.com

请给我发一个：
yuzhiq2003@163.com

yk@ridee.net
我帮你找个空间让大家下载得了

我也要一份,我用d7写了一个MTS,注册后成为com+程序,如何设置让另一台同属工作组的机器,可以访问这个com+,总是提示"RPC不可用",我也是按照网上的配置进行了配置.
我是参照这个:
xp系统中配置DCOM应用服务器
--------------------------------------------------------------------------------
来源：CSDN 发布会员：新书城收集整理 发布时间：2006-8-2 人气：448


一。协议
要确保XP系统中安装有 NWLink IPX/SPX/NetBIOS Compatible Transport Protocol 协议
二。DCOM配置
运行 DCOMCNFG.EXE
我的电脑 -- 属性
默认属性 -- 在此计算机上启用分布式COM 打勾
默认身份验证级别 （无）
COM 安全 -- 访问权限 和 启动和激活权限 中保证有 ： Administrator , everyone ,guest
点击 我的电脑 下的DCOM配置项,找到自已的DCOM(如：MyRom),右键属性
常规页，选择无.
位置页，在此计算机上运行应用程序打勾。
安全页，都选择自定义，都在保证有Administrator,EveryOne,Guest
标示页，选择交互式用户。
保证Guest是被启用的。
最重要的一点就是协议的安装，在最初进行测试时没有安装此协议，导致客户端不能正常进行连接。
经测试，把XP系统作为应用服务器，以 win98 and win2k 为客户端进行连接都正常，连接方式分别采用DCOM AND SocketConnection
如采用 SocketConnection 这种方式则不需要进行DCOM的这些配置。直接连接就可以，但要保证一点服务器端要先运行 Borland Socket Server(scktsrvr.exe)在Delphi/Bin中。如果服务器端没有运行，客户端在进行连接时则会出错。客户端也要先运行scktsrvr.exe后再运行客户端程序。
采用socketconnection进行连接，应用服务器可以放在windows98,windows2000,xp系统中。

我把源代码贴出来,生成一个pas,需要在delphi中install component一下就可以了:
unit uSecDComConnection;
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*do
main;
unsigned longdo
mainLength;
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 *do
main;
ULONGdo
mainLength;
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
userUnShort;
UserLength:ULONG;
do
mainUnShort;
do
mainLength:Ulong;
passwordUnShort;
PasswordLength:ulong;
Flags:ulong;
end;

_CoAuthInfo=record
dwAuthnSvcWORD;
dwAuthzSvcWORD;
pwszServerPrincName:WideString;
dwAuthnLevelword;
dwImpersonationLevel:dword;
pAuthIdentityDataCoAuthIdentity;
dwCapabilitiesWORD;
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
proceduredo
Connect;
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 FCaido
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 fciddo
begin

user:=pUnshort(@fuser[1]);
UserLength:=length(fuser);
tmpCmpName:=ComputerName;
do
main:=pUnshort(@tmpCmpName[1]);
do
mainLength:=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

inheriteddo
Connect;
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 vCaido

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.

to 搂主：
关于DCOM连接失败的问题！ 大多数的问题都是出在服务器端dcom设置不正确，是需要修改服务器端操作系统设置的问题，而由于客户端的问题不能连接的情况，是非常少的。
你修改TDCOMConnect的做法，顶多是在登陆时传输一个用户名/密码，而这种情况一般在服务器端是通过让everyone用户可以启动访问dcom组件来解决的，根本不需要单独的登陆用户，你的做法可有可无，注定了不能根本解决问题。亏你还写了一个“轻松搞定DCOM。。。”的诺大的题目，简直有哗众取宠的嫌疑， 真是打老虎揪尾巴，根本不在要害上。请你不要误人误己！！！