如何在程序中执行动态生成的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:\WINNT\System32\msscript.ocx (1)

// LIBID: {0E59F1D2-1FBE-11D0-8FF2-00A0D10038BC}

// LCID: 0

// Helpfile: C:\WINNT\System32\MSSCRIPT.HLP

// DepndLst:

//   (1) v2.0 stdole, (C:\WINNT\system32\stdole2.tlb)

//   (2) v4.0 StdVCL, (C:\WINNT\system32\stdvcl40.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 = ;

  MSScriptControlMinorVersion = ;

  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 = $;

  Connected = $;

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 ;

    property NumArgs: Integer readonly dispid ;

    property HasReturnValue: WordBool readonly dispid ;

  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 -;

    property Item[Index: OleVariant]: IScriptProcedure readonly dispid ; default;

    property Count: Integer readonly dispid ;

  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 ;

    property CodeObject: IDispatch readonly dispid ;

    property Procedures: IScriptProcedureCollection readonly dispid ;

    procedure AddCode(const Code: WideString); dispid ;

    function Eval(const Expression: WideString): OleVariant; dispid ;

    procedure ExecuteStatement(const Statement: WideString); dispid ;

    function Run(const ProcedureName: WideString; var Parameters: {??PSafeArray}OleVariant): OleVariant; dispid ;

  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 -;

    property Item[Index: OleVariant]: IScriptModule readonly dispid ; default;

    property Count: Integer readonly dispid ;

    function Add(const Name: WideString; var Object_: OleVariant): IScriptModule; dispid ;

  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 ;

    property Source: WideString readonly dispid ;

    property Description: WideString readonly dispid ;

    property HelpFile: WideString readonly dispid ;

    property HelpContext: Integer readonly dispid ;

    property Text: WideString readonly dispid -;

    property Line: Integer readonly dispid ;

    property Column: Integer readonly dispid -;

    procedure Clear; dispid ;

  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 ;

    property State: ScriptControlStates dispid ;

    property SitehWnd: Integer dispid ;

    property Timeout: Integer dispid ;

    property AllowUI: WordBool dispid ;

    property UseSafeSubset: WordBool dispid ;

    property Modules: IScriptModuleCollection readonly dispid ;

    property Error: IScriptError readonly dispid ;

    property CodeObject: IDispatch readonly dispid ;

    property Procedures: IScriptProcedureCollection readonly dispid ;

    procedure _AboutBox; dispid -;

    procedure AddObject(const Name: WideString; const Object_: IDispatch; AddMembers: WordBool); dispid ;

    procedure Reset; dispid ;

    procedure AddCode(const Code: WideString); dispid ;

    function Eval(const Expression: WideString): OleVariant; dispid ;

    procedure ExecuteStatement(const Statement: WideString); dispid ;

    function Run(const ProcedureName: WideString; var Parameters: {??PSafeArray}OleVariant): OleVariant; dispid ;

  end;

// *********************************************************************//

// DispIntf:  DScriptControlSource

// Flags:     (4112) Hidden Dispatchable

// GUID:      {8B167D60-8605-11D0-ABCB-00A0C90FFFC0}

// *********************************************************************//

  DScriptControlSource = dispinterface

    ['{8B167D60-8605-11D0-ABCB-00A0C90FFFC0}']

    procedure Error; dispid ;

    procedure Timeout; dispid ;

  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  read GetIDispatchProp;

    property Procedures: IScriptProcedureCollection read Get_Procedures;

  published

    property Language: WideString index  read GetWideStringProp write SetWideStringProp stored False;

    property State: TOleEnum index  read GetTOleEnumProp write SetTOleEnumProp stored False;

    property SitehWnd: Integer index  read GetIntegerProp write SetIntegerProp stored False;

    property Timeout: Integer index  read GetIntegerProp write SetIntegerProp stored False;

    property AllowUI: WordBool index  read GetWordBoolProp write SetWordBoolProp stored False;

    property UseSafeSubset: WordBool index  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 [..] of DWORD = (

    $00000BB8, $00000BB9);

  CControlData: TControlData2 = (

    ClassID: '{0E59F1D5-1FBE-11D0-8FF2-00A0D10038BC}';

    EventIID: '{8B167D60-8605-11D0-ABCB-00A0C90FFFC0}';

    EventCount: ;

    EventDispIDs: @CEventDispIDs;

    LicenseKey: nil (*HR:$00000000*);

    Flags: $;

    Version: );

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 >  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+##+

      '出错行:'+ IntToStr(l_Script.Error.Line)+##+

      '出错原因:'+ 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([, ], varVariant);

  a_var[] := 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 := ;

  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([, ], varVariant);

  a_var[] := edt_input.Text;

  edt_output.Text:= CallFunction(mmo_FileDirCode.Text, 'ParseFileDir', a_var, False);

end;

end.

Unit_FormMain.dfm

object FormMain: TFormMain

  Left =

  Top =

  Width =

  Height =

  Caption = 'MS ScriptControl Demo'

  Color = clBtnFace

  Font.Charset = GB2312_CHARSET

  Font.Color = clWindowText

  Font.Height = -

  Font.Name = ##

  Font.Style = []

  OldCreateOrder = False

  PixelsPerInch =

  TextHeight =

  object PageControl1: TPageControl

    Left =

    Top =

    Width =

    Height =

    ActivePage = TabSheet2

    Align = alClient

    TabIndex =

    TabOrder =

    object TabSheet1: TTabSheet

      Caption = ####

      object Label1: TLabel

        Left =

        Top =

        Width =

        Height =

        Caption = ##

      end

      object Label2: TLabel

        Left =

        Top =

        Width =

        Height =

        Caption = ##

      end

      object mmo_FileDirCode: TMemo

        Left =

        Top =

        Width =

        Height =

        Align = alTop

        HideSelection = False

        Lines.Strings = (

          'function ParseFileDir(a_strFileName)'

          '{    '

          '  var l_FunNo;'

          '  var l_BaseDir;'

          '  var result;'

          '  l_BaseDir = "D:\\X'##'\\";'

          '  l_FunNo = a_strFileName.substring(0, 5);'

          '  result = l_BaseDir+l_FunNo + '#'\\'#'+a_strFileName;'

          '  return result;'

          '}')

        ScrollBars = ssBoth

        TabOrder =

      end

      object Button3: TButton

        Left =

        Top =

        Width =

        Height =

        Caption = ##

        TabOrder =

        OnClick = Button3Click

      end

      object edt_input: TEdit

        Left =

        Top =

        Width =

        Height =

        TabOrder =

        Text = 'CF514_Tform_main_CHS.xml'

      end

      object edt_output: TEdit

        Left =

        Top =

        Width =

        Height =

        TabOrder =

      end

    end

    object TabSheet2: TTabSheet

      Caption = ####

      ImageIndex =

      object edt_formula: TEdit

        Left =

        Top =

        Width =

        Height =

        TabOrder =

        Text = 'LOG(SQR(1+2)+3)'

      end

      object Button2: TButton

        Left =

        Top =

        Width =

        Height =

        Caption = ##

        TabOrder =

        OnClick = Button2Click

      end

      object edt_result: TEdit

        Left =

        Top =

        Width =

        Height =

        TabOrder =

      end

    end

    object TabSheet3: TTabSheet

      Caption = #####

      ImageIndex =

      object mmo_result: TMemo

        Left =

        Top =

        Width =

        Height =

        TabOrder =

      end

      object Button1: TButton

        Left =

        Top =

        Width =

        Height =

        Caption = ##

        TabOrder =

        OnClick = Button1Click

      end

      object mmo_FunGetUrlFile: TMemo

        Left =

        Top =

        Width =

        Height =

        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 =

      end

      object edt_www: TEdit

        Left =

        Top =

        Width =

        Height =

        TabOrder =

        Text = 'http://blog.csdn.net/jie115/archive/2004/09/15/104900.aspx'

      end

    end

  end

end

Delphi 如何在程序中执行动态生成的Delphi代码的更多相关文章

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

    如何在程序中执行动态生成的Delphi代码 经常发现有人提这类问题,或者提问内容最后归结成这种问题 前些阵子有位高手写了一个“执行动态生成的代码”,这是真正的高手,我没那种功力,我只会投机取巧. 这里 ...

  2. winform WebBrowser控件中，cs后台代码执行动态生成的js

    很多文章都是好介绍C# 后台cs和js如何交互,cs调用js方法(js方法必须是页面上存在的,已经定义好的),js调用cs方法, 但如果想用cs里面执行动态生成的js代码,如何实现呢? 思路大致是这样 ...

  3. Delphi 7 在程序中直接执行SQL脚本文件

    Delphi 7 在程序中直接执行SQL脚本文件 在处理MSDE一些操作中.需要执行一些SQL脚本.有的是从SQLServer 2000中生成的SQL为后缀的脚本.在MSDE中没有企业管理器,操作都是 ...

  4. 在Oracle中执行动态SQL的几种方法

    转载:在Oracle中执行动态SQL的几种方法 以下为内容留存: 在Oracle中执行动态SQL的几种方法 在一般的sql操作中,sql语句基本上都是固定的,如:SELECT t.empno,t.en ...

  5. 在Web应用程序中执行计划任务（多线程）

    在业务复杂的应用程序中,有时候会要求一个或者多个任务在一定的时间或者一定的时间间隔内计划进行,比如定时备份或同步数据库,定时发送电子邮件等,我们称之为计划任务.实现计划任务的方法也有很多,可以采用SQ ...

  6. jQuery EasyUI中DataGird动态生成列的方法

    EasyUI中使用DataGird显示数据列表中,有时需要根据需要显示不同的列,例如,在权限管理中,不同的用户登录后只能查看自己权限范围内的列表字段,这就需要DataGird动态组合列,下面介绍Eas ...

  7. C#和Java中执行SQL文件脚本的代码(非常有用)

    原文:C#和Java中执行SQL文件脚本的代码(非常有用) 我们在做程序的时候有事后会涉及到利用sql文件 直接执行,可是在sql文件中有很多注释,我们要一句一句的执行首先必须的得把sql文件解析 去 ...

  8. Java | 在 Java 中执行动态表达式语句: 前中后缀、Ognl、SpEL、Groovy、Jexl3

    在一些规则集或者工作流项目中,经常会遇到动态解析表达式并执行得出结果的功能. 规则引擎是一种嵌入在应用程序中的组件,它可以将业务规则从业务代码中剥离出来,使用预先定义好的语义规范来实现这些剥离出来的业 ...

  9. 区分execl与system——应用程序中执行命令

    execl:相关函数:fork, execle, execlp, execv, execve, execvp表头文件:#include <unistd.h>函数定义:int execl(c ...

随机推荐

  1. 002-JS-SDK开发使用,网页获取授权,扫一扫调用

    一.概述 在申请响应的公众号之后,实名认证或者企业认证之后,可以进行对应开发 二.开发步骤 2.1.开发前提[服务号]-域名设置 登录后台之后→左侧设置→公众号设置→功能设置,设置好“JS接口安全域名 ...

  2. jenkins之启动与关闭

    jenkins可以通过内置的应用服务器或者借助其他应用服务器启动 目录 1.启动jenkins 2.关闭jenkins 3.重启jenkins 4.重新加载jenkins配置信息 1.启动jenkin ...

  3. Jenkins 官网文档翻译汇总

    Jenkins 官网地址 Jenkins 官网文档地址 用户手册 安装 Jenkins 使用 Jenkins 使用凭证 Pipeline 流水线 开始使用 Pipeline 使用 Jenkinsfil ...

  4. 如何通过xmake进行交叉编译

    xmake 提供了方便灵活的交叉编译支持,大部分情况下,都不需要配置很复杂的toolchains前缀,例如:arm-linux- 什么的 只要这个toolchains目录满足如下结构(大部分的交叉工具 ...

  5. HTML5-注册表单案例fieldset

    <!DOCTYPE html> <html lang="en"> <head> <meta charset="UTF-8&quo ...

  6. DS-哈希表浅析

    1.哈希表 2.哈希函数 3.哈希冲突 哈希表 哈希表是一种按key-value存储的数据结构,也称散列表. 之前的数组.树和图等等查找一个值时都要与结构中的值相比较,查找的效率取决于比较的次数. 而 ...

  7. shell编程：awk基础

    语法格式: 一 awk 'BEGIN{}pattern{commands}END{}' file_name 二 standard output | awk 'BEGIN{}pattern{comman ...

  8. FireFox浏览器导出文件名乱码

    解决方案1 String codedFileName = "导出文件名.xls"; String agent = request.getHeader("USER-AGEN ...

  9. Struts2之下载

    下载页面 <%@ page language="java" contentType="text/html; charset=UTF-8" pageEnco ...

  10. Codeforces 1082D （贪心）

    题面 传送门 分析 贪心 将度限制大于1的点连成一条链,然后将度限制等于1的点挂上去 形状如下图,其中(1,2,3)为度数限制>1的点 显然直径长度=(度数限制>1的节点个数)-1+min ...