RealICQClient/COM/IEBHO/CallClientInterfaceUnit.pas

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.