如何在程序中执行动态生成的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.****.net/jie115/archive/2004/09/15/104900.aspx'
end
end
end
end