unit CallClientInterfaceUnit; {$WARN SYMBOL_PLATFORM OFF} interface uses Windows, Classes, ComObj, Shdocvw, ActiveX, IEBHO_TLB, StdVcl, Registry, CIEBHO; type TCallClientInterface = class(TAutoObject, ICallClientInterface, IObjectSafety) private FObjectSafetyFlags: DWORD; protected procedure OpenTalkingForm(LoginName: OleVariant); safecall; function GetInterfaceSafetyOptions(const IID: TIID; pdwSupportedOptions, pdwEnabledOptions: PDWORD): HResult; stdcall; function SetInterfaceSafetyOptions(const IID: TIID; dwOptionSetMask, dwEnabledOptions: DWORD): HResult; stdcall; end; implementation uses Variants, ComServ, Sysutils, ComConst, ShellAPI; //------------------------------------------------------------------------------ procedure TCallClientInterface.OpenTalkingForm(LoginName: OleVariant); var ExeFileName: String; FVar: OleVariant; Registry: TRegistry; Handle: HWND; begin ExeFileName := ''; {从注册表中读取 BaseURL} Registry := TRegistry.Create; try Registry.RootKey := HKEY_LOCAL_MACHINE; if Registry.OpenKey(AppKey + CompanyKeyValue, True) then begin ExeFileName := Registry.ReadString('ExeFileName'); end; finally Registry.Free; end; Handle := openmutex(mutex_all_access, False, iAtom); try if Handle = 0 then begin if MessageBox(0, PChar(AppTitle + ' 还未启动,是否启动?'), '提示', MB_ICONQUESTION or MB_YESNO) = ID_YES then begin ShellExecute(0, 'open', PChar('"' + ExeFileName + '"'), nil, nil, SW_SHOWNORMAL); end; Exit; end; finally closeHandle(Handle); end; FVar := CreateOleObject('RealICQ.RealOAMessengerAutoServer'); try try FVar.OpenTalkingForm(LoginName); except on E: Exception do MessageBox(0, PChar(E.Message), '错误', MB_ICONERROR); end; finally FVar := Unassigned; end; end; //------------------------------------------------------------------------------ function TCallClientInterface.GetInterfaceSafetyOptions(const IID: TIID; pdwSupportedOptions, pdwEnabledOptions: PDWORD): HResult; var Unk: IUnknown; begin if (pdwSupportedOptions = nil) or (pdwEnabledOptions = nil) then begin Result := E_POINTER; Exit; end; Result := QueryInterface(IID, Unk); if Result = S_OK then begin pdwSupportedOptions^ := INTERFACESAFE_FOR_UNTRUSTED_CALLER or INTERFACESAFE_FOR_UNTRUSTED_DATA; pdwEnabledOptions^ := FObjectSafetyFlags and (INTERFACESAFE_FOR_UNTRUSTED_CALLER or INTERFACESAFE_FOR_UNTRUSTED_DATA); end else begin pdwSupportedOptions^ := 0; pdwEnabledOptions^ := 0; end; end; //------------------------------------------------------------------------------ function TCallClientInterface.SetInterfaceSafetyOptions(const IID: TIID; dwOptionSetMask, dwEnabledOptions: DWORD): HResult; var Unk: IUnknown; begin Result := QueryInterface(IID, Unk); if Result <> S_OK then Exit; FObjectSafetyFlags := dwEnabledOptions and dwOptionSetMask; end; initialization TAutoObjectFactory.Create(ComServer, TCallClientInterface, Class_CallClientInterface, ciMultiInstance, tmApartment); end.