Marco Cantù 1998, Mastering Delphi 4

Project: CORBA1.DPR


Project Structure


CORBA1.DPR

program Corba1;

uses
  Forms,
  CorbaF in 'CorbaF.pas' {Form1},
  Corba1_TLB in 'Corba1_TLB.pas',
  CorbaDM in 'CorbaDM.pas' {FirstCorba: TCorbaDataModule} {FirstCorba: CoClass};

{$R *.TLB} {CORBA}

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

CORBAF.PAS

unit CorbaF;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type
  TForm1 = class(TForm)
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

end.

CORBA1_TLB.PAS

unit Corba1_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 7/14/98 6:23:01 PM from Type Library described below.

// ************************************************************************ //
// Type Lib: C:\md4code\Part5\25\Corba1\Corba1.tlb
// IID\LCID: {4A0AD345-1B2C-11D2-B9F1-004845400FAA}\0
// Helpfile: 
// HelpString: Project1 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_Corba1: TGUID = '{4A0AD345-1B2C-11D2-B9F1-004845400FAA}';
  IID_IFirstCorba: TGUID = '{4A0AD346-1B2C-11D2-B9F1-004845400FAA}';
  CLASS_FirstCorba: TGUID = '{4A0AD348-1B2C-11D2-B9F1-004845400FAA}';
type

// *********************************************************************//
// Forward declaration of interfaces defined in Type Library            //
// *********************************************************************//
  IFirstCorba = interface;
  IFirstCorbaDisp = dispinterface;

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


// *********************************************************************//
// Interface: IFirstCorba
// Flags:     (4416) Dual OleAutomation Dispatchable
// GUID:      {4A0AD346-1B2C-11D2-B9F1-004845400FAA}
// *********************************************************************//
  IFirstCorba = interface(IDataBroker)
    ['{4A0AD346-1B2C-11D2-B9F1-004845400FAA}']
    function Get_Table1: IProvider; safecall;
    property Table1: IProvider read Get_Table1;
  end;

// *********************************************************************//
// DispIntf:  IFirstCorbaDisp
// Flags:     (4416) Dual OleAutomation Dispatchable
// GUID:      {4A0AD346-1B2C-11D2-B9F1-004845400FAA}
// *********************************************************************//
  IFirstCorbaDisp = dispinterface
    ['{4A0AD346-1B2C-11D2-B9F1-004845400FAA}']
    property Table1: IProvider readonly dispid 1;
    function GetProviderNames: OleVariant; dispid 22929905;
  end;

  TFirstCorbaStub = class(TDataBrokerStub, IFirstCorba)
  public
    function Get_Table1: IProvider; safecall;
  end;

  TFirstCorbaSkeleton = class(TDataBrokerSkeleton)
  private
    FIntf: IFirstCorba;
  public
    constructor Create(const InstanceName: string; const Impl: IUnknown); override;
    procedure GetImplementation(out Impl: IUnknown); override; stdcall;
  published
    procedure Get_Table1(const InBuf: IMarshalInBuffer; Cookie: Pointer);
  end;

  CoFirstCorba = class
    class function Create: IFirstCorba;
    class function CreateRemote(const MachineName: string): IFirstCorba;
  end;

  TFirstCorbaCorbaFactory = class
    class function CreateInstance(const InstanceName: string): IFirstCorba;
  end;

implementation

uses ComObj;

{ TFirstCorbaStub }

function TFirstCorbaStub.Get_Table1: IProvider;
var
  OutBuf: IMarshalOutBuffer;
  InBuf: IMarshalInBuffer;
begin
  FStub.CreateRequest('Get_Table1', True, OutBuf);
  FStub.Invoke(OutBuf, InBuf);
  Result := UnmarshalObject(InBuf, IProvider) as IProvider;
end;

{ TFirstCorbaSkeleton }

constructor TFirstCorbaSkeleton.Create(const InstanceName: string; const Impl: IUnknown);
begin
  inherited;
  inherited InitSkeleton('FirstCorba', InstanceName, '', tmMultiThreaded, True);
  FIntf := Impl as IFirstCorba;
end;

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

procedure TFirstCorbaSkeleton.Get_Table1(const InBuf: IMarshalInBuffer; Cookie: Pointer);
var
  OutBuf: IMarshalOutBuffer;
  Retval: IProvider;
begin
  Retval := FIntf.Get_Table1;
  FSkeleton.GetReplyBuffer(Cookie, OutBuf);
  MarshalObject(OutBuf, IProvider, Retval);
end;

class function CoFirstCorba.Create: IFirstCorba;
begin
  Result := CreateComObject(CLASS_FirstCorba) as IFirstCorba;
end;

class function CoFirstCorba.CreateRemote(const MachineName: string): IFirstCorba;
begin
  Result := CreateRemoteComObject(MachineName, CLASS_FirstCorba) as IFirstCorba;
end;

class function TFirstCorbaCorbaFactory.CreateInstance(const InstanceName: string): IFirstCorba;
begin
  Result := CorbaFactoryCreateStub('IDL:Corba1/FirstCorbaFactory:1.0', 'FirstCorba',
    InstanceName, '', IFirstCorba) as IFirstCorba;
end;

initialization
  CorbaStubManager.RegisterStub(IFirstCorba, TFirstCorbaStub);
  CorbaInterfaceIDManager.RegisterInterface(IFirstCorba, 'IDL:FirstCorba:1.0');
  CorbaSkeletonManager.RegisterSkeleton(IFirstCorba, TFirstCorbaSkeleton);

end.

CORBADM.PAS

unit CorbaDM;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComObj, VCLCom, StdVcl, BdeProv, DataBkr, CorbaRdm, CorbaObj,
  Corba1_TLB, Db, DBTables;

type

  TFirstCorba = class(TCorbaDataModule, IFirstCorba)
    Table1: TTable;
  private
    { Private declarations }
  public
    { Public declarations }
  protected
    function Get_Table1: IProvider; safecall;
  end;

var
  FirstCorba: TFirstCorba;

implementation

{$R *.DFM}

uses CorbInit, CorbaVcl;

function TFirstCorba.Get_Table1: IProvider;
begin
  Result := Table1.Provider;
end;

initialization
  TCorbaVclComponentFactory.Create('FirstCorbaFactory', 'FirstCorba', 'IDL:Corba1/FirstCorbaFactory:1.0', IFirstCorba,
    TFirstCorba, iMultiInstance, tmSingleThread);
end.

CORBAF.DFM

object Form1: TForm1
  Left = 229
  Top = 108
  Width = 185
  Height = 44
  Caption = 'Corba1 Server'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
end

CORBADM.DFM

object FirstCorba: TFirstCorba
  OldCreateOrder = False
  Left = 283
  Top = 192
  Height = 150
  Width = 215
  object Table1: TTable
    DatabaseName = 'DBDEMOS'
    TableName = 'biolife.db'
    Left = 24
    Top = 16
  end
end


Copyright Marco Cantù 1998