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