Watch, Follow, &
Connect with Us

For forums, blogs and more please visit our
Developer Tools Community.


Welcome, Guest
Guest Settings
Help

Thread: Hooking up events in console application


This question is not answered. Helpful answers available: 2. Correct answers available: 1.


Permlink Replies: 0
Fred Smith

Posts: 81
Registered: 12/4/15
Hooking up events in console application  
Click to report abuse...   Click to reply to this thread Reply
  Posted: Feb 16, 2017 10:36 AM
Hi,
I've generated the Sonic_TLB unit using tlibimp but not sure how to hook up the events in a console application:

This gives me an error:
program MyProject;
 
{$APPTYPE CONSOLE}
 
{$R *.res}
 
uses
  System.SysUtils,
  System.SyncObjs,
  Winapi.ActiveX,
  System.Classes,
  Sonic_TLB in 'Sonic_TLB.pas';
 
 
var
  Obj: TSystème;
 
 
procedure StartLibraryCallBack(Sender: TObject);
begin
  Writeln('StartLibraryCallBack triggered!');
end;
 
procedure RegisterHostCallBack(Sender: TObject);
begin
  Writeln('RegisterHostCallBack triggered!');
end;
 
 
 
 
begin
  try
    { TODO -oUser -cConsole Main : Insert code here }
    try
      obj := TSystème.Create(nil);
      obj.OnStartLibraryCallBack := StartLibraryCallBack;// How to hook up events in console mode
                                                                                        // Here I get 'method pointer and regular procedure' error
 
      Obj.OnRegisterHostCallBack := RegisterHostCallBack;
     
 
      obj.StartLibrary(param1, param2, param3, param4);
      obj.RegisterHost(param1, param2, param3, param4);
    finally
      FreeAndNil(Obj);
    end;
 
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
end.


If I put my StartLibraryCallBack in a class then assign it this way:
  obj.OnStartLibraryCallBack := StartLibraryCallBack

I don't get an error and everything works fine but still not sure if that's correct.

Thanks.

unit Sonic_TLB;
 
interface
 
uses Winapi.Windows, System.Classes, System.Variants, System.Win.StdVCL, Vcl.Graphics, Vcl.OleServer, Winapi.ActiveX;
  
type
 
// *********************************************************************//
// Forward declaration of types defined in TypeLibrary                    
// *********************************************************************//
  ProgData = interface;
  ProgDataDisp = dispinterface;
  comResponse = dispinterface;
  comBiblio = interface;
  comBiblioDisp = dispinterface;
 
// *********************************************************************//
// Declaration of CoClasses defined in Type Library                       
// (NOTE: Here we map each CoClass to its Default Interface)              
// *********************************************************************//
  Système = comBiblio;
 
 
// *********************************************************************//
// Declaration of structures, unions and aliases.                         
// *********************************************************************//
  POleVariant1 = ^OleVariant; {*}
  PWideString1 = ^WideString; {*}
 
 
  ProgData = interface(IDispatch)
    ['{B58A6A71-8508-408C-B304-E15377EF0296}']
    function FunctionOne: Integer; safecall;
    function FunctionTwo(param1: Integer): WideString; safecall;
  end;
 
 
  ProgDataDisp = dispinterface
    ['{B58A6A71-8508-408C-B304-E15377EF0296}']
    function FunctionOne: Integer; dispid 1;
    function FunctionTwo(param1: Integer): WideString; dispid 2;
  end;
 
 
// *********************************************************************//
// DispIntf:  comResponse
// Flags:     (4112) Hidden Dispatchable
// GUID:      {BF3FC3D0-115A-4F60-8FFA-503B9C049A77}
// *********************************************************************//
  comResponse = dispinterface
    ['{BF3FC3D0-115A-4F60-8FFA-503B9C049A77}']    
    procedure StartLibraryCallBack; dispid 1;    
    procedure RegisterHostCallBack(const param1: ProgData; param2: SYSINT; param3: SYSINT; 
                            param4: SYSINT; const param5: WideString); dispid 2;    
  end;
 
// *********************************************************************//
// Interface: comBiblio
// Flags:     (4560) Hidden Dual NonExtensible OleAutomation Dispatchable
// GUID:      {8535EA7E-86FF-40DA-8D6E-DB3A087C4C66}
// *********************************************************************//
  comBiblio = interface(IDispatch)
    ['{8535EA7E-86FF-40DA-8D6E-DB3A087C4C66}']
    function StartLibrary(param1: Integer; const param2: WideString; 
                         const param3: WideString; param4: Integer): Integer; safecall;   
    function RegisterHost(const param1: WideString; const param2: WideString; 
                         const param3: WideString; const param4: WideString): Integer; safecall;    
  end;
 
// *********************************************************************//
// DispIntf:  comBiblioDisp
// Flags:     (4560) Hidden Dual NonExtensible OleAutomation Dispatchable
// GUID:      {8535EA7E-86FF-40DA-8D6E-DB3A087C4C66}
// *********************************************************************//
  comBiblioDisp = dispinterface
    ['{8535EA7E-86FF-40DA-8D6E-DB3A087C4C66}']
    function StartLibrary(param1: Integer; const param2: WideString; 
                         const param3: WideString; param4: Integer): Integer; dispid 1;
    
    function RegisterHost(const param1: WideString; const param2: WideString; 
                         const param3: WideString; const param4: WideString): Integer; dispid 3;
  end;
 
// *********************************************************************//
// The Class CoSysteme provides a Create and CreateRemote method to          
// create instances of the default interface comBiblio exSystèmeed by              
// the CoClass Système. The functions are intended to be used by             
// clients wishing to automate the CoClass objects exSystèmeed by the         
// server of this typelibrary.                                            
// *********************************************************************//
  CoSysteme = class
    class function Create: comBiblio;
    class function CreateRemote(const MachineName: string): comBiblio;
  end;
 
  TSystèmeRegisterHostCallBack = procedure(ASender: TObject; const param1: ProgData; param2: SYSINT; 
                                                  param3: SYSINT; param4: SYSINT; 
                                                  const param5: WideString) of object;
  
 
// *********************************************************************//
// OLE Server Proxy class declaration
// Server Object    : TSystème
// Help String      : Sonic Système COM root object
// Default Interface: comBiblio
// Def. Intf. DISP? : No
// Event   Interface: comResponse
// TypeFlags        : (3) AppObject CanCreate
// *********************************************************************//
  TSystème = class(TOleServer)
  private
    FOnStartLibraryCallBack: TNotifyEvent;    
    FOnRegisterHostCallBack: TSystèmeRegisterHostCallBack;
    FIntf: comBiblio;
    function GetDefaultInterface: comBiblio;
  protected
    procedure InitServerData; override;
    procedure InvokeEvent(DispID: TDispID; var Params: TVariantArray); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
    procedure Connect; override;
    procedure ConnectTo(svrIntf: comBiblio);
    procedure Disconnect; override;
    function StartLibrary(param1: Integer; const param2: WideString; 
                         const param3: WideString; param4: Integer): Integer;
    
    function RegisterHost(const param1: WideString; const param2: WideString; 
                         const param3: WideString; const param4: WideString): Integer;
    
    property DefaultInterface: comBiblio read GetDefaultInterface;
  published
    property OnStartLibraryCallBack: TNotifyEvent read FOnStartLibraryCallBack write FOnStartLibraryCallBack;    
    property OnRegisterHostCallBack: TSystèmeRegisterHostCallBack read FOnRegisterHostCallBack write FOnRegisterHostCallBack;    
  end;
 
procedure Register;
 
resourcestring
  dtlServerPage = 'Servers';
 
  dtlOcxPage = 'ActiveX';
 
implementation
 
uses System.Win.ComObj;
 
class function CoSysteme.Create: comBiblio;
begin
  Result := CreateComObject(CLASS_Systeme) as comBiblio;
end;
 
class function CoSysteme.CreateRemote(const MachineName: string): comBiblio;
begin
  Result := CreateRemoteComObject(MachineName, CLASS_Systeme) as comBiblio;
end;
 
procedure TSystème.InitServerData;
const
  CServerData: TServerData = (
    ClassID:   '{6350F900-F2FD-4540-B6F2-79DABC4D9C28}';
    IntfIID:   '{8535EA7E-86FF-40DA-8D6E-DB3A087C4C66}';
    EventIID:  '{BF3FC3D0-115A-4F60-8FFA-503B9C049A77}';
    LicenseKey: nil;
    Version: 500);
begin
  ServerData := @CServerData;
end;
 
procedure TSystème.Connect;
var
  punk: IUnknown;
begin
  if FIntf = nil then
  begin
    punk := GetServer;
    ConnectEvents(punk);
    Fintf:= punk as comBiblio;
  end;
end;
 
procedure TSystème.ConnectTo(svrIntf: comBiblio);
begin
  Disconnect;
  FIntf := svrIntf;
  ConnectEvents(FIntf);
end;
 
procedure TSystème.DisConnect;
begin
  if Fintf <> nil then
  begin
    DisconnectEvents(FIntf);
    FIntf := nil;
  end;
end;
 
function TSystème.GetDefaultInterface: comBiblio;
begin
  if FIntf = nil then
    Connect;
  Assert(FIntf <> nil, 'Component is not connected to Server.');
  Result := FIntf;
end;
 
constructor TSystème.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
end;
 
destructor TSystème.Destroy;
begin
  inherited Destroy;
end;
 
procedure TSystème.InvokeEvent(DispID: TDispID; var Params: TVariantArray);
begin
  case DispID of
    -1: Exit;  // DISPID_UNKNOWN
 
    1: if Assigned(FOnStartLibraryCallBack) then
         FOnStartLibraryCallBack(Self);
    
    2: if Assigned(FOnRegisterHostCallBack) then
         FOnRegisterHostCallBack(Self,
                          IUnknown(TVarData(Params[0]).VPointer) as ProgData {const ProgData},
                          Params[1] {SYSINT},
                          Params[2] {SYSINT},
                          Params[3] {SYSINT},
                          Params[4] {const WideString});
  end; {case DispID}
end;
 
function TSystème.StartLibrary(param1: Integer; const param2: WideString; 
                          const param3: WideString; param4: Integer): Integer;
begin
  Result := DefaultInterface.StartLibrary(param1, param2, param3, param4);
end;
 
function TSystème.RegisterHost(const param1: WideString; const param2: WideString; 
                          const param3: WideString; const param4: WideString): Integer;
begin
  Result := DefaultInterface.RegisterHost(param1, param2, param3, param4);
end;
 
 
procedure Register;
begin
  RegisterComponents(dtlServerPage, [TSystème]);
end;
 
end.
Legend
Helpful Answer (5 pts)
Correct Answer (10 pts)

Server Response from: ETNAJIVE02