simplecorbaserver_tlb.pas

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

unit SimpleCorbaServer_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 6:01:08 PM from Type Library described below.

// ************************************************************************ //
// Type Lib: C:\ICON99\CORBA Server\SimpleCorbaServer.tlb (1)
// IID\LCID: {B7D4ED80-27C2-11D3-9703-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
  SimpleCorbaServerMajorVersion = 1;
  SimpleCorbaServerMinorVersion = 0;

  LIBID_SimpleCorbaServer: TGUID = '{B7D4ED80-27C2-11D3-9703-0000861F6726}';

  IID_IQueryServer: TGUID = '{B7D4ED81-27C2-11D3-9703-0000861F6726}';
  CLASS_QueryServer: TGUID = '{B7D4ED83-27C2-11D3-9703-0000861F6726}';
type

// *********************************************************************//
// Forward declaration of types defined in TypeLibrary                    
// *********************************************************************//
  IQueryServer = interface;
  IQueryServerDisp = dispinterface;

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


// *********************************************************************//
// Interface: IQueryServer
// Flags:     (4416) Dual OleAutomation Dispatchable
// GUID:      {B7D4ED81-27C2-11D3-9703-0000861F6726}
// *********************************************************************//
  IQueryServer = interface(IDispatch)
    ['{B7D4ED81-27C2-11D3-9703-0000861F6726}']
    function  Login(const Db: WideString; const User: WideString;
      const Password: WideString): WordBool; safecall;
    function  Get_SQL: WideString; safecall;
    procedure Set_SQL(const Value: WideString); safecall;
    procedure Next; safecall;
    procedure Prev; safecall;
    procedure First; safecall;
    procedure Last; safecall;
    function  Get_FieldCount: Integer; safecall;
    function  Data: OleVariant; safecall;
    function  Get_EOF: WordBool; safecall;
    function  Get_BOF: WordBool; safecall;
    function  Execute: WordBool; safecall;
    property SQL: WideString read Get_SQL write Set_SQL;
    property FieldCount: Integer read Get_FieldCount;
    property EOF: WordBool read Get_EOF;
    property BOF: WordBool read Get_BOF;
  end;

// *********************************************************************//
// DispIntf:  IQueryServerDisp
// Flags:     (4416) Dual OleAutomation Dispatchable
// GUID:      {B7D4ED81-27C2-11D3-9703-0000861F6726}
// *********************************************************************//
  IQueryServerDisp = dispinterface
    ['{B7D4ED81-27C2-11D3-9703-0000861F6726}']
    function  Login(const Db: WideString; const User: WideString;
      const Password: WideString): WordBool; dispid 1;
    property SQL: WideString dispid 2;
    procedure Next; dispid 3;
    procedure Prev; dispid 4;
    procedure First; dispid 5;
    procedure Last; dispid 6;
    property FieldCount: Integer readonly dispid 7;
    function  Data: OleVariant; dispid 8;
    property EOF: WordBool readonly dispid 9;
    property BOF: WordBool readonly dispid 11;
    function  Execute: WordBool; dispid 12;
  end;

  TQueryServerStub = class(TCorbaDispatchStub, IQueryServer)
  public
    function Login(const Db: WideString; const User: WideString;
      const Password: WideString): WordBool; safecall;
    function Get_SQL: WideString; safecall;
    procedure Set_SQL(const Value: WideString); safecall;
    procedure Next; safecall;
    procedure Prev; safecall;
    procedure First; safecall;
    procedure Last; safecall;
    function Get_FieldCount: Integer; safecall;
    function Data: OleVariant; safecall;
    function Get_EOF: WordBool; safecall;
    function Get_BOF: WordBool; safecall;
    function Execute: WordBool; safecall;
  end;

  TQueryServerSkeleton = class(TCorbaSkeleton)
  private
    FIntf: IQueryServer;
  public
    constructor Create(const InstanceName: string; const Impl: IUnknown);
      override;
    procedure GetImplementation(out Impl: IUnknown); override; stdcall;
  published
    procedure Login(const InBuf: IMarshalInBuffer; Cookie: Pointer);
    procedure Get_SQL(const InBuf: IMarshalInBuffer; Cookie: Pointer);
    procedure Set_SQL(const InBuf: IMarshalInBuffer; Cookie: Pointer);
    procedure Next(const InBuf: IMarshalInBuffer; Cookie: Pointer);
    procedure Prev(const InBuf: IMarshalInBuffer; Cookie: Pointer);
    procedure First(const InBuf: IMarshalInBuffer; Cookie: Pointer);
    procedure Last(const InBuf: IMarshalInBuffer; Cookie: Pointer);
    procedure Get_FieldCount(const InBuf: IMarshalInBuffer; Cookie: Pointer);
    procedure Data(const InBuf: IMarshalInBuffer; Cookie: Pointer);
    procedure Get_EOF(const InBuf: IMarshalInBuffer; Cookie: Pointer);
    procedure Get_BOF(const InBuf: IMarshalInBuffer; Cookie: Pointer);
    procedure Execute(const InBuf: IMarshalInBuffer; Cookie: Pointer);
  end;

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

  TQueryServerCorbaFactory = class
    class function CreateInstance(const InstanceName: string): IQueryServer;
  end;

implementation

uses ComObj;

{ TQueryServerStub }

function TQueryServerStub.Login(const Db: WideString; const User: WideString; 
                                const Password: WideString): WordBool;
var
  OutBuf: IMarshalOutBuffer;
  InBuf: IMarshalInBuffer;
begin
  FStub.CreateRequest('Login', True, OutBuf);
  OutBuf.PutWideText(PWideChar(Pointer(Db)));
  OutBuf.PutWideText(PWideChar(Pointer(User)));
  OutBuf.PutWideText(PWideChar(Pointer(Password)));
  FStub.Invoke(OutBuf, InBuf);
  Result := UnmarshalWordBool(InBuf);
end;

function TQueryServerStub.Get_SQL: WideString;
var
  OutBuf: IMarshalOutBuffer;
  InBuf: IMarshalInBuffer;
begin
  FStub.CreateRequest('Get_SQL', True, OutBuf);
  FStub.Invoke(OutBuf, InBuf);
  Result := UnmarshalWideText(InBuf);
end;

procedure TQueryServerStub.Set_SQL(const Value: WideString);
var
  OutBuf: IMarshalOutBuffer;
  InBuf: IMarshalInBuffer;
begin
  FStub.CreateRequest('Set_SQL', True, OutBuf);
  OutBuf.PutWideText(PWideChar(Pointer(Value)));
  FStub.Invoke(OutBuf, InBuf);
end;

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

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

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

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

function TQueryServerStub.Get_FieldCount: Integer;
var
  OutBuf: IMarshalOutBuffer;
  InBuf: IMarshalInBuffer;
begin
  FStub.CreateRequest('Get_FieldCount', True, OutBuf);
  FStub.Invoke(OutBuf, InBuf);
  Result := InBuf.GetLong;
end;

function TQueryServerStub.Data: OleVariant;
var
  OutBuf: IMarshalOutBuffer;
  InBuf: IMarshalInBuffer;
begin
  FStub.CreateRequest('Data', True, OutBuf);
  FStub.Invoke(OutBuf, InBuf);
  Result := UnmarshalAny(InBuf);
end;

function TQueryServerStub.Get_EOF: WordBool;
var
  OutBuf: IMarshalOutBuffer;
  InBuf: IMarshalInBuffer;
begin
  FStub.CreateRequest('Get_EOF', True, OutBuf);
  FStub.Invoke(OutBuf, InBuf);
  Result := UnmarshalWordBool(InBuf);
end;

function TQueryServerStub.Get_BOF: WordBool;
var
  OutBuf: IMarshalOutBuffer;
  InBuf: IMarshalInBuffer;
begin
  FStub.CreateRequest('Get_BOF', True, OutBuf);
  FStub.Invoke(OutBuf, InBuf);
  Result := UnmarshalWordBool(InBuf);
end;

function TQueryServerStub.Execute: WordBool;
var
  OutBuf: IMarshalOutBuffer;
  InBuf: IMarshalInBuffer;
begin
  FStub.CreateRequest('Execute', True, OutBuf);
  FStub.Invoke(OutBuf, InBuf);
  Result := UnmarshalWordBool(InBuf);
end;

{ TQueryServerSkeleton }

constructor TQueryServerSkeleton.Create(const InstanceName: string;
  const Impl: IUnknown);
begin
  inherited;
  inherited InitSkeleton('QueryServer', InstanceName,
    'IDL:SimpleCorbaServer/IQueryServer:1.0', tmMultiThreaded, True);
  FIntf := Impl as IQueryServer;
end;

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

procedure TQueryServerSkeleton.Login(const InBuf: IMarshalInBuffer;
  Cookie: Pointer);
var
  OutBuf: IMarshalOutBuffer;
  Retval: WordBool;
  Db: WideString;
  User: WideString;
  Password: WideString;
begin
  Db := UnmarshalWideText(InBuf);
  User := UnmarshalWideText(InBuf);
  Password := UnmarshalWideText(InBuf);
  Retval := FIntf.Login(Db, User, Password);
  FSkeleton.GetReplyBuffer(Cookie, OutBuf);
  MarshalWordBool(OutBuf, Retval);
end;

procedure TQueryServerSkeleton.Get_SQL(const InBuf: IMarshalInBuffer;
  Cookie: Pointer);
var
  OutBuf: IMarshalOutBuffer;
  Retval: WideString;
begin
  Retval := FIntf.Get_SQL;
  FSkeleton.GetReplyBuffer(Cookie, OutBuf);
  OutBuf.PutWideText(PWideChar(Pointer(Retval)));
end;

procedure TQueryServerSkeleton.Set_SQL(const InBuf: IMarshalInBuffer;
  Cookie: Pointer);
var
  OutBuf: IMarshalOutBuffer;
  Value: WideString;
begin
  Value := UnmarshalWideText(InBuf);
  FIntf.Set_SQL(Value);
  FSkeleton.GetReplyBuffer(Cookie, OutBuf);
end;

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

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

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

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

procedure TQueryServerSkeleton.Get_FieldCount(const InBuf: IMarshalInBuffer;
  Cookie: Pointer);
var
  OutBuf: IMarshalOutBuffer;
  Retval: Integer;
begin
  Retval := FIntf.Get_FieldCount;
  FSkeleton.GetReplyBuffer(Cookie, OutBuf);
  OutBuf.PutLong(Retval);
end;

procedure TQueryServerSkeleton.Data(const InBuf: IMarshalInBuffer;
  Cookie: Pointer);
var
  OutBuf: IMarshalOutBuffer;
  Retval: OleVariant;
begin
  Retval := FIntf.Data;
  FSkeleton.GetReplyBuffer(Cookie, OutBuf);
  MarshalAny(OutBuf, Retval);
end;

procedure TQueryServerSkeleton.Get_EOF(const InBuf: IMarshalInBuffer;
  Cookie: Pointer);
var
  OutBuf: IMarshalOutBuffer;
  Retval: WordBool;
begin
  Retval := FIntf.Get_EOF;
  FSkeleton.GetReplyBuffer(Cookie, OutBuf);
  MarshalWordBool(OutBuf, Retval);
end;

procedure TQueryServerSkeleton.Get_BOF(const InBuf: IMarshalInBuffer;
  Cookie: Pointer);
var
  OutBuf: IMarshalOutBuffer;
  Retval: WordBool;
begin
  Retval := FIntf.Get_BOF;
  FSkeleton.GetReplyBuffer(Cookie, OutBuf);
  MarshalWordBool(OutBuf, Retval);
end;

procedure TQueryServerSkeleton.Execute(const InBuf: IMarshalInBuffer;
  Cookie: Pointer);
var
  OutBuf: IMarshalOutBuffer;
  Retval: WordBool;
begin
  Retval := FIntf.Execute;
  FSkeleton.GetReplyBuffer(Cookie, OutBuf);
  MarshalWordBool(OutBuf, Retval);
end;

class function CoQueryServer.Create: IQueryServer;
begin
  Result := CreateComObject(CLASS_QueryServer) as IQueryServer;
end;

class function CoQueryServer.CreateRemote(const MachineName: string):
  IQueryServer;
begin
  Result := CreateRemoteComObject(MachineName, CLASS_QueryServer) as
    IQueryServer;
end;

class function TQueryServerCorbaFactory.CreateInstance(
  const InstanceName: string): IQueryServer;
begin
  Result := CorbaFactoryCreateStub(
    'IDL:SimpleCorbaServer/QueryServerFactory:1.0', 'QueryServer',
    InstanceName, '', IQueryServer) as IQueryServer;
end;

initialization
  CorbaStubManager.RegisterStub(IQueryServer, TQueryServerStub);
  CorbaInterfaceIDManager.RegisterInterface(IQueryServer,
    'IDL:SimpleCorbaServer/IQueryServer:1.0');
  CorbaSkeletonManager.RegisterSkeleton(IQueryServer, TQueryServerSkeleton);

end.