serverprj_tlb.pas

电脑编程技巧和源码。很不错的。

unit serverprj_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.11.1.63  $
// File generated on 99-10-15 10:01:29 from Type Library described below.

// ************************************************************************ //
// Type Lib: D:\zjh\corba\server\serverprj.tlb
// IID\LCID: {4E9DD860-82E7-11D3-A0DB-0010609017AB}\0
// Helpfile: 
// HelpString: serverprj Library
// Version:    1.0
// ************************************************************************ //

interface

uses Windows, ActiveX, Classes, Graphics, 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
  LIBID_serverprj: TGUID = '{4E9DD860-82E7-11D3-A0DB-0010609017AB}';
  IID_ICorbaServerObject: TGUID = '{4E9DD861-82E7-11D3-A0DB-0010609017AB}';
  CLASS_CorbaServerObject: TGUID = '{4E9DD863-82E7-11D3-A0DB-0010609017AB}';
type

// *********************************************************************//
// Forward declaration of interfaces defined in Type Library            //
// *********************************************************************//
  ICorbaServerObject = interface;
  ICorbaServerObjectDisp = dispinterface;

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


// *********************************************************************//
// Interface: ICorbaServerObject
// Flags:     (4416) Dual OleAutomation Dispatchable
// GUID:      {4E9DD861-82E7-11D3-A0DB-0010609017AB}
// *********************************************************************//
  ICorbaServerObject = interface(IDispatch)
    ['{4E9DD861-82E7-11D3-A0DB-0010609017AB}']
    function MultiplyServe(a: Integer; b: Integer): WideString; safecall;
  end;

// *********************************************************************//
// DispIntf:  ICorbaServerObjectDisp
// Flags:     (4416) Dual OleAutomation Dispatchable
// GUID:      {4E9DD861-82E7-11D3-A0DB-0010609017AB}
// *********************************************************************//
  ICorbaServerObjectDisp = dispinterface
    ['{4E9DD861-82E7-11D3-A0DB-0010609017AB}']
    function MultiplyServe(a: Integer; b: Integer): WideString; dispid 1;
  end;

  TCorbaServerObjectStub = class(TCorbaDispatchStub, ICorbaServerObject)
  public
    function MultiplyServe(a: Integer; b: Integer): WideString; safecall;
  end;

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

  CoCorbaServerObject = class
    class function Create: ICorbaServerObject;
    class function CreateRemote(const MachineName: string): ICorbaServerObject;
  end;

  TCorbaServerObjectCorbaFactory = class
    class function CreateInstance(const InstanceName: string): ICorbaServerObject;
  end;

implementation

uses ComObj;

{ TCorbaServerObjectStub }

function TCorbaServerObjectStub.MultiplyServe(a: Integer; b: Integer): WideString;
var
  OutBuf: IMarshalOutBuffer;
  InBuf: IMarshalInBuffer;
begin
  FStub.CreateRequest('MultiplyServe', True, OutBuf);
  OutBuf.PutLong(a);
  OutBuf.PutLong(b);
  FStub.Invoke(OutBuf, InBuf);
  Result := UnmarshalWideText(InBuf);
end;

{ TCorbaServerObjectSkeleton }

constructor TCorbaServerObjectSkeleton.Create(const InstanceName: string; const Impl: IUnknown);
begin
  inherited;
  inherited InitSkeleton('CorbaServerObject', InstanceName, 'IDL:serverprj/ICorbaServerObject:1.0', tmMultiThreaded, True);
  FIntf := Impl as ICorbaServerObject;
end;

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

procedure TCorbaServerObjectSkeleton.MultiplyServe(const InBuf: IMarshalInBuffer; Cookie: Pointer);
var
  OutBuf: IMarshalOutBuffer;
  Retval: WideString;
  a: Integer;
  b: Integer;
begin
  a := InBuf.GetLong;
  b := InBuf.GetLong;
  Retval := FIntf.MultiplyServe(a, b);
  FSkeleton.GetReplyBuffer(Cookie, OutBuf);
  OutBuf.PutWideText(PWideChar(Pointer(Retval)));
end;

class function CoCorbaServerObject.Create: ICorbaServerObject;
begin
  Result := CreateComObject(CLASS_CorbaServerObject) as ICorbaServerObject;
end;

class function CoCorbaServerObject.CreateRemote(const MachineName: string): ICorbaServerObject;
begin
  Result := CreateRemoteComObject(MachineName, CLASS_CorbaServerObject) as ICorbaServerObject;
end;

class function TCorbaServerObjectCorbaFactory.CreateInstance(const InstanceName: string): ICorbaServerObject;
begin
  Result := CorbaFactoryCreateStub('IDL:serverprj/CorbaServerObjectFactory:1.0', 'CorbaServerObject',
    InstanceName, '', ICorbaServerObject) as ICorbaServerObject;
end;

initialization
  CorbaStubManager.RegisterStub(ICorbaServerObject, TCorbaServerObjectStub);
  CorbaInterfaceIDManager.RegisterInterface(ICorbaServerObject, 'IDL:serverprj/ICorbaServerObject:1.0');
  CorbaSkeletonManager.RegisterSkeleton(ICorbaServerObject, TCorbaServerObjectSkeleton);

end.