我正在尝试从dwscript内部执行此代码(这是使用CreateOleObject的最小样本)
function GetFileVersion(const FileName: string): string;
var
V : OleVariant;
begin
V := CreateOleObject('Scripting.FileSystemObject');
Result := V.GetFileVersion(FileName);
end;
到目前为止,我试过这个
{$APPTYPE CONSOLE}
{$R *.res}
uses
SysUtils,
ComObj,
ActiveX,
dwsComp,
dwsCompiler,
dwsExprs,
dwsCoreExprs;
procedure Execute;
var
LScript: TDelphiWebScript;
LUnit: TdwsUnit;
LProg: IdwsProgram;
LExec: IdwsProgramExecution;
begin
LScript := TDelphiWebScript.Create(NIL);
LUnit := TdwsUnit.Create(NIL);
try
LUnit.UnitName := 'Foo';
LUnit.Script := LScript;
// compile a simple script
LProg := LScript.Compile(
'function GetFileVersion(const FileName: string): string;'+sLineBreak+
'var'+sLineBreak+
' V : Variant;'+sLineBreak+
'begin'+sLineBreak+
' V := CreateOleObject(''Scripting.FileSystemObject'');'+sLineBreak+
' Result := V.GetFileVersion(FileName);'+sLineBreak+
'end;'+sLineBreak+
''+sLineBreak+
'PrintLn(GetFileVersion(''Foo''));'+sLineBreak+
''
);
if LProg.Msgs.HasErrors then begin
Writeln(LProg.Msgs.AsInfo);
Exit;
end;
try
LExec := LProg.Execute;
except
on E: Exception do
WriteLn(E.Message + sLineBreak + LExec.Msgs.AsInfo );
end;
Writeln(LExec.Result.ToString);
finally
LScript.Free;
end;
end;
begin
try
Execute;
Readln;
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
end.
但我收到此错误消息
语法错误:未知名称“CreateOleObject”[line:5,column:8]
问题是如何使用dwscript执行CreateOleObject
函数?
根据Linas建议,我终于可以解决问题了。
这是一个示例工作应用程序
uses
SysUtils,
ComObj,
ActiveX,
dwsComp,
dwsCompiler,
dwsExprs,
dwsComConnector,
dwsCoreExprs;
procedure Execute;
var
LScript: TDelphiWebScript;
LUnit: TdwsUnit;
LProg: IdwsProgram;
LExec: IdwsProgramExecution;
LdwsComConnector : TdwsComConnector;
begin
LScript := TDelphiWebScript.Create(NIL);
LdwsComConnector:=TdwsComConnector.Create(nil);
LdwsComConnector.Script:=LScript;
LUnit := TdwsUnit.Create(NIL);
try
LUnit.UnitName := 'Foo';
LUnit.Script := LScript;
// compile a simple script
LProg := LScript.Compile(
'function GetFileVersion(const FileName: string): string;'+sLineBreak+
'var'+sLineBreak+
' V : OleVariant;'+sLineBreak+
'begin'+sLineBreak+
' V := CreateOleObject(''Scripting.FileSystemObject'');'+sLineBreak+
' Result := VarToStr(V.GetFileVersion(FileName));'+sLineBreak+
'end;'+sLineBreak+
''+sLineBreak+
'PrintLn(GetFileVersion(''C:\Bar\Foo.exe''));'+sLineBreak+
''
);
if LProg.Msgs.HasErrors then begin
Writeln(LProg.Msgs.AsInfo);
Exit;
end;
try
LExec := LProg.Execute;
except
on E: Exception do
WriteLn(E.Message + sLineBreak + LExec.Msgs.AsInfo );
end;
Writeln(LExec.Result.ToString);
finally
LScript.Free;
LdwsComConnector.Free;
end;
end;
begin
try
CoInitialize(nil);
try
Execute;
Readln;
finally
CoUninitialize;
end;
except
on E:Exception do
Writeln(E.Classname, ':', E.Message);
end;
end.
答案 0 :(得分:2)
这可以通过两种方式实现。
1种方式:您必须将TdwsComConnector
(从单位dwsComConnector
)删除到您的数据模块或表单(或手动创建)并将脚本实例分配给它。 e.g:
dwsComConnector1.Script := LScript;
2路:
interface
uses
dwsFunctions, dwsSymbols, dwsExprs;
type
TCreateOleObjectFunc = class(TInternalFunction)
procedure Execute(info : TProgramInfo); override;
end;
implementation
uses
OleAuto;
{ TCreateOleObjectFunc }
procedure TCreateOleObjectFunc.Execute(info : TProgramInfo);
begin
Info.ResultAsVariant := CreateOleObject(Info.ValueAsString['ClassName']);
end;
initialization
RegisterInternalFunction(TCreateOleObjectFunc, 'CreateOleObject', ['ClassName', cString], cVariant, True);
这会将CreateOleObject函数暴露给DWScript,因此您可以使用它。
此外,您应将V
声明为OleVariant
而不是Variant
,并将该行更改为Result := VarToStr(V.GetFileVersion(FileName));
以使其正常工作。