L
LeonSu
Unregistered / Unconfirmed
GUEST, unregistred user!
我的连接代码：
var
MySession1: ISession;
MySessions: ISessions;
H1: SmallInt;
begin
MySessions:=CoSessions.Create;
MySession1:=CoSession.Create;
ShowMessage(Format('TotalSession = %d',[MySessions.GetTotalSessionNumber]));
//执行到这里都没有任何错
ShowMessage(Format('ActiveSession = %d',[MySession1.GetCurrentSessionID]));
//执行到这条语句时，就会提示：服务器出现意外情况
//我该怎么办？如何使用ISession这个接口？
end;
接口的源代码：
unit Eterm3Lib_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.130.1.0.1.0.1.6 $
// File generated on 2006-8-12 17:08:18 from Type Library described below.
// ************************************************************************ //
// Type Lib: D:/Tools/eTerm3/eTerm3.tlb (1)
// LIBID: {3B06E499-1473-47ED-85A5-2CE4EE45A6DF}
// LCID: 0
// Helpfile:
// DepndLst:
// (1) v2.0 stdole, (C:/WINDOWS/system32/stdole2.tlb)
// (2) v4.0 StdVCL, (C:/WINDOWS/system32/stdvcl40.dll)
// ************************************************************************ //
// *************************************************************************//
// NOTE:
// Items guarded by $IFDEF_LIVE_SERVER_AT_DESIGN_TIME are used by properties
// which return objects that may need to be explicitly created via a function
// call prior to any access via the property. These items have been disabled
// in order to prevent accidental use from within the object inspector. You
// may enable them by defining LIVE_SERVER_AT_DESIGN_TIME or by selectively
// removing them from the $IFDEF blocks. However, such items must still be
// programmatically created via a method of the appropriate CoClass before
// they can be used.
{$TYPEDADDRESS OFF} // Unit must be compiled without type-checked pointers.
{$WARN SYMBOL_PLATFORM OFF}
{$WRITEABLECONST ON}
{$VARPROPSETTER ON}
interface
uses Windows, ActiveX, Classes, Graphics, OleServer, StdVCL, Variants;
// *********************************************************************//
// 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
Eterm3LibMajorVersion = 1;
Eterm3LibMinorVersion = 0;
LIBID_Eterm3Lib: TGUID = '{3B06E499-1473-47ED-85A5-2CE4EE45A6DF}';
DIID__IApplicationEvents: TGUID = '{3C31BF76-2837-4BFA-A19E-34485A213F29}';
DIID__ISessionEvents: TGUID = '{4ADE78EF-390A-4FF8-B788-C47E30331B6D}';
IID_ISession: TGUID = '{2F4B1CA9-0DF8-4EC8-92DF-71BACE1DE0AA}';
CLASS_Session: TGUID = '{EC2C9F4C-CFB4-4096-AFC0-1531FC603606}';
IID_ISessions: TGUID = '{74423526-1E08-4A97-BC85-2D5FCC22CDBE}';
CLASS_Sessions: TGUID = '{FE104F26-4219-4DE0-87B9-8FF12A2A56B1}';
IID_IApplication: TGUID = '{98AA9DD3-0715-4170-8A96-04F06C8BAD49}';
CLASS_Application: TGUID = '{C5E9A707-5D62-4C96-A1B0-3DA8B719AA0D}';
type
// *********************************************************************//
// Forward declaration of types defined in TypeLibrary
// *********************************************************************//
_IApplicationEvents = dispinterface;
_ISessionEvents = dispinterface;
ISession = interface;
ISessionDisp = dispinterface;
ISessions = interface;
ISessionsDisp = dispinterface;
IApplication = interface;
IApplicationDisp = dispinterface;
// *********************************************************************//
// Declaration of CoClasses defined in Type Library
// (NOTE: Here we map each CoClass to its Default Interface)
// *********************************************************************//
Session = ISession;
Sessions = ISessions;
Application = IApplication;
// *********************************************************************//
// Declaration of structures, unions and aliases.
// *********************************************************************//
POleVariant1 = ^OleVariant; {*}
// *********************************************************************//
// DispIntf: _IApplicationEvents
// Flags: (4096) Dispatchable
// GUID: {3C31BF76-2837-4BFA-A19E-34485A213F29}
// *********************************************************************//
_IApplicationEvents = dispinterface
['{3C31BF76-2837-4BFA-A19E-34485A213F29}']
procedure ReceiveCurConf(var Conf: OleVariant); dispid 1;
procedure StatusChange(Status: Integer; const bstrDetail: WideString); dispid 2;
end;
// *********************************************************************//
// DispIntf: _ISessionEvents
// Flags: (4096) Dispatchable
// GUID: {4ADE78EF-390A-4FF8-B788-C47E30331B6D}
// *********************************************************************//
_ISessionEvents = dispinterface
['{4ADE78EF-390A-4FF8-B788-C47E30331B6D}']
procedure CPReceive(H1: Smallint; H2: Smallint; shReceiveType: Smallint; X: Smallint;
Y: Smallint; const bstrReceived: WideString); dispid 1;
end;
// *********************************************************************//
// Interface: ISession
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {2F4B1CA9-0DF8-4EC8-92DF-71BACE1DE0AA}
// *********************************************************************//
ISession = interface(IDispatch)
['{2F4B1CA9-0DF8-4EC8-92DF-71BACE1DE0AA}']
procedure InputStr(shH1: Smallint; shH2: Smallint; shSID: Smallint; const bstrCmd: WideString); safecall;
procedure SendStrNow(shH1: Smallint; shH2: Smallint; shSID: Smallint; const bstrCmd: WideString); safecall;
procedure SendCmd(shH1: Smallint; shH2: Smallint; shSID: Smallint; X: Smallint; Y: Smallint;
shKey: Smallint); safecall;
procedure PrintData(PrinterType: Integer; const PrinterInfo: WideString); safecall;
function GetLockStatus: Smallint; safecall;
procedure GetH1(out H1: Smallint); safecall;
procedure GetH2(out H2: Smallint); safecall;
procedure GetRID(out RID: Smallint); safecall;
procedure GetSID(out SID: Smallint); safecall;
procedure FullScreenString(Data: OleVariant); safecall;
function GetCurrentSessionID: Integer; safecall;
procedure Lock; safecall;
procedure Unlock; safecall;
function IsLock: Integer; safecall;
end;
// *********************************************************************//
// DispIntf: ISessionDisp
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {2F4B1CA9-0DF8-4EC8-92DF-71BACE1DE0AA}
// *********************************************************************//
ISessionDisp = dispinterface
['{2F4B1CA9-0DF8-4EC8-92DF-71BACE1DE0AA}']
procedure InputStr(shH1: Smallint; shH2: Smallint; shSID: Smallint; const bstrCmd: WideString); dispid 1;
procedure SendStrNow(shH1: Smallint; shH2: Smallint; shSID: Smallint; const bstrCmd: WideString); dispid 2;
procedure SendCmd(shH1: Smallint; shH2: Smallint; shSID: Smallint; X: Smallint; Y: Smallint;
shKey: Smallint); dispid 3;
procedure PrintData(PrinterType: Integer; const PrinterInfo: WideString); dispid 4;
function GetLockStatus: Smallint; dispid 5;
procedure GetH1(out H1: Smallint); dispid 6;
procedure GetH2(out H2: Smallint); dispid 7;
procedure GetRID(out RID: Smallint); dispid 8;
procedure GetSID(out SID: Smallint); dispid 9;
procedure FullScreenString(Data: OleVariant); dispid 10;
function GetCurrentSessionID: Integer; dispid 11;
procedure Lock; dispid 12;
procedure Unlock; dispid 13;
function IsLock: Integer; dispid 14;
end;
// *********************************************************************//
// Interface: ISessions
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {74423526-1E08-4A97-BC85-2D5FCC22CDBE}
// *********************************************************************//
ISessions = interface(IDispatch)
['{74423526-1E08-4A97-BC85-2D5FCC22CDBE}']
function Count: Integer; safecall;
function Item(index: OleVariant): IDispatch; safecall;
function GetTotalSessionNumber: Integer; safecall;
function GetActiveSession: Integer; safecall;
function Get__NewEnum: IUnknown; safecall;
property _NewEnum: IUnknown read Get__NewEnum;
end;
// *********************************************************************//
// DispIntf: ISessionsDisp
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {74423526-1E08-4A97-BC85-2D5FCC22CDBE}
// *********************************************************************//
ISessionsDisp = dispinterface
['{74423526-1E08-4A97-BC85-2D5FCC22CDBE}']
function Count: Integer; dispid 1;
function Item(index: OleVariant): IDispatch; dispid 2;
function GetTotalSessionNumber: Integer; dispid 3;
function GetActiveSession: Integer; dispid 4;
property _NewEnum: IUnknown readonly dispid -4;
end;
// *********************************************************************//
// Interface: IApplication
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {98AA9DD3-0715-4170-8A96-04F06C8BAD49}
// *********************************************************************//
IApplication = interface(IDispatch)
['{98AA9DD3-0715-4170-8A96-04F06C8BAD49}']
procedure Connect(shType: Smallint; const bstrServerIP: WideString; const bstrUser: WideString;
const bstrPass: WideString); safecall;
procedure DisConnect; safecall;
function IsConnect: Smallint; safecall;
function GetSessions: IDispatch; safecall;
procedure Exit; safecall;
procedure ShowServer; safecall;
function GetCurrentAccount: WideString; safecall;
function GetCurrentHost: WideString; safecall;
end;
// *********************************************************************//
// DispIntf: IApplicationDisp
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {98AA9DD3-0715-4170-8A96-04F06C8BAD49}
// *********************************************************************//
IApplicationDisp = dispinterface
['{98AA9DD3-0715-4170-8A96-04F06C8BAD49}']
procedure Connect(shType: Smallint; const bstrServerIP: WideString; const bstrUser: WideString;
const bstrPass: WideString); dispid 1;
procedure DisConnect; dispid 2;
function IsConnect: Smallint; dispid 3;
function GetSessions: IDispatch; dispid 4;
procedure Exit; dispid 5;
procedure ShowServer; dispid 6;
function GetCurrentAccount: WideString; dispid 7;
function GetCurrentHost: WideString; dispid 8;
end;
// *********************************************************************//
// The Class CoSession provides a Create and CreateRemote method to
// create instances of the default interface ISession exposed by
// the CoClass Session. The functions are intended to be used by
// clients wishing to automate the CoClass objects exposed by the
// server of this typelibrary.
// *********************************************************************//
CoSession = class
class function Create: ISession;
class function CreateRemote(const MachineName: string): ISession;
end;
TSessionCPReceive = procedure(Sender: TObject; H1: Smallint; H2: Smallint;
shReceiveType: Smallint; X: Smallint; Y: Smallint;
var bstrReceived: OleVariant) of object;
// *********************************************************************//
// OLE Server Proxy class declaration
// Server Object : TESession
// Help String : Session Class
// Default Interface: ISession
// Def. Intf. DISP? : No
// Event Interface: _ISessionEvents
// TypeFlags : (2) CanCreate
// *********************************************************************//
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
TSessionProperties= class;
{$ENDIF}
TESession = class(TOleServer)
private
FOnCPReceive: TSessionCPReceive;
FIntf: ISession;
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
FProps: TSessionProperties;
function GetServerProperties: TSessionProperties;
{$ENDIF}
function GetDefaultInterface: ISession;
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: ISession);
procedure Disconnect; override;
procedure InputStr(shH1: Smallint; shH2: Smallint; shSID: Smallint; const bstrCmd: WideString);
procedure SendStrNow(shH1: Smallint; shH2: Smallint; shSID: Smallint; const bstrCmd: WideString);
procedure SendCmd(shH1: Smallint; shH2: Smallint; shSID: Smallint; X: Smallint; Y: Smallint;
shKey: Smallint);
procedure PrintData(PrinterType: Integer; const PrinterInfo: WideString);
function GetLockStatus: Smallint;
procedure GetH1(out H1: Smallint);
procedure GetH2(out H2: Smallint);
procedure GetRID(out RID: Smallint);
procedure GetSID(out SID: Smallint);
procedure FullScreenString(Data: OleVariant);
function GetCurrentSessionID: Integer;
procedure Lock;
procedure Unlock;
function IsLock: Integer;
property DefaultInterface: ISession read GetDefaultInterface;
published
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
property Server: TSessionProperties read GetServerProperties;
{$ENDIF}
property OnCPReceive: TSessionCPReceive read FOnCPReceive write FOnCPReceive;
end;
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
// *********************************************************************//
// OLE Server Properties Proxy Class
// Server Object : TESession
// (This object is used by the IDE's Property Inspector to allow editing
// of the properties of this server)
// *********************************************************************//
TSessionProperties = class(TPersistent)
private
FServer: TESession;
function GetDefaultInterface: ISession;
constructor Create(AServer: TESession);
protected
public
property DefaultInterface: ISession read GetDefaultInterface;
published
end;
{$ENDIF}
// *********************************************************************//
// The Class CoSessions provides a Create and CreateRemote method to
// create instances of the default interface ISessions exposed by
// the CoClass Sessions. The functions are intended to be used by
// clients wishing to automate the CoClass objects exposed by the
// server of this typelibrary.
// *********************************************************************//
CoSessions = class
class function Create: ISessions;
class function CreateRemote(const MachineName: string): ISessions;
end;
// *********************************************************************//
// OLE Server Proxy class declaration
// Server Object : TSessions
// Help String : Sessions Class
// Default Interface: ISessions
// Def. Intf. DISP? : No
// Event Interface:
// TypeFlags : (2) CanCreate
// *********************************************************************//
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
TSessionsProperties= class;
{$ENDIF}
TSessions = class(TOleServer)
private
FIntf: ISessions;
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
FProps: TSessionsProperties;
function GetServerProperties: TSessionsProperties;
{$ENDIF}
function GetDefaultInterface: ISessions;
protected
procedure InitServerData; override;
function Get__NewEnum: IUnknown;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Connect; override;
procedure ConnectTo(svrIntf: ISessions);
procedure Disconnect; override;
function Count: Integer;
function Item(index: OleVariant): IDispatch;
function GetTotalSessionNumber: Integer;
function GetActiveSession: Integer;
property DefaultInterface: ISessions read GetDefaultInterface;
property _NewEnum: IUnknown read Get__NewEnum;
published
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
property Server: TSessionsProperties read GetServerProperties;
{$ENDIF}
end;
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
// *********************************************************************//
// OLE Server Properties Proxy Class
// Server Object : TSessions
// (This object is used by the IDE's Property Inspector to allow editing
// of the properties of this server)
// *********************************************************************//
TSessionsProperties = class(TPersistent)
private
FServer: TSessions;
function GetDefaultInterface: ISessions;
constructor Create(AServer: TSessions);
protected
function Get__NewEnum: IUnknown;
public
property DefaultInterface: ISessions read GetDefaultInterface;
published
end;
{$ENDIF}
// *********************************************************************//
// The Class CoApplication provides a Create and CreateRemote method to
// create instances of the default interface IApplication exposed by
// the CoClass Application. The functions are intended to be used by
// clients wishing to automate the CoClass objects exposed by the
// server of this typelibrary.
// *********************************************************************//
CoApplication = class
class function Create: IApplication;
class function CreateRemote(const MachineName: string): IApplication;
end;
TApplicationReceiveCurConf = procedure(Sender: TObject; var Conf: OleVariant) of object;
TApplicationStatusChange = procedure(Sender: TObject; Status: Integer; var bstrDetail: OleVariant) of object;
// *********************************************************************//
// OLE Server Proxy class declaration
// Server Object : TApplication
// Help String : Application Class
// Default Interface: IApplication
// Def. Intf. DISP? : No
// Event Interface: _IApplicationEvents
// TypeFlags : (2) CanCreate
// *********************************************************************//
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
TApplicationProperties= class;
{$ENDIF}
TApplication = class(TOleServer)
private
FOnReceiveCurConf: TApplicationReceiveCurConf;
FOnStatusChange: TApplicationStatusChange;
FIntf: IApplication;
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
FProps: TApplicationProperties;
function GetServerProperties: TApplicationProperties;
{$ENDIF}
function GetDefaultInterface: IApplication;
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: IApplication);
procedure Disconnect; override;
procedure Connect1(shType: Smallint; const bstrServerIP: WideString;
const bstrUser: WideString; const bstrPass: WideString);
procedure DisConnect1;
function IsConnect: Smallint;
function GetSessions: IDispatch;
procedure Exit;
procedure ShowServer;
function GetCurrentAccount: WideString;
function GetCurrentHost: WideString;
property DefaultInterface: IApplication read GetDefaultInterface;
published
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
property Server: TApplicationProperties read GetServerProperties;
{$ENDIF}
property OnReceiveCurConf: TApplicationReceiveCurConf read FOnReceiveCurConf write FOnReceiveCurConf;
property OnStatusChange: TApplicationStatusChange read FOnStatusChange write FOnStatusChange;
end;
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
// *********************************************************************//
// OLE Server Properties Proxy Class
// Server Object : TApplication
// (This object is used by the IDE's Property Inspector to allow editing
// of the properties of this server)
// *********************************************************************//
TApplicationProperties = class(TPersistent)
private
FServer: TApplication;
function GetDefaultInterface: IApplication;
constructor Create(AServer: TApplication);
protected
public
property DefaultInterface: IApplication read GetDefaultInterface;
published
end;
{$ENDIF}
procedure Register;
resourcestring
dtlServerPage = 'ActiveX';
implementation
uses ComObj;
class function CoSession.Create: ISession;
begin
Result := CreateComObject(CLASS_Session) as ISession;
end;
class function CoSession.CreateRemote(const MachineName: string): ISession;
begin
Result := CreateRemoteComObject(MachineName, CLASS_Session) as ISession;
end;
procedure TESession.InitServerData;
const
CServerData: TServerData = (
ClassID: '{EC2C9F4C-CFB4-4096-AFC0-1531FC603606}';
IntfIID: '{2F4B1CA9-0DF8-4EC8-92DF-71BACE1DE0AA}';
EventIID: '{4ADE78EF-390A-4FF8-B788-C47E30331B6D}';
LicenseKey: nil;
Version: 500);
begin
ServerData := @CServerData;
end;
procedure TESession.Connect;
var
punk: IUnknown;
begin
if FIntf = nil then
begin
punk := GetServer;
ConnectEvents(punk);
Fintf:= punk as ISession;
end;
end;
procedure TESession.ConnectTo(svrIntf: ISession);
begin
Disconnect;
FIntf := svrIntf;
ConnectEvents(FIntf);
end;
procedure TESession.DisConnect;
begin
if Fintf <> nil then
begin
DisconnectEvents(FIntf);
FIntf := nil;
end;
end;
function TESession.GetDefaultInterface: ISession;
begin
if FIntf = nil then
Connect;
Assert(FIntf <> nil, 'DefaultInterface is NULL. Component is not connected to Server. You must call ''Connect'' or ''ConnectTo'' before this operation');
Result := FIntf;
end;
constructor TESession.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
FProps := TSessionProperties.Create(Self);
{$ENDIF}
end;
destructor TESession.Destroy;
begin
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
FProps.Free;
{$ENDIF}
inherited Destroy;
end;
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
function TESession.GetServerProperties: TSessionProperties;
begin
Result := FProps;
end;
{$ENDIF}
procedure TESession.InvokeEvent(DispID: TDispID; var Params: TVariantArray);
begin
case DispID of
-1: Exit; // DISPID_UNKNOWN
1: if Assigned(FOnCPReceive) then
FOnCPReceive(Self, Params[5] {const WideString}, Params[4] {Smallint}, Params[3] {Smallint}, Params[2] {Smallint}, Params[1] {Smallint}, Params[0] {Smallint});
end; {case DispID}
end;
procedure TESession.InputStr(shH1: Smallint; shH2: Smallint; shSID: Smallint;
const bstrCmd: WideString);
begin
DefaultInterface.InputStr(shH1, shH2, shSID, bstrCmd);
end;
procedure TESession.SendStrNow(shH1: Smallint; shH2: Smallint; shSID: Smallint;
const bstrCmd: WideString);
begin
DefaultInterface.SendStrNow(shH1, shH2, shSID, bstrCmd);
end;
procedure TESession.SendCmd(shH1: Smallint; shH2: Smallint; shSID: Smallint; X: Smallint;
Y: Smallint; shKey: Smallint);
begin
DefaultInterface.SendCmd(shH1, shH2, shSID, X, Y, shKey);
end;
procedure TESession.PrintData(PrinterType: Integer; const PrinterInfo: WideString);
begin
DefaultInterface.PrintData(PrinterType, PrinterInfo);
end;
function TESession.GetLockStatus: Smallint;
begin
Result := DefaultInterface.GetLockStatus;
end;
procedure TESession.GetH1(out H1: Smallint);
begin
DefaultInterface.GetH1(H1);
end;
procedure TESession.GetH2(out H2: Smallint);
begin
DefaultInterface.GetH2(H2);
end;
procedure TESession.GetRID(out RID: Smallint);
begin
DefaultInterface.GetRID(RID);
end;
procedure TESession.GetSID(out SID: Smallint);
begin
DefaultInterface.GetSID(SID);
end;
procedure TESession.FullScreenString(Data: OleVariant);
begin
DefaultInterface.FullScreenString(Data);
end;
function TESession.GetCurrentSessionID: Integer;
begin
Result := DefaultInterface.GetCurrentSessionID;
end;
procedure TESession.Lock;
begin
DefaultInterface.Lock;
end;
procedure TESession.Unlock;
begin
DefaultInterface.Unlock;
end;
function TESession.IsLock: Integer;
begin
Result := DefaultInterface.IsLock;
end;
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
constructor TSessionProperties.Create(AServer: TESession);
begin
inherited Create;
FServer := AServer;
end;
function TSessionProperties.GetDefaultInterface: ISession;
begin
Result := FServer.DefaultInterface;
end;
{$ENDIF}
class function CoSessions.Create: ISessions;
begin
Result := CreateComObject(CLASS_Sessions) as ISessions;
end;
class function CoSessions.CreateRemote(const MachineName: string): ISessions;
begin
Result := CreateRemoteComObject(MachineName, CLASS_Sessions) as ISessions;
end;
procedure TSessions.InitServerData;
const
CServerData: TServerData = (
ClassID: '{FE104F26-4219-4DE0-87B9-8FF12A2A56B1}';
IntfIID: '{74423526-1E08-4A97-BC85-2D5FCC22CDBE}';
EventIID: '';
LicenseKey: nil;
Version: 500);
begin
ServerData := @CServerData;
end;
procedure TSessions.Connect;
var
punk: IUnknown;
begin
if FIntf = nil then
begin
punk := GetServer;
Fintf:= punk as ISessions;
end;
end;
procedure TSessions.ConnectTo(svrIntf: ISessions);
begin
Disconnect;
FIntf := svrIntf;
end;
procedure TSessions.DisConnect;
begin
if Fintf <> nil then
begin
FIntf := nil;
end;
end;
function TSessions.GetDefaultInterface: ISessions;
begin
if FIntf = nil then
Connect;
Assert(FIntf <> nil, 'DefaultInterface is NULL. Component is not connected to Server. You must call ''Connect'' or ''ConnectTo'' before this operation');
Result := FIntf;
end;
constructor TSessions.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
FProps := TSessionsProperties.Create(Self);
{$ENDIF}
end;
destructor TSessions.Destroy;
begin
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
FProps.Free;
{$ENDIF}
inherited Destroy;
end;
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
function TSessions.GetServerProperties: TSessionsProperties;
begin
Result := FProps;
end;
{$ENDIF}
function TSessions.Get__NewEnum: IUnknown;
begin
Result := DefaultInterface._NewEnum;
end;
function TSessions.Count: Integer;
begin
Result := DefaultInterface.Count;
end;
function TSessions.Item(index: OleVariant): IDispatch;
begin
Result := DefaultInterface.Item(index);
end;
function TSessions.GetTotalSessionNumber: Integer;
begin
Result := DefaultInterface.GetTotalSessionNumber;
end;
function TSessions.GetActiveSession: Integer;
begin
Result := DefaultInterface.GetActiveSession;
end;
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
constructor TSessionsProperties.Create(AServer: TSessions);
begin
inherited Create;
FServer := AServer;
end;
function TSessionsProperties.GetDefaultInterface: ISessions;
begin
Result := FServer.DefaultInterface;
end;
function TSessionsProperties.Get__NewEnum: IUnknown;
begin
Result := DefaultInterface._NewEnum;
end;
{$ENDIF}
class function CoApplication.Create: IApplication;
begin
Result := CreateComObject(CLASS_Application) as IApplication;
end;
class function CoApplication.CreateRemote(const MachineName: string): IApplication;
begin
Result := CreateRemoteComObject(MachineName, CLASS_Application) as IApplication;
end;
procedure TApplication.InitServerData;
const
CServerData: TServerData = (
ClassID: '{C5E9A707-5D62-4C96-A1B0-3DA8B719AA0D}';
IntfIID: '{98AA9DD3-0715-4170-8A96-04F06C8BAD49}';
EventIID: '{3C31BF76-2837-4BFA-A19E-34485A213F29}';
LicenseKey: nil;
Version: 500);
begin
ServerData := @CServerData;
end;
procedure TApplication.Connect;
var
punk: IUnknown;
begin
if FIntf = nil then
begin
punk := GetServer;
ConnectEvents(punk);
Fintf:= punk as IApplication;
end;
end;
procedure TApplication.ConnectTo(svrIntf: IApplication);
begin
Disconnect;
FIntf := svrIntf;
ConnectEvents(FIntf);
end;
procedure TApplication.DisConnect;
begin
if Fintf <> nil then
begin
DisconnectEvents(FIntf);
FIntf := nil;
end;
end;
function TApplication.GetDefaultInterface: IApplication;
begin
if FIntf = nil then
Connect;
Assert(FIntf <> nil, 'DefaultInterface is NULL. Component is not connected to Server. You must call ''Connect'' or ''ConnectTo'' before this operation');
Result := FIntf;
end;
constructor TApplication.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
FProps := TApplicationProperties.Create(Self);
{$ENDIF}
end;
destructor TApplication.Destroy;
begin
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
FProps.Free;
{$ENDIF}
inherited Destroy;
end;
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
function TApplication.GetServerProperties: TApplicationProperties;
begin
Result := FProps;
end;
{$ENDIF}
procedure TApplication.InvokeEvent(DispID: TDispID; var Params: TVariantArray);
begin
case DispID of
-1: Exit; // DISPID_UNKNOWN
1: if Assigned(FOnReceiveCurConf) then
FOnReceiveCurConf(Self, Params[0] {var OleVariant});
2: if Assigned(FOnStatusChange) then
FOnStatusChange(Self, Params[1] {const WideString}, Params[0] {Integer});
end; {case DispID}
end;
procedure TApplication.Connect1(shType: Smallint; const bstrServerIP: WideString;
const bstrUser: WideString; const bstrPass: WideString);
begin
DefaultInterface.Connect(shType, bstrServerIP, bstrUser, bstrPass);
end;
procedure TApplication.DisConnect1;
begin
DefaultInterface.DisConnect;
end;
function TApplication.IsConnect: Smallint;
begin
Result := DefaultInterface.IsConnect;
end;
function TApplication.GetSessions: IDispatch;
begin
Result := DefaultInterface.GetSessions;
end;
procedure TApplication.Exit;
begin
DefaultInterface.Exit;
end;
procedure TApplication.ShowServer;
begin
DefaultInterface.ShowServer;
end;
function TApplication.GetCurrentAccount: WideString;
begin
Result := DefaultInterface.GetCurrentAccount;
end;
function TApplication.GetCurrentHost: WideString;
begin
Result := DefaultInterface.GetCurrentHost;
end;
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
constructor TApplicationProperties.Create(AServer: TApplication);
begin
inherited Create;
FServer := AServer;
end;
function TApplicationProperties.GetDefaultInterface: IApplication;
begin
Result := FServer.DefaultInterface;
end;
{$ENDIF}
procedure Register;
begin
RegisterComponents(dtlServerPage, [TESession, TSessions, TApplication]);
end;
end.
var
MySession1: ISession;
MySessions: ISessions;
H1: SmallInt;
begin
MySessions:=CoSessions.Create;
MySession1:=CoSession.Create;
ShowMessage(Format('TotalSession = %d',[MySessions.GetTotalSessionNumber]));
//执行到这里都没有任何错
ShowMessage(Format('ActiveSession = %d',[MySession1.GetCurrentSessionID]));
//执行到这条语句时，就会提示：服务器出现意外情况
//我该怎么办？如何使用ISession这个接口？
end;
接口的源代码：
unit Eterm3Lib_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.130.1.0.1.0.1.6 $
// File generated on 2006-8-12 17:08:18 from Type Library described below.
// ************************************************************************ //
// Type Lib: D:/Tools/eTerm3/eTerm3.tlb (1)
// LIBID: {3B06E499-1473-47ED-85A5-2CE4EE45A6DF}
// LCID: 0
// Helpfile:
// DepndLst:
// (1) v2.0 stdole, (C:/WINDOWS/system32/stdole2.tlb)
// (2) v4.0 StdVCL, (C:/WINDOWS/system32/stdvcl40.dll)
// ************************************************************************ //
// *************************************************************************//
// NOTE:
// Items guarded by $IFDEF_LIVE_SERVER_AT_DESIGN_TIME are used by properties
// which return objects that may need to be explicitly created via a function
// call prior to any access via the property. These items have been disabled
// in order to prevent accidental use from within the object inspector. You
// may enable them by defining LIVE_SERVER_AT_DESIGN_TIME or by selectively
// removing them from the $IFDEF blocks. However, such items must still be
// programmatically created via a method of the appropriate CoClass before
// they can be used.
{$TYPEDADDRESS OFF} // Unit must be compiled without type-checked pointers.
{$WARN SYMBOL_PLATFORM OFF}
{$WRITEABLECONST ON}
{$VARPROPSETTER ON}
interface
uses Windows, ActiveX, Classes, Graphics, OleServer, StdVCL, Variants;
// *********************************************************************//
// 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
Eterm3LibMajorVersion = 1;
Eterm3LibMinorVersion = 0;
LIBID_Eterm3Lib: TGUID = '{3B06E499-1473-47ED-85A5-2CE4EE45A6DF}';
DIID__IApplicationEvents: TGUID = '{3C31BF76-2837-4BFA-A19E-34485A213F29}';
DIID__ISessionEvents: TGUID = '{4ADE78EF-390A-4FF8-B788-C47E30331B6D}';
IID_ISession: TGUID = '{2F4B1CA9-0DF8-4EC8-92DF-71BACE1DE0AA}';
CLASS_Session: TGUID = '{EC2C9F4C-CFB4-4096-AFC0-1531FC603606}';
IID_ISessions: TGUID = '{74423526-1E08-4A97-BC85-2D5FCC22CDBE}';
CLASS_Sessions: TGUID = '{FE104F26-4219-4DE0-87B9-8FF12A2A56B1}';
IID_IApplication: TGUID = '{98AA9DD3-0715-4170-8A96-04F06C8BAD49}';
CLASS_Application: TGUID = '{C5E9A707-5D62-4C96-A1B0-3DA8B719AA0D}';
type
// *********************************************************************//
// Forward declaration of types defined in TypeLibrary
// *********************************************************************//
_IApplicationEvents = dispinterface;
_ISessionEvents = dispinterface;
ISession = interface;
ISessionDisp = dispinterface;
ISessions = interface;
ISessionsDisp = dispinterface;
IApplication = interface;
IApplicationDisp = dispinterface;
// *********************************************************************//
// Declaration of CoClasses defined in Type Library
// (NOTE: Here we map each CoClass to its Default Interface)
// *********************************************************************//
Session = ISession;
Sessions = ISessions;
Application = IApplication;
// *********************************************************************//
// Declaration of structures, unions and aliases.
// *********************************************************************//
POleVariant1 = ^OleVariant; {*}
// *********************************************************************//
// DispIntf: _IApplicationEvents
// Flags: (4096) Dispatchable
// GUID: {3C31BF76-2837-4BFA-A19E-34485A213F29}
// *********************************************************************//
_IApplicationEvents = dispinterface
['{3C31BF76-2837-4BFA-A19E-34485A213F29}']
procedure ReceiveCurConf(var Conf: OleVariant); dispid 1;
procedure StatusChange(Status: Integer; const bstrDetail: WideString); dispid 2;
end;
// *********************************************************************//
// DispIntf: _ISessionEvents
// Flags: (4096) Dispatchable
// GUID: {4ADE78EF-390A-4FF8-B788-C47E30331B6D}
// *********************************************************************//
_ISessionEvents = dispinterface
['{4ADE78EF-390A-4FF8-B788-C47E30331B6D}']
procedure CPReceive(H1: Smallint; H2: Smallint; shReceiveType: Smallint; X: Smallint;
Y: Smallint; const bstrReceived: WideString); dispid 1;
end;
// *********************************************************************//
// Interface: ISession
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {2F4B1CA9-0DF8-4EC8-92DF-71BACE1DE0AA}
// *********************************************************************//
ISession = interface(IDispatch)
['{2F4B1CA9-0DF8-4EC8-92DF-71BACE1DE0AA}']
procedure InputStr(shH1: Smallint; shH2: Smallint; shSID: Smallint; const bstrCmd: WideString); safecall;
procedure SendStrNow(shH1: Smallint; shH2: Smallint; shSID: Smallint; const bstrCmd: WideString); safecall;
procedure SendCmd(shH1: Smallint; shH2: Smallint; shSID: Smallint; X: Smallint; Y: Smallint;
shKey: Smallint); safecall;
procedure PrintData(PrinterType: Integer; const PrinterInfo: WideString); safecall;
function GetLockStatus: Smallint; safecall;
procedure GetH1(out H1: Smallint); safecall;
procedure GetH2(out H2: Smallint); safecall;
procedure GetRID(out RID: Smallint); safecall;
procedure GetSID(out SID: Smallint); safecall;
procedure FullScreenString(Data: OleVariant); safecall;
function GetCurrentSessionID: Integer; safecall;
procedure Lock; safecall;
procedure Unlock; safecall;
function IsLock: Integer; safecall;
end;
// *********************************************************************//
// DispIntf: ISessionDisp
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {2F4B1CA9-0DF8-4EC8-92DF-71BACE1DE0AA}
// *********************************************************************//
ISessionDisp = dispinterface
['{2F4B1CA9-0DF8-4EC8-92DF-71BACE1DE0AA}']
procedure InputStr(shH1: Smallint; shH2: Smallint; shSID: Smallint; const bstrCmd: WideString); dispid 1;
procedure SendStrNow(shH1: Smallint; shH2: Smallint; shSID: Smallint; const bstrCmd: WideString); dispid 2;
procedure SendCmd(shH1: Smallint; shH2: Smallint; shSID: Smallint; X: Smallint; Y: Smallint;
shKey: Smallint); dispid 3;
procedure PrintData(PrinterType: Integer; const PrinterInfo: WideString); dispid 4;
function GetLockStatus: Smallint; dispid 5;
procedure GetH1(out H1: Smallint); dispid 6;
procedure GetH2(out H2: Smallint); dispid 7;
procedure GetRID(out RID: Smallint); dispid 8;
procedure GetSID(out SID: Smallint); dispid 9;
procedure FullScreenString(Data: OleVariant); dispid 10;
function GetCurrentSessionID: Integer; dispid 11;
procedure Lock; dispid 12;
procedure Unlock; dispid 13;
function IsLock: Integer; dispid 14;
end;
// *********************************************************************//
// Interface: ISessions
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {74423526-1E08-4A97-BC85-2D5FCC22CDBE}
// *********************************************************************//
ISessions = interface(IDispatch)
['{74423526-1E08-4A97-BC85-2D5FCC22CDBE}']
function Count: Integer; safecall;
function Item(index: OleVariant): IDispatch; safecall;
function GetTotalSessionNumber: Integer; safecall;
function GetActiveSession: Integer; safecall;
function Get__NewEnum: IUnknown; safecall;
property _NewEnum: IUnknown read Get__NewEnum;
end;
// *********************************************************************//
// DispIntf: ISessionsDisp
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {74423526-1E08-4A97-BC85-2D5FCC22CDBE}
// *********************************************************************//
ISessionsDisp = dispinterface
['{74423526-1E08-4A97-BC85-2D5FCC22CDBE}']
function Count: Integer; dispid 1;
function Item(index: OleVariant): IDispatch; dispid 2;
function GetTotalSessionNumber: Integer; dispid 3;
function GetActiveSession: Integer; dispid 4;
property _NewEnum: IUnknown readonly dispid -4;
end;
// *********************************************************************//
// Interface: IApplication
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {98AA9DD3-0715-4170-8A96-04F06C8BAD49}
// *********************************************************************//
IApplication = interface(IDispatch)
['{98AA9DD3-0715-4170-8A96-04F06C8BAD49}']
procedure Connect(shType: Smallint; const bstrServerIP: WideString; const bstrUser: WideString;
const bstrPass: WideString); safecall;
procedure DisConnect; safecall;
function IsConnect: Smallint; safecall;
function GetSessions: IDispatch; safecall;
procedure Exit; safecall;
procedure ShowServer; safecall;
function GetCurrentAccount: WideString; safecall;
function GetCurrentHost: WideString; safecall;
end;
// *********************************************************************//
// DispIntf: IApplicationDisp
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {98AA9DD3-0715-4170-8A96-04F06C8BAD49}
// *********************************************************************//
IApplicationDisp = dispinterface
['{98AA9DD3-0715-4170-8A96-04F06C8BAD49}']
procedure Connect(shType: Smallint; const bstrServerIP: WideString; const bstrUser: WideString;
const bstrPass: WideString); dispid 1;
procedure DisConnect; dispid 2;
function IsConnect: Smallint; dispid 3;
function GetSessions: IDispatch; dispid 4;
procedure Exit; dispid 5;
procedure ShowServer; dispid 6;
function GetCurrentAccount: WideString; dispid 7;
function GetCurrentHost: WideString; dispid 8;
end;
// *********************************************************************//
// The Class CoSession provides a Create and CreateRemote method to
// create instances of the default interface ISession exposed by
// the CoClass Session. The functions are intended to be used by
// clients wishing to automate the CoClass objects exposed by the
// server of this typelibrary.
// *********************************************************************//
CoSession = class
class function Create: ISession;
class function CreateRemote(const MachineName: string): ISession;
end;
TSessionCPReceive = procedure(Sender: TObject; H1: Smallint; H2: Smallint;
shReceiveType: Smallint; X: Smallint; Y: Smallint;
var bstrReceived: OleVariant) of object;
// *********************************************************************//
// OLE Server Proxy class declaration
// Server Object : TESession
// Help String : Session Class
// Default Interface: ISession
// Def. Intf. DISP? : No
// Event Interface: _ISessionEvents
// TypeFlags : (2) CanCreate
// *********************************************************************//
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
TSessionProperties= class;
{$ENDIF}
TESession = class(TOleServer)
private
FOnCPReceive: TSessionCPReceive;
FIntf: ISession;
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
FProps: TSessionProperties;
function GetServerProperties: TSessionProperties;
{$ENDIF}
function GetDefaultInterface: ISession;
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: ISession);
procedure Disconnect; override;
procedure InputStr(shH1: Smallint; shH2: Smallint; shSID: Smallint; const bstrCmd: WideString);
procedure SendStrNow(shH1: Smallint; shH2: Smallint; shSID: Smallint; const bstrCmd: WideString);
procedure SendCmd(shH1: Smallint; shH2: Smallint; shSID: Smallint; X: Smallint; Y: Smallint;
shKey: Smallint);
procedure PrintData(PrinterType: Integer; const PrinterInfo: WideString);
function GetLockStatus: Smallint;
procedure GetH1(out H1: Smallint);
procedure GetH2(out H2: Smallint);
procedure GetRID(out RID: Smallint);
procedure GetSID(out SID: Smallint);
procedure FullScreenString(Data: OleVariant);
function GetCurrentSessionID: Integer;
procedure Lock;
procedure Unlock;
function IsLock: Integer;
property DefaultInterface: ISession read GetDefaultInterface;
published
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
property Server: TSessionProperties read GetServerProperties;
{$ENDIF}
property OnCPReceive: TSessionCPReceive read FOnCPReceive write FOnCPReceive;
end;
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
// *********************************************************************//
// OLE Server Properties Proxy Class
// Server Object : TESession
// (This object is used by the IDE's Property Inspector to allow editing
// of the properties of this server)
// *********************************************************************//
TSessionProperties = class(TPersistent)
private
FServer: TESession;
function GetDefaultInterface: ISession;
constructor Create(AServer: TESession);
protected
public
property DefaultInterface: ISession read GetDefaultInterface;
published
end;
{$ENDIF}
// *********************************************************************//
// The Class CoSessions provides a Create and CreateRemote method to
// create instances of the default interface ISessions exposed by
// the CoClass Sessions. The functions are intended to be used by
// clients wishing to automate the CoClass objects exposed by the
// server of this typelibrary.
// *********************************************************************//
CoSessions = class
class function Create: ISessions;
class function CreateRemote(const MachineName: string): ISessions;
end;
// *********************************************************************//
// OLE Server Proxy class declaration
// Server Object : TSessions
// Help String : Sessions Class
// Default Interface: ISessions
// Def. Intf. DISP? : No
// Event Interface:
// TypeFlags : (2) CanCreate
// *********************************************************************//
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
TSessionsProperties= class;
{$ENDIF}
TSessions = class(TOleServer)
private
FIntf: ISessions;
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
FProps: TSessionsProperties;
function GetServerProperties: TSessionsProperties;
{$ENDIF}
function GetDefaultInterface: ISessions;
protected
procedure InitServerData; override;
function Get__NewEnum: IUnknown;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Connect; override;
procedure ConnectTo(svrIntf: ISessions);
procedure Disconnect; override;
function Count: Integer;
function Item(index: OleVariant): IDispatch;
function GetTotalSessionNumber: Integer;
function GetActiveSession: Integer;
property DefaultInterface: ISessions read GetDefaultInterface;
property _NewEnum: IUnknown read Get__NewEnum;
published
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
property Server: TSessionsProperties read GetServerProperties;
{$ENDIF}
end;
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
// *********************************************************************//
// OLE Server Properties Proxy Class
// Server Object : TSessions
// (This object is used by the IDE's Property Inspector to allow editing
// of the properties of this server)
// *********************************************************************//
TSessionsProperties = class(TPersistent)
private
FServer: TSessions;
function GetDefaultInterface: ISessions;
constructor Create(AServer: TSessions);
protected
function Get__NewEnum: IUnknown;
public
property DefaultInterface: ISessions read GetDefaultInterface;
published
end;
{$ENDIF}
// *********************************************************************//
// The Class CoApplication provides a Create and CreateRemote method to
// create instances of the default interface IApplication exposed by
// the CoClass Application. The functions are intended to be used by
// clients wishing to automate the CoClass objects exposed by the
// server of this typelibrary.
// *********************************************************************//
CoApplication = class
class function Create: IApplication;
class function CreateRemote(const MachineName: string): IApplication;
end;
TApplicationReceiveCurConf = procedure(Sender: TObject; var Conf: OleVariant) of object;
TApplicationStatusChange = procedure(Sender: TObject; Status: Integer; var bstrDetail: OleVariant) of object;
// *********************************************************************//
// OLE Server Proxy class declaration
// Server Object : TApplication
// Help String : Application Class
// Default Interface: IApplication
// Def. Intf. DISP? : No
// Event Interface: _IApplicationEvents
// TypeFlags : (2) CanCreate
// *********************************************************************//
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
TApplicationProperties= class;
{$ENDIF}
TApplication = class(TOleServer)
private
FOnReceiveCurConf: TApplicationReceiveCurConf;
FOnStatusChange: TApplicationStatusChange;
FIntf: IApplication;
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
FProps: TApplicationProperties;
function GetServerProperties: TApplicationProperties;
{$ENDIF}
function GetDefaultInterface: IApplication;
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: IApplication);
procedure Disconnect; override;
procedure Connect1(shType: Smallint; const bstrServerIP: WideString;
const bstrUser: WideString; const bstrPass: WideString);
procedure DisConnect1;
function IsConnect: Smallint;
function GetSessions: IDispatch;
procedure Exit;
procedure ShowServer;
function GetCurrentAccount: WideString;
function GetCurrentHost: WideString;
property DefaultInterface: IApplication read GetDefaultInterface;
published
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
property Server: TApplicationProperties read GetServerProperties;
{$ENDIF}
property OnReceiveCurConf: TApplicationReceiveCurConf read FOnReceiveCurConf write FOnReceiveCurConf;
property OnStatusChange: TApplicationStatusChange read FOnStatusChange write FOnStatusChange;
end;
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
// *********************************************************************//
// OLE Server Properties Proxy Class
// Server Object : TApplication
// (This object is used by the IDE's Property Inspector to allow editing
// of the properties of this server)
// *********************************************************************//
TApplicationProperties = class(TPersistent)
private
FServer: TApplication;
function GetDefaultInterface: IApplication;
constructor Create(AServer: TApplication);
protected
public
property DefaultInterface: IApplication read GetDefaultInterface;
published
end;
{$ENDIF}
procedure Register;
resourcestring
dtlServerPage = 'ActiveX';
implementation
uses ComObj;
class function CoSession.Create: ISession;
begin
Result := CreateComObject(CLASS_Session) as ISession;
end;
class function CoSession.CreateRemote(const MachineName: string): ISession;
begin
Result := CreateRemoteComObject(MachineName, CLASS_Session) as ISession;
end;
procedure TESession.InitServerData;
const
CServerData: TServerData = (
ClassID: '{EC2C9F4C-CFB4-4096-AFC0-1531FC603606}';
IntfIID: '{2F4B1CA9-0DF8-4EC8-92DF-71BACE1DE0AA}';
EventIID: '{4ADE78EF-390A-4FF8-B788-C47E30331B6D}';
LicenseKey: nil;
Version: 500);
begin
ServerData := @CServerData;
end;
procedure TESession.Connect;
var
punk: IUnknown;
begin
if FIntf = nil then
begin
punk := GetServer;
ConnectEvents(punk);
Fintf:= punk as ISession;
end;
end;
procedure TESession.ConnectTo(svrIntf: ISession);
begin
Disconnect;
FIntf := svrIntf;
ConnectEvents(FIntf);
end;
procedure TESession.DisConnect;
begin
if Fintf <> nil then
begin
DisconnectEvents(FIntf);
FIntf := nil;
end;
end;
function TESession.GetDefaultInterface: ISession;
begin
if FIntf = nil then
Connect;
Assert(FIntf <> nil, 'DefaultInterface is NULL. Component is not connected to Server. You must call ''Connect'' or ''ConnectTo'' before this operation');
Result := FIntf;
end;
constructor TESession.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
FProps := TSessionProperties.Create(Self);
{$ENDIF}
end;
destructor TESession.Destroy;
begin
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
FProps.Free;
{$ENDIF}
inherited Destroy;
end;
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
function TESession.GetServerProperties: TSessionProperties;
begin
Result := FProps;
end;
{$ENDIF}
procedure TESession.InvokeEvent(DispID: TDispID; var Params: TVariantArray);
begin
case DispID of
-1: Exit; // DISPID_UNKNOWN
1: if Assigned(FOnCPReceive) then
FOnCPReceive(Self, Params[5] {const WideString}, Params[4] {Smallint}, Params[3] {Smallint}, Params[2] {Smallint}, Params[1] {Smallint}, Params[0] {Smallint});
end; {case DispID}
end;
procedure TESession.InputStr(shH1: Smallint; shH2: Smallint; shSID: Smallint;
const bstrCmd: WideString);
begin
DefaultInterface.InputStr(shH1, shH2, shSID, bstrCmd);
end;
procedure TESession.SendStrNow(shH1: Smallint; shH2: Smallint; shSID: Smallint;
const bstrCmd: WideString);
begin
DefaultInterface.SendStrNow(shH1, shH2, shSID, bstrCmd);
end;
procedure TESession.SendCmd(shH1: Smallint; shH2: Smallint; shSID: Smallint; X: Smallint;
Y: Smallint; shKey: Smallint);
begin
DefaultInterface.SendCmd(shH1, shH2, shSID, X, Y, shKey);
end;
procedure TESession.PrintData(PrinterType: Integer; const PrinterInfo: WideString);
begin
DefaultInterface.PrintData(PrinterType, PrinterInfo);
end;
function TESession.GetLockStatus: Smallint;
begin
Result := DefaultInterface.GetLockStatus;
end;
procedure TESession.GetH1(out H1: Smallint);
begin
DefaultInterface.GetH1(H1);
end;
procedure TESession.GetH2(out H2: Smallint);
begin
DefaultInterface.GetH2(H2);
end;
procedure TESession.GetRID(out RID: Smallint);
begin
DefaultInterface.GetRID(RID);
end;
procedure TESession.GetSID(out SID: Smallint);
begin
DefaultInterface.GetSID(SID);
end;
procedure TESession.FullScreenString(Data: OleVariant);
begin
DefaultInterface.FullScreenString(Data);
end;
function TESession.GetCurrentSessionID: Integer;
begin
Result := DefaultInterface.GetCurrentSessionID;
end;
procedure TESession.Lock;
begin
DefaultInterface.Lock;
end;
procedure TESession.Unlock;
begin
DefaultInterface.Unlock;
end;
function TESession.IsLock: Integer;
begin
Result := DefaultInterface.IsLock;
end;
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
constructor TSessionProperties.Create(AServer: TESession);
begin
inherited Create;
FServer := AServer;
end;
function TSessionProperties.GetDefaultInterface: ISession;
begin
Result := FServer.DefaultInterface;
end;
{$ENDIF}
class function CoSessions.Create: ISessions;
begin
Result := CreateComObject(CLASS_Sessions) as ISessions;
end;
class function CoSessions.CreateRemote(const MachineName: string): ISessions;
begin
Result := CreateRemoteComObject(MachineName, CLASS_Sessions) as ISessions;
end;
procedure TSessions.InitServerData;
const
CServerData: TServerData = (
ClassID: '{FE104F26-4219-4DE0-87B9-8FF12A2A56B1}';
IntfIID: '{74423526-1E08-4A97-BC85-2D5FCC22CDBE}';
EventIID: '';
LicenseKey: nil;
Version: 500);
begin
ServerData := @CServerData;
end;
procedure TSessions.Connect;
var
punk: IUnknown;
begin
if FIntf = nil then
begin
punk := GetServer;
Fintf:= punk as ISessions;
end;
end;
procedure TSessions.ConnectTo(svrIntf: ISessions);
begin
Disconnect;
FIntf := svrIntf;
end;
procedure TSessions.DisConnect;
begin
if Fintf <> nil then
begin
FIntf := nil;
end;
end;
function TSessions.GetDefaultInterface: ISessions;
begin
if FIntf = nil then
Connect;
Assert(FIntf <> nil, 'DefaultInterface is NULL. Component is not connected to Server. You must call ''Connect'' or ''ConnectTo'' before this operation');
Result := FIntf;
end;
constructor TSessions.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
FProps := TSessionsProperties.Create(Self);
{$ENDIF}
end;
destructor TSessions.Destroy;
begin
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
FProps.Free;
{$ENDIF}
inherited Destroy;
end;
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
function TSessions.GetServerProperties: TSessionsProperties;
begin
Result := FProps;
end;
{$ENDIF}
function TSessions.Get__NewEnum: IUnknown;
begin
Result := DefaultInterface._NewEnum;
end;
function TSessions.Count: Integer;
begin
Result := DefaultInterface.Count;
end;
function TSessions.Item(index: OleVariant): IDispatch;
begin
Result := DefaultInterface.Item(index);
end;
function TSessions.GetTotalSessionNumber: Integer;
begin
Result := DefaultInterface.GetTotalSessionNumber;
end;
function TSessions.GetActiveSession: Integer;
begin
Result := DefaultInterface.GetActiveSession;
end;
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
constructor TSessionsProperties.Create(AServer: TSessions);
begin
inherited Create;
FServer := AServer;
end;
function TSessionsProperties.GetDefaultInterface: ISessions;
begin
Result := FServer.DefaultInterface;
end;
function TSessionsProperties.Get__NewEnum: IUnknown;
begin
Result := DefaultInterface._NewEnum;
end;
{$ENDIF}
class function CoApplication.Create: IApplication;
begin
Result := CreateComObject(CLASS_Application) as IApplication;
end;
class function CoApplication.CreateRemote(const MachineName: string): IApplication;
begin
Result := CreateRemoteComObject(MachineName, CLASS_Application) as IApplication;
end;
procedure TApplication.InitServerData;
const
CServerData: TServerData = (
ClassID: '{C5E9A707-5D62-4C96-A1B0-3DA8B719AA0D}';
IntfIID: '{98AA9DD3-0715-4170-8A96-04F06C8BAD49}';
EventIID: '{3C31BF76-2837-4BFA-A19E-34485A213F29}';
LicenseKey: nil;
Version: 500);
begin
ServerData := @CServerData;
end;
procedure TApplication.Connect;
var
punk: IUnknown;
begin
if FIntf = nil then
begin
punk := GetServer;
ConnectEvents(punk);
Fintf:= punk as IApplication;
end;
end;
procedure TApplication.ConnectTo(svrIntf: IApplication);
begin
Disconnect;
FIntf := svrIntf;
ConnectEvents(FIntf);
end;
procedure TApplication.DisConnect;
begin
if Fintf <> nil then
begin
DisconnectEvents(FIntf);
FIntf := nil;
end;
end;
function TApplication.GetDefaultInterface: IApplication;
begin
if FIntf = nil then
Connect;
Assert(FIntf <> nil, 'DefaultInterface is NULL. Component is not connected to Server. You must call ''Connect'' or ''ConnectTo'' before this operation');
Result := FIntf;
end;
constructor TApplication.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
FProps := TApplicationProperties.Create(Self);
{$ENDIF}
end;
destructor TApplication.Destroy;
begin
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
FProps.Free;
{$ENDIF}
inherited Destroy;
end;
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
function TApplication.GetServerProperties: TApplicationProperties;
begin
Result := FProps;
end;
{$ENDIF}
procedure TApplication.InvokeEvent(DispID: TDispID; var Params: TVariantArray);
begin
case DispID of
-1: Exit; // DISPID_UNKNOWN
1: if Assigned(FOnReceiveCurConf) then
FOnReceiveCurConf(Self, Params[0] {var OleVariant});
2: if Assigned(FOnStatusChange) then
FOnStatusChange(Self, Params[1] {const WideString}, Params[0] {Integer});
end; {case DispID}
end;
procedure TApplication.Connect1(shType: Smallint; const bstrServerIP: WideString;
const bstrUser: WideString; const bstrPass: WideString);
begin
DefaultInterface.Connect(shType, bstrServerIP, bstrUser, bstrPass);
end;
procedure TApplication.DisConnect1;
begin
DefaultInterface.DisConnect;
end;
function TApplication.IsConnect: Smallint;
begin
Result := DefaultInterface.IsConnect;
end;
function TApplication.GetSessions: IDispatch;
begin
Result := DefaultInterface.GetSessions;
end;
procedure TApplication.Exit;
begin
DefaultInterface.Exit;
end;
procedure TApplication.ShowServer;
begin
DefaultInterface.ShowServer;
end;
function TApplication.GetCurrentAccount: WideString;
begin
Result := DefaultInterface.GetCurrentAccount;
end;
function TApplication.GetCurrentHost: WideString;
begin
Result := DefaultInterface.GetCurrentHost;
end;
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
constructor TApplicationProperties.Create(AServer: TApplication);
begin
inherited Create;
FServer := AServer;
end;
function TApplicationProperties.GetDefaultInterface: IApplication;
begin
Result := FServer.DefaultInterface;
end;
{$ENDIF}
procedure Register;
begin
RegisterComponents(dtlServerPage, [TESession, TSessions, TApplication]);
end;
end.