Delphi 如何在程序中执行动态生成的Delphi代码

如何在程序中执行动态生成的Delphi代码 


经常发现有人提这类问题，或者提问内容最后归结成这种问题 


前些阵子有位高手写了一个“执行动态生成的代码”，这是真正的高手，我没那种功力，我只会投机取巧。 


这里提供三种方法，都是借助第三方的组件来实现的。 


1、MicroSoft Windows Script Control（http://www.microsoft.com/downloads/details.aspx?FamilyID=d7e31492-2595-49e6-8c02-1426fec693ac&DisplayLang=en） 
   这是微软的东西，OCX的，我对OCX的东西一向没什么好感，：）但总算是解决问题的一个方法。 
   到以上地址下载回来sct10en.exe，这是个安装程序，安装完成以后，在安装目录里有一个msscript.ocx，就是它了。 
   在Delphi中Import OCX...导入安装，在窗体上添加一个TScriptControl类的实例。 
   设置好它的Scriptanguage属性：VBScript,JScript...IE认识的它都认识，没有Object Pascal？不要急，好戏总是放在后头嘛... 
   以VbScript为例： 
     运行脚本：ScriptControl1.ExecuteStatement('msgbox("Runing....")'); 
     计算公式：ShowMessage(scriptcontrol1.Eval('1+1')); 
   
   优点：皇家的东西，相信它，没错的 
   缺点：发布程序带个OCX，只能支持微软的Script 


2、Dream Collection中的DCScripter（ftp://202.117.210.28/file/dream4.rar） 
   安装好以后在控件面板DreamCompany里面有一个向右的黑色箭头，就是它了。 
   以VbScript为例： 
   运行脚本：DCScripter1.Script.Add('msgbox("Script Runing...")'); 
             DCScripter1.Run; 
   计算公式：ShowMessage(DCScripter1.Evaluate('1+1')); 


   优点：VCL的，除支持微软的脚本以外，还支持Perl，Python 
   缺点：还是不支持Object Pascal...（别打，就来了...） 


3、DelphiWebScriptII（http://prdownloads.sourceforge.net/dws/dws2src11.zip） 
   这个东西好啊，功能超强，太强了，太强了，真强... 
   安装完成以后，将TDelphiWebScriptII，Tdws2GUIFunctions加入窗体，引用dws2Exprs单元。 
   运行脚本： 
   var 
     prg: TProgram; 
   begin 
     prg := DelphiWebScriptII1.Compile('ShowMessage(''hi'');'); 
     prg.Execute; 
   end; 
   这个东西是用稍微复杂一点，不过看看Demo吧，接下来的造化就看你自己的了。 


   优点：VCL的，功能超强，支持Object Pascal... 
   缺点：只支持Object Pascal... 

以上三个各有忧缺点，大家可能比较欣赏DelphiWebScript的功能，但是我觉得如果是给用户使用的话，还是Dream Scripter比较好，毕竟VbScript等比较容易为用户所接受。其实现在很多网管等都很习惯于利用系统提供的COM对象，使用纯脚本进行编程。很方便的。 

MSScriptControl_TLB.pas

unit MSScriptControl_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.1 $
// File generated on 2005-12-20 13:43:49 from Type Library described below.

// ************************************************************************  //
// Type Lib: C:WINNTSystem32msscript.ocx (1)
// LIBID: {0E59F1D2-1FBE-11D0-8FF2-00A0D10038BC}
// LCID: 0
// Helpfile: C:WINNTSystem32MSSCRIPT.HLP
// DepndLst: 
//   (1) v2.0 stdole, (C:WINNTsystem32stdole2.tlb)
//   (2) v4.0 StdVCL, (C:WINNTsystem32stdvcl40.dll)
// Errors:
//   Hint: TypeInfo 'Procedure' changed to 'Procedure_'
//   Hint: Parameter 'Object' of IScriptModuleCollection.Add changed to 'Object_'
//   Hint: Parameter 'Object' of IScriptControl.AddObject changed to 'Object_'
// ************************************************************************ //
{$TYPEDADDRESS OFF} // Unit must be compiled without type-checked pointers. 
{$WARN SYMBOL_PLATFORM OFF}
{$WRITEABLECONST ON}
{$VARPROPSETTER ON}
interface

uses Windows, ActiveX, Classes, Graphics, OleCtrls, 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
  MSScriptControlMajorVersion = 1;
  MSScriptControlMinorVersion = 0;

  LIBID_MSScriptControl: TGUID = '{0E59F1D2-1FBE-11D0-8FF2-00A0D10038BC}';

  IID_IScriptProcedure: TGUID = '{70841C73-067D-11D0-95D8-00A02463AB28}';
  IID_IScriptProcedureCollection: TGUID = '{70841C71-067D-11D0-95D8-00A02463AB28}';
  IID_IScriptModule: TGUID = '{70841C70-067D-11D0-95D8-00A02463AB28}';
  IID_IScriptModuleCollection: TGUID = '{70841C6F-067D-11D0-95D8-00A02463AB28}';
  IID_IScriptError: TGUID = '{70841C78-067D-11D0-95D8-00A02463AB28}';
  IID_IScriptControl: TGUID = '{0E59F1D3-1FBE-11D0-8FF2-00A0D10038BC}';
  DIID_DScriptControlSource: TGUID = '{8B167D60-8605-11D0-ABCB-00A0C90FFFC0}';
  CLASS_Procedure_: TGUID = '{0E59F1DA-1FBE-11D0-8FF2-00A0D10038BC}';
  CLASS_Procedures: TGUID = '{0E59F1DB-1FBE-11D0-8FF2-00A0D10038BC}';
  CLASS_Module: TGUID = '{0E59F1DC-1FBE-11D0-8FF2-00A0D10038BC}';
  CLASS_Modules: TGUID = '{0E59F1DD-1FBE-11D0-8FF2-00A0D10038BC}';
  CLASS_Error: TGUID = '{0E59F1DE-1FBE-11D0-8FF2-00A0D10038BC}';
  CLASS_ScriptControl: TGUID = '{0E59F1D5-1FBE-11D0-8FF2-00A0D10038BC}';

// *********************************************************************//
// Declaration of Enumerations defined in Type Library                    
// *********************************************************************//
// Constants for enum ScriptControlStates
type
  ScriptControlStates = TOleEnum;
const
  Initialized = $00000000;
  Connected = $00000001;

type

// *********************************************************************//
// Forward declaration of types defined in TypeLibrary                    
// *********************************************************************//
  IScriptProcedure = interface;
  IScriptProcedureDisp = dispinterface;
  IScriptProcedureCollection = interface;
  IScriptProcedureCollectionDisp = dispinterface;
  IScriptModule = interface;
  IScriptModuleDisp = dispinterface;
  IScriptModuleCollection = interface;
  IScriptModuleCollectionDisp = dispinterface;
  IScriptError = interface;
  IScriptErrorDisp = dispinterface;
  IScriptControl = interface;
  IScriptControlDisp = dispinterface;
  DScriptControlSource = dispinterface;

// *********************************************************************//
// Declaration of CoClasses defined in Type Library                       
// (NOTE: Here we map each CoClass to its Default Interface)              
// *********************************************************************//
  Procedure_ = IScriptProcedure;
  Procedures = IScriptProcedureCollection;
  Module = IScriptModule;
  Modules = IScriptModuleCollection;
  Error = IScriptError;
  ScriptControl = IScriptControl;


// *********************************************************************//
// Declaration of structures, unions and aliases.                         
// *********************************************************************//
  PPSafeArray1 = ^PSafeArray; {*}
  POleVariant1 = ^OleVariant; {*}


// *********************************************************************//
// Interface: IScriptProcedure
// Flags:     (4560) Hidden Dual NonExtensible OleAutomation Dispatchable
// GUID:      {70841C73-067D-11D0-95D8-00A02463AB28}
// *********************************************************************//
  IScriptProcedure = interface(IDispatch)
    ['{70841C73-067D-11D0-95D8-00A02463AB28}']
    function Get_Name: WideString; safecall;
    function Get_NumArgs: Integer; safecall;
    function Get_HasReturnValue: WordBool; safecall;
    property Name: WideString read Get_Name;
    property NumArgs: Integer read Get_NumArgs;
    property HasReturnValue: WordBool read Get_HasReturnValue;
  end;

// *********************************************************************//
// DispIntf:  IScriptProcedureDisp
// Flags:     (4560) Hidden Dual NonExtensible OleAutomation Dispatchable
// GUID:      {70841C73-067D-11D0-95D8-00A02463AB28}
// *********************************************************************//
  IScriptProcedureDisp = dispinterface
    ['{70841C73-067D-11D0-95D8-00A02463AB28}']
    property Name: WideString readonly dispid 0;
    property NumArgs: Integer readonly dispid 100;
    property HasReturnValue: WordBool readonly dispid 101;
  end;

// *********************************************************************//
// Interface: IScriptProcedureCollection
// Flags:     (4560) Hidden Dual NonExtensible OleAutomation Dispatchable
// GUID:      {70841C71-067D-11D0-95D8-00A02463AB28}
// *********************************************************************//
  IScriptProcedureCollection = interface(IDispatch)
    ['{70841C71-067D-11D0-95D8-00A02463AB28}']
    function Get__NewEnum: IUnknown; safecall;
    function Get_Item(Index: OleVariant): IScriptProcedure; safecall;
    function Get_Count: Integer; safecall;
    property _NewEnum: IUnknown read Get__NewEnum;
    property Item[Index: OleVariant]: IScriptProcedure read Get_Item; default;
    property Count: Integer read Get_Count;
  end;

// *********************************************************************//
// DispIntf:  IScriptProcedureCollectionDisp
// Flags:     (4560) Hidden Dual NonExtensible OleAutomation Dispatchable
// GUID:      {70841C71-067D-11D0-95D8-00A02463AB28}
// *********************************************************************//
  IScriptProcedureCollectionDisp = dispinterface
    ['{70841C71-067D-11D0-95D8-00A02463AB28}']
    property _NewEnum: IUnknown readonly dispid -4;
    property Item[Index: OleVariant]: IScriptProcedure readonly dispid 0; default;
    property Count: Integer readonly dispid 1;
  end;

// *********************************************************************//
// Interface: IScriptModule
// Flags:     (4560) Hidden Dual NonExtensible OleAutomation Dispatchable
// GUID:      {70841C70-067D-11D0-95D8-00A02463AB28}
// *********************************************************************//
  IScriptModule = interface(IDispatch)
    ['{70841C70-067D-11D0-95D8-00A02463AB28}']
    function Get_Name: WideString; safecall;
    function Get_CodeObject: IDispatch; safecall;
    function Get_Procedures: IScriptProcedureCollection; safecall;
    procedure AddCode(const Code: WideString); safecall;
    function Eval(const Expression: WideString): OleVariant; safecall;
    procedure ExecuteStatement(const Statement: WideString); safecall;
    function Run(const ProcedureName: WideString; var Parameters: PSafeArray): OleVariant; safecall;
    property Name: WideString read Get_Name;
    property CodeObject: IDispatch read Get_CodeObject;
    property Procedures: IScriptProcedureCollection read Get_Procedures;
  end;

// *********************************************************************//
// DispIntf:  IScriptModuleDisp
// Flags:     (4560) Hidden Dual NonExtensible OleAutomation Dispatchable
// GUID:      {70841C70-067D-11D0-95D8-00A02463AB28}
// *********************************************************************//
  IScriptModuleDisp = dispinterface
    ['{70841C70-067D-11D0-95D8-00A02463AB28}']
    property Name: WideString readonly dispid 0;
    property CodeObject: IDispatch readonly dispid 1000;
    property Procedures: IScriptProcedureCollection readonly dispid 1001;
    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;

// *********************************************************************//
// Interface: IScriptModuleCollection
// Flags:     (4560) Hidden Dual NonExtensible OleAutomation Dispatchable
// GUID:      {70841C6F-067D-11D0-95D8-00A02463AB28}
// *********************************************************************//
  IScriptModuleCollection = interface(IDispatch)
    ['{70841C6F-067D-11D0-95D8-00A02463AB28}']
    function Get__NewEnum: IUnknown; safecall;
    function Get_Item(Index: OleVariant): IScriptModule; safecall;
    function Get_Count: Integer; safecall;
    function Add(const Name: WideString; var Object_: OleVariant): IScriptModule; safecall;
    property _NewEnum: IUnknown read Get__NewEnum;
    property Item[Index: OleVariant]: IScriptModule read Get_Item; default;
    property Count: Integer read Get_Count;
  end;

// *********************************************************************//
// DispIntf:  IScriptModuleCollectionDisp
// Flags:     (4560) Hidden Dual NonExtensible OleAutomation Dispatchable
// GUID:      {70841C6F-067D-11D0-95D8-00A02463AB28}
// *********************************************************************//
  IScriptModuleCollectionDisp = dispinterface
    ['{70841C6F-067D-11D0-95D8-00A02463AB28}']
    property _NewEnum: IUnknown readonly dispid -4;
    property Item[Index: OleVariant]: IScriptModule readonly dispid 0; default;
    property Count: Integer readonly dispid 1;
    function Add(const Name: WideString; var Object_: OleVariant): IScriptModule; dispid 2;
  end;

// *********************************************************************//
// Interface: IScriptError
// Flags:     (4560) Hidden Dual NonExtensible OleAutomation Dispatchable
// GUID:      {70841C78-067D-11D0-95D8-00A02463AB28}
// *********************************************************************//
  IScriptError = interface(IDispatch)
    ['{70841C78-067D-11D0-95D8-00A02463AB28}']
    function Get_Number: Integer; safecall;
    function Get_Source: WideString; safecall;
    function Get_Description: WideString; safecall;
    function Get_HelpFile: WideString; safecall;
    function Get_HelpContext: Integer; safecall;
    function Get_Text: WideString; safecall;
    function Get_Line: Integer; safecall;
    function Get_Column: Integer; safecall;
    procedure Clear; safecall;
    property Number: Integer read Get_Number;
    property Source: WideString read Get_Source;
    property Description: WideString read Get_Description;
    property HelpFile: WideString read Get_HelpFile;
    property HelpContext: Integer read Get_HelpContext;
    property Text: WideString read Get_Text;
    property Line: Integer read Get_Line;
    property Column: Integer read Get_Column;
  end;

// *********************************************************************//
// DispIntf:  IScriptErrorDisp
// Flags:     (4560) Hidden Dual NonExtensible OleAutomation Dispatchable
// GUID:      {70841C78-067D-11D0-95D8-00A02463AB28}
// *********************************************************************//
  IScriptErrorDisp = dispinterface
    ['{70841C78-067D-11D0-95D8-00A02463AB28}']
    property Number: Integer readonly dispid 201;
    property Source: WideString readonly dispid 202;
    property Description: WideString readonly dispid 203;
    property HelpFile: WideString readonly dispid 204;
    property HelpContext: Integer readonly dispid 205;
    property Text: WideString readonly dispid -517;
    property Line: Integer readonly dispid 206;
    property Column: Integer readonly dispid -529;
    procedure Clear; dispid 208;
  end;

// *********************************************************************//
// Interface: IScriptControl
// Flags:     (4560) Hidden Dual NonExtensible OleAutomation Dispatchable
// GUID:      {0E59F1D3-1FBE-11D0-8FF2-00A0D10038BC}
// *********************************************************************//
  IScriptControl = interface(IDispatch)
    ['{0E59F1D3-1FBE-11D0-8FF2-00A0D10038BC}']
    function Get_Language: WideString; safecall;
    procedure Set_Language(const pbstrLanguage: WideString); safecall;
    function Get_State: ScriptControlStates; safecall;
    procedure Set_State(pssState: ScriptControlStates); safecall;
    procedure Set_SitehWnd(phwnd: Integer); safecall;
    function Get_SitehWnd: Integer; safecall;
    function Get_Timeout: Integer; safecall;
    procedure Set_Timeout(plMilleseconds: Integer); safecall;
    function Get_AllowUI: WordBool; safecall;
    procedure Set_AllowUI(pfAllowUI: WordBool); safecall;
    function Get_UseSafeSubset: WordBool; safecall;
    procedure Set_UseSafeSubset(pfUseSafeSubset: WordBool); safecall;
    function Get_Modules: IScriptModuleCollection; safecall;
    function Get_Error: IScriptError; safecall;
    function Get_CodeObject: IDispatch; safecall;
    function Get_Procedures: IScriptProcedureCollection; safecall;
    procedure _AboutBox; safecall;
    procedure AddObject(const Name: WideString; const Object_: IDispatch; AddMembers: WordBool); safecall;
    procedure Reset; safecall;
    procedure AddCode(const Code: WideString); safecall;
    function Eval(const Expression: WideString): OleVariant; safecall;
    procedure ExecuteStatement(const Statement: WideString); safecall;
    function Run(const ProcedureName: WideString; var Parameters: PSafeArray): OleVariant; safecall;
    property Language: WideString read Get_Language write Set_Language;
    property State: ScriptControlStates read Get_State write Set_State;
    property SitehWnd: Integer read Get_SitehWnd write Set_SitehWnd;
    property Timeout: Integer read Get_Timeout write Set_Timeout;
    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.

RegExp.vbs

function GetUrlFile(Url)
    Set RegObject = New RegExp 
    With RegObject
    .Pattern = "w+.w+(?!.)"
    .IgnoreCase = True
    .Global = True
    End With
    Set matchs =  RegObject.Execute(Url)
    If matchs.Count > 0 Then
        For Each mach in matchs
            GetUrlFile=mach.value
        Next
    End If
    Set RegObject = nothing
end function 

Unit_FormMain.pas

unit Unit_FormMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls;

type
  TFormMain = class(TForm)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    TabSheet3: TTabSheet;
    mmo_result: TMemo;
    Button1: TButton;
    mmo_FunGetUrlFile: TMemo;
    edt_formula: TEdit;
    Button2: TButton;
    mmo_FileDirCode: TMemo;
    edt_www: TEdit;
    edt_input: TEdit;
    Button3: TButton;
    Label1: TLabel;
    Label2: TLabel;
    edt_output: TEdit;
    edt_result: TEdit;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    function CallFunction(a_strCode, a_strProcName: WideString;
      const a_Params: oleVariant; IsVBScript: Boolean= True): OleVariant;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FormMain: TFormMain;

implementation

uses MSScriptControl_TLB, ActiveX;

{$R *.dfm}

function TFormMain.CallFunction(a_strCode, a_strProcName: WideString;
  const a_Params: oleVariant; IsVBScript: Boolean): OleVariant;
var
  Parameters: PSafeArray;
  l_Script: TScriptControl;
begin
  //mmo_FunGetUrlFile.Lines.LoadFromFile('RegExp.vbs');
  l_Script:= TScriptControl.Create(nil);
  if IsVBScript then l_Script.Language := 'VbScript'
  else l_Script.Language := 'JScript';
  l_Script.AllowUI:= True;
  l_Script.AddCode(a_strCode);
  try
    // 转化为安全数组
    Parameters := PSafeArray(TVarData(a_Params).VArray);
    // 调用函数
    Result := l_Script.Run(a_strProcName, Parameters);
  except
    Application.MessageBox(PChar(string('出错代码:'+l_Script.Error.Text+#13#10+
      '出错行:'+ IntToStr(l_Script.Error.Line)+#13#10+
      '出错原因:'+ l_Script.Error.Description)),'ERROR', MB_ICONEXCLAMATION);
  end;
  l_Script.Free;
end;

procedure TFormMain.Button1Click(Sender: TObject);
var
  a_var: OleVariant;
begin
  a_var := VarArrayCreate([0, 0], varVariant);
  a_var[0] := edt_www.Text;
  mmo_result.Lines.Add(CallFunction(mmo_FunGetUrlFile.Text, 'GetUrlFile', a_var));
end;

function Calculate(a_strFormula: string):Double;
var
  Script: TScriptControl;
begin
  try
    Script := TScriptControl.Create(nil);
    Script.Language := 'VbScript';
    Result := Script.Eval(a_strFormula);
  except
    result := 0;
  end;
end;

procedure TFormMain.Button2Click(Sender: TObject);
var
  ret: Double;
begin
  ret:= Calculate(edt_formula.Text);
  edt_result.Text:= FloatToStr(ret);
end;

procedure TFormMain.Button3Click(Sender: TObject);
var
  a_var: OleVariant;
begin
  a_var := VarArrayCreate([0, 0], varVariant);
  a_var[0] := edt_input.Text;
  edt_output.Text:= CallFunction(mmo_FileDirCode.Text, 'ParseFileDir', a_var, False);
end;

end.

Unit_FormMain.dfm

object FormMain: TFormMain
  Left = 361
  Top = 224
  Width = 452
  Height = 411
  Caption = 'MS ScriptControl Demo'
  Color = clBtnFace
  Font.Charset = GB2312_CHARSET
  Font.Color = clWindowText
  Font.Height = -12
  Font.Name = #23435#20307
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 12
  object PageControl1: TPageControl
    Left = 0
    Top = 0
    Width = 444
    Height = 376
    ActivePage = TabSheet2
    Align = alClient
    TabIndex = 1
    TabOrder = 0
    object TabSheet1: TTabSheet
      Caption = #20989#25968#35299#26512
      object Label1: TLabel
        Left = 0
        Top = 201
        Width = 24
        Height = 12
        Caption = #20256#20837
      end
      object Label2: TLabel
        Left = 0
        Top = 223
        Width = 24
        Height = 12
        Caption = #20256#20986
      end
      object mmo_FileDirCode: TMemo
        Left = 0
        Top = 0
        Width = 436
        Height = 193
        Align = alTop
        HideSelection = False
        Lines.Strings = (
          'function ParseFileDir(a_strFileName)'
          '{    '
          '  var l_FunNo;'
          '  var l_BaseDir;'
          '  var result;'
          '  l_BaseDir = "D:\X'#39033#30446'\";'
          '  l_FunNo = a_strFileName.substring(0, 5);'
          '  result = l_BaseDir+l_FunNo + '#39'\'#39'+a_strFileName;'
          '  return result;'
          '}')
        ScrollBars = ssBoth
        TabOrder = 0
      end
      object Button3: TButton
        Left = 272
        Top = 196
        Width = 75
        Height = 25
        Caption = #36816#34892
        TabOrder = 1
        OnClick = Button3Click
      end
      object edt_input: TEdit
        Left = 36
        Top = 197
        Width = 230
        Height = 20
        TabOrder = 2
        Text = 'CF514_Tform_main_CHS.xml'
      end
      object edt_output: TEdit
        Left = 36
        Top = 221
        Width = 230
        Height = 20
        TabOrder = 3
      end
    end
    object TabSheet2: TTabSheet
      Caption = #35745#31639#20844#24335
      ImageIndex = 1
      object edt_formula: TEdit
        Left = 24
        Top = 24
        Width = 257
        Height = 20
        TabOrder = 0
        Text = 'LOG(SQR(1+2)+3)'
      end
      object Button2: TButton
        Left = 24
        Top = 56
        Width = 75
        Height = 25
        Caption = #35745#31639
        TabOrder = 1
        OnClick = Button2Click
      end
      object edt_result: TEdit
        Left = 24
        Top = 96
        Width = 257
        Height = 20
        TabOrder = 2
      end
    end
    object TabSheet3: TTabSheet
      Caption = #27491#21017#34920#36798#24335
      ImageIndex = 2
      object mmo_result: TMemo
        Left = 0
        Top = 226
        Width = 425
        Height = 118
        TabOrder = 0
      end
      object Button1: TButton
        Left = 350
        Top = 197
        Width = 75
        Height = 25
        Caption = #36816#34892
        TabOrder = 1
        OnClick = Button1Click
      end
      object mmo_FunGetUrlFile: TMemo
        Left = 0
        Top = 0
        Width = 425
        Height = 193
        Lines.Strings = (
          'function GetUrlFile(Url)'
          '    Set RegObject = New RegExp '
          '    With RegObject'
          '    .Pattern = "w+.w+(?!.)"'
          '    .IgnoreCase = True'
          '    .Global = True'
          '    End With'
          '    Set matchs =  RegObject.Execute(Url)'
          '    If matchs.Count > 0 Then'
          '        For Each mach in matchs'
          '            GetUrlFile=mach.value'
          '        Next'
          '    End If'
          '    Set RegObject = nothing'
          'end function ')
        ScrollBars = ssBoth
        TabOrder = 2
      end
      object edt_www: TEdit
        Left = 0
        Top = 200
        Width = 348
        Height = 20
        TabOrder = 3
        Text = 'http://blog.csdn.net/jie115/archive/2004/09/15/104900.aspx'
      end
    end
  end
end