2014年4月 Delphi大版内专家分月排行榜第三2014年3月 Delphi大版内专家分月排行榜第三2013年5月 Delphi大版内专家分月排行榜第三2013年1月 Delphi大版内专家分月排行榜第三2010年11月 Delphi大版内专家分月排行榜第三2009年12月 Delphi大版内专家分月排行榜第三2009年11月 Delphi大版内专家分月排行榜第三
2012年4月 Delphi大版内专家分月排行榜第二2012年3月 Delphi大版内专家分月排行榜第二2012年1月 Delphi大版内专家分月排行榜第二2011年11月 Delphi大版内专家分月排行榜第二
2012年2月 Delphi大版内专家分月排行榜第三
2011年10月 其他开发语言大版内专家分月排行榜第三2010年8月 其他开发语言大版内专家分月排行榜第三2007年5月 其他开发语言大版内专家分月排行榜第三
本帖子已过去太久远了，不再提供回复功能。如何在程序中执行动态生成的Delphi代码
我的图书馆
如何在程序中执行动态生成的Delphi代码
如何在程序中执行动态生成的Delphi代码&
经常发现有人提这类问题，或者提问内容最后归结成这种问题&
前些阵子有位高手写了一个“执行动态生成的代码”，这是真正的高手，我没那种功力，我只会投机取巧。&
这里提供三种方法，都是借助第三方的组件来实现的。&
1、MicroSoft Windows Script Control（/downloads/details.aspx?FamilyID=d7e-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.R&
& &计算公式：ShowMessage(DCScripter1.Evaluate('1+1'));&
& &优点：VCL的，除支持微软的脚本以外，还支持Perl，Python&
& &缺点：还是不支持Object Pascal...（别打，就来了...）&
3、DelphiWebScriptII（http://prdownloads.sourceforge.net/dws/dws2src11.zip）&
& &这个东西好啊，功能超强，太强了，太强了，真强...&
& &安装完成以后，将TDelphiWebScriptII，Tdws2GUIFunctions加入窗体，引用dws2Exprs单元。&
& &运行脚本：&
& & &prg: TP&
& & &prg := pile('ShowMessage(''hi'');');&
& & &prg.E&
& &这个东西是用稍微复杂一点，不过看看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
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}
uses Windows, ActiveX, Classes, Graphics, OleCtrls, OleServer, StdVCL, V
// *********************************************************************//
// GUIDS declared in the TypeLibrary. Following prefixes are used:
Type Libraries
: LIBID_xxxx
: CLASS_xxxx
DISPInterfaces
: DIID_xxxx
Non-DISP interfaces: IID_xxxx
// *********************************************************************//
// TypeLibrary Major and minor versions
MSScriptControlMajorVersion = 1;
MSScriptControlMinorVersion = 0;
LIBID_MSScriptControl: TGUID = '{0E59F1D2-1FBE-11D0-8FF2-00A0D10038BC}';
IID_IScriptProcedure: TGUID = '{D-11D0-95D8-00A02463AB28}';
IID_IScriptProcedureCollection: TGUID = '{D-11D0-95D8-00A02463AB28}';
IID_IScriptModule: TGUID = '{D-11D0-95D8-00A02463AB28}';
IID_IScriptModuleCollection: TGUID = '{7D-11D0-95D8-00A02463AB28}';
IID_IScriptError: TGUID = '{D-11D0-95D8-00A02463AB28}';
IID_IScriptControl: TGUID = '{0E59F1D3-1FBE-11D0-8FF2-00A0D10038BC}';
DIID_DScriptControlSource: TGUID = '{8B167D60--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
ScriptControlStates = TOleE
Initialized = $;
Connected = $;
// *********************************************************************//
// Forward declaration of types defined in TypeLibrary
// *********************************************************************//
IScriptProcedure =
IScriptProcedureDisp =
IScriptProcedureCollection =
IScriptProcedureCollectionDisp =
IScriptModule =
IScriptModuleDisp =
IScriptModuleCollection =
IScriptModuleCollectionDisp =
IScriptError =
IScriptErrorDisp =
IScriptControl =
IScriptControlDisp =
DScriptControlSource =
// *********************************************************************//
// Declaration of CoClasses defined in Type Library
// (NOTE: Here we map each CoClass to its Default Interface)
// *********************************************************************//
Procedure_ = IScriptP
Procedures = IScriptProcedureC
Module = IScriptM
Modules = IScriptModuleC
Error = IScriptE
ScriptControl = IScriptC
// *********************************************************************//
// Declaration of structures, unions and aliases.
// *********************************************************************//
PPSafeArray1 = ^PSafeA {*}
POleVariant1 = ^OleV {*}
// *********************************************************************//
// Interface: IScriptProcedure
(4560) Hidden Dual NonExtensible OleAutomation Dispatchable
{D-11D0-95D8-00A02463AB28}
// *********************************************************************//
IScriptProcedure = interface(IDispatch)
['{D-11D0-95D8-00A02463AB28}']
function Get_Name: WideS
function Get_NumArgs: I
function Get_HasReturnValue: WordB
property Name: WideString read Get_N
property NumArgs: Integer read Get_NumA
property HasReturnValue: WordBool read Get_HasReturnV
// *********************************************************************//
// DispIntf:
IScriptProcedureDisp
(4560) Hidden Dual NonExtensible OleAutomation Dispatchable
{D-11D0-95D8-00A02463AB28}
// *********************************************************************//
IScriptProcedureDisp = dispinterface
['{D-11D0-95D8-00A02463AB28}']
property Name: WideString readonly dispid 0;
property NumArgs: Integer readonly dispid 100;
property HasReturnValue: WordBool readonly dispid 101;
// *********************************************************************//
// Interface: IScriptProcedureCollection
(4560) Hidden Dual NonExtensible OleAutomation Dispatchable
{D-11D0-95D8-00A02463AB28}
// *********************************************************************//
IScriptProcedureCollection = interface(IDispatch)
['{D-11D0-95D8-00A02463AB28}']
function Get__NewEnum: IU
function Get_Item(Index: OleVariant): IScriptP
function Get_Count: I
property _NewEnum: IUnknown read Get__NewE
property Item[Index: OleVariant]: IScriptProcedure read Get_I
property Count: Integer read Get_C
// *********************************************************************//
// DispIntf:
IScriptProcedureCollectionDisp
(4560) Hidden Dual NonExtensible OleAutomation Dispatchable
{D-11D0-95D8-00A02463AB28}
// *********************************************************************//
IScriptProcedureCollectionDisp = dispinterface
['{D-11D0-95D8-00A02463AB28}']
property _NewEnum: IUnknown readonly dispid -4;
property Item[Index: OleVariant]: IScriptProcedure readonly dispid 0;
property Count: Integer readonly dispid 1;
// *********************************************************************//
// Interface: IScriptModule
(4560) Hidden Dual NonExtensible OleAutomation Dispatchable
{D-11D0-95D8-00A02463AB28}
// *********************************************************************//
IScriptModule = interface(IDispatch)
['{D-11D0-95D8-00A02463AB28}']
function Get_Name: WideS
function Get_CodeObject: ID
function Get_Procedures: IScriptProcedureC
procedure AddCode(const Code: WideString);
function Eval(const Expression: WideString): OleV
procedure ExecuteStatement(const Statement: WideString);
function Run(const ProcedureName: WideS var Parameters: PSafeArray): OleV
property Name: WideString read Get_N
property CodeObject: IDispatch read Get_CodeO
property Procedures: IScriptProcedureCollection read Get_P
// *********************************************************************//
// DispIntf:
IScriptModuleDisp
(4560) Hidden Dual NonExtensible OleAutomation Dispatchable
{D-11D0-95D8-00A02463AB28}
// *********************************************************************//
IScriptModuleDisp = dispinterface
['{D-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): OleV dispid 2001;
procedure ExecuteStatement(const Statement: WideString); dispid 2002;
function Run(const ProcedureName: WideS var Parameters: {??PSafeArray}OleVariant): OleV dispid 2003;
// *********************************************************************//
// Interface: IScriptModuleCollection
(4560) Hidden Dual NonExtensible OleAutomation Dispatchable
{7D-11D0-95D8-00A02463AB28}
// *********************************************************************//
IScriptModuleCollection = interface(IDispatch)
['{7D-11D0-95D8-00A02463AB28}']
function Get__NewEnum: IU
function Get_Item(Index: OleVariant): IScriptM
function Get_Count: I
function Add(const Name: WideS var Object_: OleVariant): IScriptM
property _NewEnum: IUnknown read Get__NewE
property Item[Index: OleVariant]: IScriptModule read Get_I
property Count: Integer read Get_C
// *********************************************************************//
// DispIntf:
IScriptModuleCollectionDisp
(4560) Hidden Dual NonExtensible OleAutomation Dispatchable
{7D-11D0-95D8-00A02463AB28}
// *********************************************************************//
IScriptModuleCollectionDisp = dispinterface
['{7D-11D0-95D8-00A02463AB28}']
property _NewEnum: IUnknown readonly dispid -4;
property Item[Index: OleVariant]: IScriptModule readonly dispid 0;
property Count: Integer readonly dispid 1;
function Add(const Name: WideS var Object_: OleVariant): IScriptM dispid 2;
// *********************************************************************//
// Interface: IScriptError
(4560) Hidden Dual NonExtensible OleAutomation Dispatchable
{D-11D0-95D8-00A02463AB28}
// *********************************************************************//
IScriptError = interface(IDispatch)
['{D-11D0-95D8-00A02463AB28}']
function Get_Number: I
function Get_Source: WideS
function Get_Description: WideS
function Get_HelpFile: WideS
function Get_HelpContext: I
function Get_Text: WideS
function Get_Line: I
function Get_Column: I
procedure C
property Number: Integer read Get_N
property Source: WideString read Get_S
property Description: WideString read Get_D
property HelpFile: WideString read Get_HelpF
property HelpContext: Integer read Get_HelpC
property Text: WideString read Get_T
property Line: Integer read Get_L
property Column: Integer read Get_C
// *********************************************************************//
// DispIntf:
IScriptErrorDisp
(4560) Hidden Dual NonExtensible OleAutomation Dispatchable
{D-11D0-95D8-00A02463AB28}
// *********************************************************************//
IScriptErrorDisp = dispinterface
['{D-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 C dispid 208;
// *********************************************************************//
// Interface: IScriptControl
(4560) Hidden Dual NonExtensible OleAutomation Dispatchable
{0E59F1D3-1FBE-11D0-8FF2-00A0D10038BC}
// *********************************************************************//
IScriptControl = interface(IDispatch)
['{0E59F1D3-1FBE-11D0-8FF2-00A0D10038BC}']
function Get_Language: WideS
procedure Set_Language(const pbstrLanguage: WideString);
function Get_State: ScriptControlS
procedure Set_State(pssState: ScriptControlStates);
procedure Set_SitehWnd(phwnd: Integer);
function Get_SitehWnd: I
function Get_Timeout: I
procedure Set_Timeout(plMilleseconds: Integer);
function Get_AllowUI: WordB
procedure Set_AllowUI(pfAllowUI: WordBool);
function Get_UseSafeSubset: WordB
procedure Set_UseSafeSubset(pfUseSafeSubset: WordBool);
function Get_Modules: IScriptModuleC
function Get_Error: IScriptE
function Get_CodeObject: ID
function Get_Procedures: IScriptProcedureC
procedure _AboutB
procedure AddObject(const Name: WideS const Object_: ID AddMembers: WordBool);
procedure R
procedure AddCode(const Code: WideString);
function Eval(const Expression: WideString): OleV
procedure ExecuteStatement(const Statement: WideString);
function Run(const ProcedureName: WideS var Parameters: PSafeArray): OleV
property Language: WideString read Get_Language write Set_L
property State: ScriptControlStates read Get_State write Set_S
property SitehWnd: Integer read Get_SitehWnd write Set_SitehW
property Timeout: Integer read Get_Timeout write Set_T
property AllowUI: WordBool read Get_AllowUI write Set_AllowUI;
property UseSafeSubset: WordBool read Get_UseSafeSubset write Set_UseSafeS
property Modules: IScriptModuleCollection read Get_M
property Error: IScriptError read Get_E
property CodeObject: IDispatch read Get_CodeO
property Procedures: IScriptProcedureCollection read Get_P
// *********************************************************************//
// DispIntf:
IScriptControlDisp
(4560) Hidden Dual NonExtensible OleAutomation Dispatchable
{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 _AboutB dispid -552;
procedure AddObject(const Name: WideS const Object_: ID AddMembers: WordBool); dispid 2500;
procedure R dispid 2501;
procedure AddCode(const Code: WideString); dispid 2000;
function Eval(const Expression: WideString): OleV dispid 2001;
procedure ExecuteStatement(const Statement: WideString); dispid 2002;
function Run(const ProcedureName: WideS var Parameters: {??PSafeArray}OleVariant): OleV dispid 2003;
// *********************************************************************//
// DispIntf:
DScriptControlSource
(4112) Hidden Dispatchable
{8B167D60--ABCB-00A0C90FFFC0}
// *********************************************************************//
DScriptControlSource = dispinterface
['{8B167D60--ABCB-00A0C90FFFC0}']
procedure E dispid 3000;
procedure T dispid 3001;
// *********************************************************************//
// 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: IScriptP
class function CreateRemote(const MachineName: string): IScriptP
// *********************************************************************//
// 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: IScriptProcedureC
class function CreateRemote(const MachineName: string): IScriptProcedureC
// *********************************************************************//
// 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: IScriptM
class function CreateRemote(const MachineName: string): IScriptM
// *********************************************************************//
// 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: IScriptModuleC
class function CreateRemote(const MachineName: string): IScriptModuleC
// *********************************************************************//
// 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: IScriptE
class function CreateRemote(const MachineName: string): IScriptE
// *********************************************************************//
// 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
Interface: DScriptControlSource
// TypeFlags
: (34) CanCreate Control
// *********************************************************************//
TScriptControl = class(TOleControl)
FOnError: TNotifyE
FOnTimeout: TNotifyE
FIntf: IScriptC
GetControlInterface: IScriptC
procedure CreateC
procedure InitControlD
function Get_Modules: IScriptModuleC
function Get_Error: IScriptE
function Get_CodeObject: ID
function Get_Procedures: IScriptProcedureC
procedure _AboutB
procedure AddObject(const Name: WideS const Object_: ID AddMembers: WordBool);
procedure R
procedure AddCode(const Code: WideString);
function Eval(const Expression: WideString): OleV
procedure ExecuteStatement(const Statement: WideString);
function Run(const ProcedureName: WideS var Parameters: PSafeArray): OleV
ControlInterface: IScriptControl read GetControlI
DefaultInterface: IScriptControl read GetControlI
property Modules: IScriptModuleCollection read Get_M
property Error: IScriptError read Get_E
property CodeObject: IDispatch index 1000 read GetIDispatchP
property Procedures: IScriptProcedureCollection read Get_P
property Language: WideString index 1500 read GetWideStringProp write SetWideStringProp stored F
property State: TOleEnum index 1501 read GetTOleEnumProp write SetTOleEnumProp stored F
property SitehWnd: Integer index 1502 read GetIntegerProp write SetIntegerProp stored F
property Timeout: Integer index 1503 read GetIntegerProp write SetIntegerProp stored F
property AllowUI: WordBool index 1504 read GetWordBoolProp write SetWordBoolProp stored F
property UseSafeSubset: WordBool index 1505 read GetWordBoolProp write SetWordBoolProp stored F
property OnError: TNotifyEvent read FOnError write FOnE
property OnTimeout: TNotifyEvent read FOnTimeout write FOnT
procedure R
resourcestring
dtlServerPage = 'ActiveX';
implementation
class function CoProcedure_.Create: IScriptP
Result := CreateComObject(CLASS_Procedure_) as IScriptP
class function CoProcedure_.CreateRemote(const MachineName: string): IScriptP
Result := CreateRemoteComObject(MachineName, CLASS_Procedure_) as IScriptP
class function CoProcedures.Create: IScriptProcedureC
Result := CreateComObject(CLASS_Procedures) as IScriptProcedureC
class function CoProcedures.CreateRemote(const MachineName: string): IScriptProcedureC
Result := CreateRemoteComObject(MachineName, CLASS_Procedures) as IScriptProcedureC
class function CoModule.Create: IScriptM
Result := CreateComObject(CLASS_Module) as IScriptM
class function CoModule.CreateRemote(const MachineName: string): IScriptM
Result := CreateRemoteComObject(MachineName, CLASS_Module) as IScriptM
class function CoModules.Create: IScriptModuleC
Result := CreateComObject(CLASS_Modules) as IScriptModuleC
class function CoModules.CreateRemote(const MachineName: string): IScriptModuleC
Result := CreateRemoteComObject(MachineName, CLASS_Modules) as IScriptModuleC
class function CoError.Create: IScriptE
Result := CreateComObject(CLASS_Error) as IScriptE
class function CoError.CreateRemote(const MachineName: string): IScriptE
Result := CreateRemoteComObject(MachineName, CLASS_Error) as IScriptE
procedure TScriptControl.InitControlD
CEventDispIDs: array [0..1] of DWORD = (
$00000BB8, $00000BB9);
CControlData: TControlData2 = (
ClassID: '{0E59F1D5-1FBE-11D0-8FF2-00A0D10038BC}';
EventIID: '{8B167D60--ABCB-00A0C90FFFC0}';
EventCount: 2;
EventDispIDs: @CEventDispIDs;
LicenseKey: nil (*HR:$*);
Version: 401);
ControlData := @CControlD
TControlData2(CControlData).FirstEventOfs := Cardinal(@@FOnError) - Cardinal(Self);
procedure TScriptControl.CreateC
procedure DoC
FIntf := IUnknown(OleObject) as IScriptC
if FIntf = nil then DoC
function TScriptControl.GetControlInterface: IScriptC
Result := FI
function TScriptControl.Get_Modules: IScriptModuleC
Result := DefaultInterface.M
function TScriptControl.Get_Error: IScriptE
Result := DefaultInterface.E
function TScriptControl.Get_CodeObject: ID
Result := DefaultInterface.CodeO
function TScriptControl.Get_Procedures: IScriptProcedureC
Result := DefaultInterface.P
procedure TScriptControl._AboutB
DefaultInterface._AboutB
procedure TScriptControl.AddObject(const Name: WideS const Object_: ID
AddMembers: WordBool);
DefaultInterface.AddObject(Name, Object_, AddMembers);
procedure TScriptControl.R
DefaultInterface.R
procedure TScriptControl.AddCode(const Code: WideString);
DefaultInterface.AddCode(Code);
function TScriptControl.Eval(const Expression: WideString): OleV
Result := DefaultInterface.Eval(Expression);
procedure TScriptControl.ExecuteStatement(const Statement: WideString);
DefaultInterface.ExecuteStatement(Statement);
function TScriptControl.Run(const ProcedureName: WideS var Parameters: PSafeArray): OleV
Result := DefaultInterface.Run(ProcedureName, Parameters);
procedure R
RegisterComponents('ActiveX',[TScriptControl]);
RegExp.vbs
function GetUrlFile(Url)
Set RegObject = New RegExp
With RegObject
.Pattern = &\w+\.\w+(?!.)&
.IgnoreCase = True
.Global = True
Set matchs =
RegObject.Execute(Url)
If matchs.Count & 0 Then
For Each mach in matchs
GetUrlFile=mach.value
Set RegObject = nothing
end function
Unit_FormMain.pas
unit Unit_FormM
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComC
TFormMain = class(TForm)
PageControl1: TPageC
TabSheet1: TTabS
TabSheet2: TTabS
TabSheet3: TTabS
mmo_result: TM
Button1: TB
mmo_FunGetUrlFile: TM
edt_formula: TE
Button2: TB
mmo_FileDirCode: TM
edt_www: TE
edt_input: TE
Button3: TB
Label1: TL
Label2: TL
edt_output: TE
edt_result: TE
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
function CallFunction(a_strCode, a_strProcName: WideS
const a_Params: oleV IsVBScript: Boolean= True): OleV
{ Private declarations }
{ Public declarations }
FormMain: TFormM
implementation
uses MSScriptControl_TLB, ActiveX;
{$R *.dfm}
function TFormMain.CallFunction(a_strCode, a_strProcName: WideS
const a_Params: oleV IsVBScript: Boolean): OleV
Parameters: PSafeA
l_Script: TScriptC
//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:= T
l_Script.AddCode(a_strCode);
// 转化为安全数组
Parameters := PSafeArray(TVarData(a_Params).VArray);
// 调用函数
Result := l_Script.Run(a_strProcName, Parameters);
Application.MessageBox(PChar(string('出错代码:'+l_Script.Error.Text+#13#10+
'出错行:'+ IntToStr(l_Script.Error.Line)+#13#10+
'出错原因:'+ l_Script.Error.Description)),'ERROR', MB_ICONEXCLAMATION);
l_Script.F
procedure TFormMain.Button1Click(Sender: TObject);
a_var: OleV
a_var := VarArrayCreate([0, 0], varVariant);
a_var[0] := edt_www.T
mmo_result.Lines.Add(CallFunction(mmo_FunGetUrlFile.Text, 'GetUrlFile', a_var));
function Calculate(a_strFormula: string):D
Script: TScriptC
Script := TScriptControl.Create(nil);
Script.Language := 'VbScript';
Result := Script.Eval(a_strFormula);
result := 0;
procedure TFormMain.Button2Click(Sender: TObject);
ret:= Calculate(edt_formula.Text);
edt_result.Text:= FloatToStr(ret);
procedure TFormMain.Button3Click(Sender: TObject);
a_var: OleV
a_var := VarArrayCreate([0, 0], varVariant);
a_var[0] := edt_input.T
edt_output.Text:= CallFunction(mmo_FileDirCode.Text, 'ParseFileDir', a_var, False);
Unit_FormMain.dfm
object FormMain: TFormMain
Left = 361
Width = 452
Height = 411
Caption = 'MS ScriptControl Demo'
Color = clBtnFace
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 12
object PageControl1: TPageControl
Width = 444
Height = 376
ActivePage = TabSheet2
Align = alClient
TabIndex = 1
TabOrder = 0
object TabSheet1: TTabSheet
Caption = ##
object Label1: TLabel
Width = 24
Height = 12
Caption = #
object Label2: TLabel
Width = 24
Height = 12
Caption = #
object mmo_FileDirCode: TMemo
Width = 436
Height = 193
Align = alTop
HideSelection = False
Lines.Strings = (
'function ParseFileDir(a_strFileName)'
var l_FunNo;'
var l_BaseD'
''
l_BaseDir = &D:\\X'#'\\&;'
l_FunNo = a_strFileName.substring(0, 5);'
result = l_BaseDir+l_FunNo + '#39'\\'#39'+a_strFileN'
''
'}')
ScrollBars = ssBoth
TabOrder = 0
object Button3: TButton
Left = 272
Width = 75
Height = 25
Caption = #
TabOrder = 1
OnClick = Button3Click
object edt_input: TEdit
Width = 230
Height = 20
TabOrder = 2
Text = 'CF514_Tform_main_CHS.xml'
object edt_output: TEdit
Width = 230
Height = 20
TabOrder = 3
object TabSheet2: TTabSheet
Caption = ##
ImageIndex = 1
object edt_formula: TEdit
Width = 257
Height = 20
TabOrder = 0
Text = 'LOG(SQR(1+2)+3)'
object Button2: TButton
Width = 75
Height = 25
Caption = #
TabOrder = 1
OnClick = Button2Click
object edt_result: TEdit
Width = 257
Height = 20
TabOrder = 2
object TabSheet3: TTabSheet
Caption = ###24335
ImageIndex = 2
object mmo_result: TMemo
Width = 425
Height = 118
TabOrder = 0
object Button1: TButton
Left = 350
Width = 75
Height = 25
Caption = #
TabOrder = 1
OnClick = Button1Click
object mmo_FunGetUrlFile: TMemo
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'
End If'
Set RegObject = nothing'
'end function ')
ScrollBars = ssBoth
TabOrder = 2
object edt_www: TEdit
Width = 348
Height = 20
TabOrder = 3
Text = 'http://blog.csdn.net/jie115/archive//104900.aspx'
馆藏&23681
TA的最新馆藏[转]&
喜欢该文的人也喜欢