vba_tlb.pas

基于Delphi的IP电话开发的源代码

end;

function  TVBAErrObject.Get_Source: WideString;
begin
  Result := DefaultInterface.Source;
end;

procedure TVBAErrObject.Set_Source(const pbstr: WideString);
  { Warning: The property Source has a setter and a getter whose
  types do not match. Delphi was unable to generate a property of
  this sort and so is using a Variant to set the property instead. }
var
  InterfaceVariant: OleVariant;
begin
  InterfaceVariant := DefaultInterface;
  InterfaceVariant.Source := pbstr;
end;

function  TVBAErrObject.Get_Description: WideString;
begin
  Result := DefaultInterface.Description;
end;

procedure TVBAErrObject.Set_Description(const pbstr: WideString);
  { Warning: The property Description has a setter and a getter whose
  types do not match. Delphi was unable to generate a property of
  this sort and so is using a Variant to set the property instead. }
var
  InterfaceVariant: OleVariant;
begin
  InterfaceVariant := DefaultInterface;
  InterfaceVariant.Description := pbstr;
end;

function  TVBAErrObject.Get_HelpFile: WideString;
begin
  Result := DefaultInterface.HelpFile;
end;

procedure TVBAErrObject.Set_HelpFile(const pbstr: WideString);
  { Warning: The property HelpFile has a setter and a getter whose
  types do not match. Delphi was unable to generate a property of
  this sort and so is using a Variant to set the property instead. }
var
  InterfaceVariant: OleVariant;
begin
  InterfaceVariant := DefaultInterface;
  InterfaceVariant.HelpFile := pbstr;
end;

function  TVBAErrObject.Get_HelpContext: Integer;
begin
  Result := DefaultInterface.HelpContext;
end;

procedure TVBAErrObject.Set_HelpContext(pi4: Integer);
begin
//  DefaultInterface.HelpContext := pi4;
end;

function  TVBAErrObject.Get_LastDllError: Integer;
begin
  Result := DefaultInterface.LastDllError;
end;

procedure TVBAErrObject.Raise_(Number: Integer);
begin
  DefaultInterface.Raise_(Number, EmptyParam, EmptyParam, EmptyParam, EmptyParam);
end;

procedure TVBAErrObject.Raise_(Number: Integer; var Source: OleVariant);
begin
  DefaultInterface.Raise_(Number, Source, EmptyParam, EmptyParam, EmptyParam);
end;

procedure TVBAErrObject.Raise_(Number: Integer; var Source: OleVariant; var Description: OleVariant);
begin
  DefaultInterface.Raise_(Number, Source, Description, EmptyParam, EmptyParam);
end;

procedure TVBAErrObject.Raise_(Number: Integer; var Source: OleVariant; 
                               var Description: OleVariant; var HelpFile: OleVariant);
begin
  DefaultInterface.Raise_(Number, Source, Description, HelpFile, EmptyParam);
end;

procedure TVBAErrObject.Raise_(Number: Integer; var Source: OleVariant; 
                               var Description: OleVariant; var HelpFile: OleVariant; 
                               var HelpContext: OleVariant);
begin
  DefaultInterface.Raise_(Number, Source, Description, HelpFile, HelpContext);
end;

procedure TVBAErrObject.Clear;
begin
  DefaultInterface.Clear;
end;

{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
constructor TVBAErrObjectProperties.Create(AServer: TVBAErrObject);
begin
  inherited Create;
  FServer := AServer;
end;

function TVBAErrObjectProperties.GetDefaultInterface: _ErrObject;
begin
  Result := FServer.DefaultInterface;
end;

function  TVBAErrObjectProperties.Get_Number: Integer;
begin
  Result := DefaultInterface.Number;
end;

procedure TVBAErrObjectProperties.Set_Number(pi4: Integer);
begin
  DefaultInterface.Number := pi4;
end;

function  TVBAErrObjectProperties.Get_Source: WideString;
begin
  Result := DefaultInterface.Source;
end;

procedure TVBAErrObjectProperties.Set_Source(const pbstr: WideString);
  { Warning: The property Source has a setter and a getter whose
  types do not match. Delphi was unable to generate a property of
  this sort and so is using a Variant to set the property instead. }
var
  InterfaceVariant: OleVariant;
begin
  InterfaceVariant := DefaultInterface;
  InterfaceVariant.Source := pbstr;
end;

function  TVBAErrObjectProperties.Get_Description: WideString;
begin
  Result := DefaultInterface.Description;
end;

procedure TVBAErrObjectProperties.Set_Description(const pbstr: WideString);
  { Warning: The property Description has a setter and a getter whose
  types do not match. Delphi was unable to generate a property of
  this sort and so is using a Variant to set the property instead. }
var
  InterfaceVariant: OleVariant;
begin
  InterfaceVariant := DefaultInterface;
  InterfaceVariant.Description := pbstr;
end;

function  TVBAErrObjectProperties.Get_HelpFile: WideString;
begin
  Result := DefaultInterface.HelpFile;
end;

procedure TVBAErrObjectProperties.Set_HelpFile(const pbstr: WideString);
  { Warning: The property HelpFile has a setter and a getter whose
  types do not match. Delphi was unable to generate a property of
  this sort and so is using a Variant to set the property instead. }
var
  InterfaceVariant: OleVariant;
begin
  InterfaceVariant := DefaultInterface;
  InterfaceVariant.HelpFile := pbstr;
end;

function  TVBAErrObjectProperties.Get_HelpContext: Integer;
begin
  Result := DefaultInterface.HelpContext;
end;

procedure TVBAErrObjectProperties.Set_HelpContext(pi4: Integer);
begin
  DefaultInterface.HelpContext := pi4;
end;

function  TVBAErrObjectProperties.Get_LastDllError: Integer;
begin
  Result := DefaultInterface.LastDllError;
end;

{$ENDIF}

class function CoCollection.Create: _Collection;
begin
  Result := CreateComObject(CLASS_Collection) as _Collection;
end;

class function CoCollection.CreateRemote(const MachineName: string): _Collection;
begin
  Result := CreateRemoteComObject(MachineName, CLASS_Collection) as _Collection;
end;

procedure TVBACollection.InitServerData;
const
  CServerData: TServerData = (
    ClassID:   '{A4C4671C-499F-101B-BB78-00AA00383CBB}';
    IntfIID:   '{A4C46780-499F-101B-BB78-00AA00383CBB}';
    EventIID:  '';
    LicenseKey: nil;
    Version: 500);
begin
  ServerData := @CServerData;
end;

procedure TVBACollection.Connect;
var
  punk: IUnknown;
begin
  if FIntf = nil then
  begin
    punk := GetServer;
    Fintf:= punk as _Collection;
  end;
end;

procedure TVBACollection.ConnectTo(svrIntf: _Collection);
begin
  Disconnect;
  FIntf := svrIntf;
end;

procedure TVBACollection.DisConnect;
begin
  if Fintf <> nil then
  begin
    FIntf := nil;
  end;
end;

function TVBACollection.GetDefaultInterface: _Collection;
begin
  if FIntf = nil then
    Connect;
  Assert(FIntf <> nil, 'DefaultInterface is NULL. Component is not connected to Server. You must call ''Connect'' or ''ConnectTo'' before this operation');
  Result := FIntf;
end;

constructor TVBACollection.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
  FProps := TVBACollectionProperties.Create(Self);
{$ENDIF}
end;

destructor TVBACollection.Destroy;
begin
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
  FProps.Free;
{$ENDIF}
  inherited Destroy;
end;

{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
function TVBACollection.GetServerProperties: TVBACollectionProperties;
begin
  Result := FProps;
end;
{$ENDIF}

function  TVBACollection.Item(var Index: OleVariant): OleVariant;
begin
  Result := DefaultInterface.Item(Index);
end;

procedure TVBACollection.Add(var Item: OleVariant);
begin
  DefaultInterface.Add(Item, EmptyParam, EmptyParam, EmptyParam);
end;

procedure TVBACollection.Add(var Item: OleVariant; var Key: OleVariant);
begin
  DefaultInterface.Add(Item, Key, EmptyParam, EmptyParam);
end;

procedure TVBACollection.Add(var Item: OleVariant; var Key: OleVariant; var Before: OleVariant);
begin
  DefaultInterface.Add(Item, Key, Before, EmptyParam);
end;

procedure TVBACollection.Add(var Item: OleVariant; var Key: OleVariant; var Before: OleVariant; 
                             var After: OleVariant);
begin
  DefaultInterface.Add(Item, Key, Before, After);
end;

function  TVBACollection.Count: Integer;
begin
  Result := DefaultInterface.Count;
end;

procedure TVBACollection.Remove(var Index: OleVariant);
begin
  DefaultInterface.Remove(Index);
end;

function  TVBACollection._NewEnum: IUnknown;
begin
  Result := DefaultInterface._NewEnum;
end;

{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
constructor TVBACollectionProperties.Create(AServer: TVBACollection);
begin
  inherited Create;
  FServer := AServer;
end;

function TVBACollectionProperties.GetDefaultInterface: _Collection;
begin
  Result := FServer.DefaultInterface;
end;

{$ENDIF}

procedure Register;
begin
  RegisterComponents(dtlServerPage, [TVBAErrObject, TVBACollection]);
end;

end.