property AllowUI: WordBool read Get_AllowUI write Set_AllowUI;
    property UseSafeSubset: WordBool read Get_UseSafeSubset write Set_UseSafeSubset;
    property Modules: IScriptModuleCollection read Get_Modules;
    property Error: IScriptError read Get_Error;
    property CodeObject: IDispatch read Get_CodeObject;
    property Procedures: IScriptProcedureCollection read Get_Procedures;
  end;

// *********************************************************************//
// DispIntf:  IScriptControlDisp
// Flags:     (4560) Hidden Dual NonExtensible OleAutomation Dispatchable
// GUID:      {0E59F1D3-1FBE-11D0-8FF2-00A0D10038BC}
// *********************************************************************//
  IScriptControlDisp = dispinterface
    ['{0E59F1D3-1FBE-11D0-8FF2-00A0D10038BC}']
    property Language: WideString dispid 1500;
    property State: ScriptControlStates dispid 1501;
    property SitehWnd: Integer dispid 1502;
    property Timeout: Integer dispid 1503;
    property AllowUI: WordBool dispid 1504;
    property UseSafeSubset: WordBool dispid 1505;
    property Modules: IScriptModuleCollection readonly dispid 1506;
    property Error: IScriptError readonly dispid 1507;
    property CodeObject: IDispatch readonly dispid 1000;
    property Procedures: IScriptProcedureCollection readonly dispid 1001;
    procedure _AboutBox; dispid -552;
    procedure AddObject(const Name: WideString; const Object_: IDispatch; AddMembers: WordBool); dispid 2500;
    procedure Reset; dispid 2501;
    procedure AddCode(const Code: WideString); dispid 2000;
    function Eval(const Expression: WideString): OleVariant; dispid 2001;
    procedure ExecuteStatement(const Statement: WideString); dispid 2002;
    function Run(const ProcedureName: WideString; var Parameters: {??PSafeArray}OleVariant): OleVariant; dispid 2003;
  end;

// *********************************************************************//
// DispIntf:  DScriptControlSource
// Flags:     (4112) Hidden Dispatchable
// GUID:      {8B167D60-8605-11D0-ABCB-00A0C90FFFC0}
// *********************************************************************//
  DScriptControlSource = dispinterface
    ['{8B167D60-8605-11D0-ABCB-00A0C90FFFC0}']
    procedure Error; dispid 3000;
    procedure Timeout; dispid 3001;
  end;

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

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

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

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

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


// *********************************************************************//
// OLE Control Proxy class declaration
// Control Name     : TScriptControl
// Help String      : Control to host scripting engines that understand the ActiveX Scripting interface
// Default Interface: IScriptControl
// Def. Intf. DISP? : No
// Event   Interface: DScriptControlSource
// TypeFlags        : (34) CanCreate Control
// *********************************************************************//
  TScriptControl = class(TOleControl)
  private
    FOnError: TNotifyEvent;
    FOnTimeout: TNotifyEvent;
    FIntf: IScriptControl;
    function  GetControlInterface: IScriptControl;
  protected
    procedure CreateControl;
    procedure InitControlData; override;
    function Get_Modules: IScriptModuleCollection;
    function Get_Error: IScriptError;
    function Get_CodeObject: IDispatch;
    function Get_Procedures: IScriptProcedureCollection;
  public
    procedure _AboutBox;
    procedure AddObject(const Name: WideString; const Object_: IDispatch; AddMembers: WordBool);
    procedure Reset;
    procedure AddCode(const Code: WideString);
    function Eval(const Expression: WideString): OleVariant;
    procedure ExecuteStatement(const Statement: WideString);
    function Run(const ProcedureName: WideString; var Parameters: PSafeArray): OleVariant;
    property  ControlInterface: IScriptControl read GetControlInterface;
    property  DefaultInterface: IScriptControl read GetControlInterface;
    property Modules: IScriptModuleCollection read Get_Modules;
    property Error: IScriptError read Get_Error;
    property CodeObject: IDispatch index 1000 read GetIDispatchProp;
    property Procedures: IScriptProcedureCollection read Get_Procedures;
  published
    property Language: WideString index 1500 read GetWideStringProp write SetWideStringProp stored False;
    property State: TOleEnum index 1501 read GetTOleEnumProp write SetTOleEnumProp stored False;
    property SitehWnd: Integer index 1502 read GetIntegerProp write SetIntegerProp stored False;
    property Timeout: Integer index 1503 read GetIntegerProp write SetIntegerProp stored False;
    property AllowUI: WordBool index 1504 read GetWordBoolProp write SetWordBoolProp stored False;
    property UseSafeSubset: WordBool index 1505 read GetWordBoolProp write SetWordBoolProp stored False;
    property OnError: TNotifyEvent read FOnError write FOnError;
    property OnTimeout: TNotifyEvent read FOnTimeout write FOnTimeout;
  end;

procedure Register;

resourcestring
  dtlServerPage = 'ActiveX';

implementation

uses ComObj;

class function CoProcedure_.Create: IScriptProcedure;
begin
  Result := CreateComObject(CLASS_Procedure_) as IScriptProcedure;
end;

class function CoProcedure_.CreateRemote(const MachineName: string): IScriptProcedure;
begin
  Result := CreateRemoteComObject(MachineName, CLASS_Procedure_) as IScriptProcedure;
end;

class function CoProcedures.Create: IScriptProcedureCollection;
begin
  Result := CreateComObject(CLASS_Procedures) as IScriptProcedureCollection;
end;

class function CoProcedures.CreateRemote(const MachineName: string): IScriptProcedureCollection;
begin
  Result := CreateRemoteComObject(MachineName, CLASS_Procedures) as IScriptProcedureCollection;
end;

class function CoModule.Create: IScriptModule;
begin
  Result := CreateComObject(CLASS_Module) as IScriptModule;
end;

class function CoModule.CreateRemote(const MachineName: string): IScriptModule;
begin
  Result := CreateRemoteComObject(MachineName, CLASS_Module) as IScriptModule;
end;

class function CoModules.Create: IScriptModuleCollection;
begin
  Result := CreateComObject(CLASS_Modules) as IScriptModuleCollection;
end;

class function CoModules.CreateRemote(const MachineName: string): IScriptModuleCollection;
begin
  Result := CreateRemoteComObject(MachineName, CLASS_Modules) as IScriptModuleCollection;
end;

class function CoError.Create: IScriptError;
begin
  Result := CreateComObject(CLASS_Error) as IScriptError;
end;

class function CoError.CreateRemote(const MachineName: string): IScriptError;
begin
  Result := CreateRemoteComObject(MachineName, CLASS_Error) as IScriptError;
end;

procedure TScriptControl.InitControlData;
const
  CEventDispIDs: array [0..1] of DWORD = (
    $00000BB8, $00000BB9);
  CControlData: TControlData2 = (
    ClassID: '{0E59F1D5-1FBE-11D0-8FF2-00A0D10038BC}';
    EventIID: '{8B167D60-8605-11D0-ABCB-00A0C90FFFC0}';
    EventCount: 2;
    EventDispIDs: @CEventDispIDs;
    LicenseKey: nil (*HR:$00000000*);
    Flags: $00000000;
    Version: 401);
begin
  ControlData := @CControlData;
  TControlData2(CControlData).FirstEventOfs := Cardinal(@@FOnError) - Cardinal(Self);
end;

procedure TScriptControl.CreateControl;

  procedure DoCreate;
  begin
    FIntf := IUnknown(OleObject) as IScriptControl;
  end;

begin
  if FIntf = nil then DoCreate;
end;

function TScriptControl.GetControlInterface: IScriptControl;
begin
  CreateControl;
  Result := FIntf;
end;

function TScriptControl.Get_Modules: IScriptModuleCollection;
begin
    Result := DefaultInterface.Modules;
end;

function TScriptControl.Get_Error: IScriptError;
begin
    Result := DefaultInterface.Error;
end;

function TScriptControl.Get_CodeObject: IDispatch;
begin
    Result := DefaultInterface.CodeObject;
end;

function TScriptControl.Get_Procedures: IScriptProcedureCollection;
begin
    Result := DefaultInterface.Procedures;
end;

procedure TScriptControl._AboutBox;
begin
  DefaultInterface._AboutBox;
end;

procedure TScriptControl.AddObject(const Name: WideString; const Object_: IDispatch; 
                                   AddMembers: WordBool);
begin
  DefaultInterface.AddObject(Name, Object_, AddMembers);
end;

procedure TScriptControl.Reset;
begin
  DefaultInterface.Reset;
end;

procedure TScriptControl.AddCode(const Code: WideString);
begin
  DefaultInterface.AddCode(Code);
end;

function TScriptControl.Eval(const Expression: WideString): OleVariant;
begin
  Result := DefaultInterface.Eval(Expression);
end;

procedure TScriptControl.ExecuteStatement(const Statement: WideString);
begin
  DefaultInterface.ExecuteStatement(Statement);
end;

function TScriptControl.Run(const ProcedureName: WideString; var Parameters: PSafeArray): OleVariant;
begin
  Result := DefaultInterface.Run(ProcedureName, Parameters);
end;

procedure Register;
begin
  RegisterComponents('ActiveX',[TScriptControl]);
end;

end.