firstcorbaserver_tlb.pas

《Delphi开发人员指南》配书原码

unit FirstCorbaServer_TLB;

// ************************************************************************ //
// WARNING                                                                    
// -------                                                                    
// The types declared in this file were generated from data read from a       
// Type Library. If this type library is explicitly or indirectly (via        
// another type library referring to this type library) re-imported, or the   
// 'Refresh' command of the Type Library Editor activated while editing the   
// Type Library, the contents of this file will be regenerated and all        
// manual modifications will be lost.                                         
// ************************************************************************ //

// PASTLWTR : $Revision:   1.88  $
// File generated on 11/02/1999 4:05:54 PM from Type Library described below.

// ************************************************************************ //
// Type Lib: C:\ICON99\FirstCORBAServer\FirstCorbaServer.tlb (1)
// IID\LCID: {CE8DB340-913A-11D3-9706-0000861F6726}\0
// Helpfile: 
// DepndLst: 
//   (1) v2.0 stdole, (C:\WINDOWS\SYSTEM\STDOLE2.TLB)
//   (2) v4.0 StdVCL, (C:\WINDOWS\SYSTEM\STDVCL40.DLL)
// ************************************************************************ //
{$TYPEDADDRESS OFF} // Unit must be compiled without type-checked pointers. 
interface

uses Windows, ActiveX, Classes, Graphics, OleServer, OleCtrls, StdVCL, SysUtils, CORBAObj, OrbPas, CorbaStd;

// *********************************************************************//
// GUIDS declared in the TypeLibrary. Following prefixes are used:        
//   Type Libraries     : LIBID_xxxx                                      
//   CoClasses          : CLASS_xxxx                                      
//   DISPInterfaces     : DIID_xxxx                                       
//   Non-DISP interfaces: IID_xxxx                                        
// *********************************************************************//
const
  // TypeLibrary Major and minor versions
  FirstCorbaServerMajorVersion = 1;
  FirstCorbaServerMinorVersion = 0;

  LIBID_FirstCorbaServer: TGUID = '{CE8DB340-913A-11D3-9706-0000861F6726}';

  IID_IMyFirstCorbaServer: TGUID = '{CE8DB341-913A-11D3-9706-0000861F6726}';
  CLASS_MyFirstCorbaServer: TGUID = '{CE8DB343-913A-11D3-9706-0000861F6726}';
type

// *********************************************************************//
// Forward declaration of types defined in TypeLibrary                    
// *********************************************************************//
  IMyFirstCorbaServer = interface;
  IMyFirstCorbaServerDisp = dispinterface;

// *********************************************************************//
// Declaration of CoClasses defined in Type Library                       
// (NOTE: Here we map each CoClass to its Default Interface)              
// *********************************************************************//
  MyFirstCorbaServer = IMyFirstCorbaServer;


// *********************************************************************//
// Interface: IMyFirstCorbaServer
// Flags:     (4416) Dual OleAutomation Dispatchable
// GUID:      {CE8DB341-913A-11D3-9706-0000861F6726}
// *********************************************************************//
  IMyFirstCorbaServer = interface(IDispatch)
    ['{CE8DB341-913A-11D3-9706-0000861F6726}']
    procedure SayHelloWorld; safecall;
  end;

// *********************************************************************//
// DispIntf:  IMyFirstCorbaServerDisp
// Flags:     (4416) Dual OleAutomation Dispatchable
// GUID:      {CE8DB341-913A-11D3-9706-0000861F6726}
// *********************************************************************//
  IMyFirstCorbaServerDisp = dispinterface
    ['{CE8DB341-913A-11D3-9706-0000861F6726}']
    procedure SayHelloWorld; dispid 1;
  end;

  TMyFirstCorbaServerStub = class(TCorbaDispatchStub, IMyFirstCorbaServer)
  public
    procedure SayHelloWorld; safecall;
  end;

  TMyFirstCorbaServerSkeleton = class(TCorbaSkeleton)
  private
    FIntf: IMyFirstCorbaServer;
  public
    constructor Create(const InstanceName: string; const Impl: IUnknown); override;
    procedure GetImplementation(out Impl: IUnknown); override; stdcall;
  published
    procedure SayHelloWorld(const InBuf: IMarshalInBuffer; Cookie: Pointer);
  end;

// *********************************************************************//
// The Class CoMyFirstCorbaServer provides a Create and CreateRemote method to          
// create instances of the default interface IMyFirstCorbaServer exposed by              
// the CoClass MyFirstCorbaServer. The functions are intended to be used by             
// clients wishing to automate the CoClass objects exposed by the         
// server of this typelibrary.                                            
// *********************************************************************//
  CoMyFirstCorbaServer = class
    class function Create: IMyFirstCorbaServer;
    class function CreateRemote(const MachineName: string): IMyFirstCorbaServer;
  end;

  TMyFirstCorbaServerCorbaFactory = class
    class function CreateInstance(const InstanceName: string): IMyFirstCorbaServer;
  end;

implementation

uses ComObj;

{ TMyFirstCorbaServerStub }

procedure TMyFirstCorbaServerStub.SayHelloWorld;
var
  OutBuf: IMarshalOutBuffer;
  InBuf: IMarshalInBuffer;
begin
  FStub.CreateRequest('SayHelloWorld', True, OutBuf);
  FStub.Invoke(OutBuf, InBuf);
end;

{ TMyFirstCorbaServerSkeleton }

constructor TMyFirstCorbaServerSkeleton.Create(const InstanceName: string; const Impl: IUnknown);
begin
  inherited;
  inherited InitSkeleton('MyFirstCorbaServer', InstanceName, 'IDL:FirstCorbaServer/IMyFirstCorbaServer:1.0', tmMultiThreaded, True);
  FIntf := Impl as IMyFirstCorbaServer;
end;

procedure TMyFirstCorbaServerSkeleton.GetImplementation(out Impl: IUnknown);
begin
  Impl := FIntf;
end;

procedure TMyFirstCorbaServerSkeleton.SayHelloWorld(const InBuf: IMarshalInBuffer; Cookie: Pointer);
var
  OutBuf: IMarshalOutBuffer;
begin
  FIntf.SayHelloWorld;
  FSkeleton.GetReplyBuffer(Cookie, OutBuf);
end;

class function CoMyFirstCorbaServer.Create: IMyFirstCorbaServer;
begin
  Result := CreateComObject(CLASS_MyFirstCorbaServer) as IMyFirstCorbaServer;
end;

class function CoMyFirstCorbaServer.CreateRemote(const MachineName: string): IMyFirstCorbaServer;
begin
  Result := CreateRemoteComObject(MachineName, CLASS_MyFirstCorbaServer) as IMyFirstCorbaServer;
end;

class function TMyFirstCorbaServerCorbaFactory.CreateInstance(const InstanceName: string): IMyFirstCorbaServer;
begin
  Result := CorbaFactoryCreateStub('IDL:FirstCorbaServer/MyFirstCorbaServerFactory:1.0', 'MyFirstCorbaServer',
    InstanceName, '', IMyFirstCorbaServer) as IMyFirstCorbaServer;
end;

initialization
  CorbaStubManager.RegisterStub(IMyFirstCorbaServer, TMyFirstCorbaServerStub);
  CorbaInterfaceIDManager.RegisterInterface(IMyFirstCorbaServer, 'IDL:FirstCorbaServer/IMyFirstCorbaServer:1.0');
  CorbaSkeletonManager.RegisterSkeleton(IMyFirstCorbaServer, TMyFirstCorbaServerSkeleton);

end.