unit1.~pas

VBS解析_delphi.rar function ParseFileDir(a_strFileName) { var l_FunNo var l_BaseDir var res

unit Unit1;

interface

uses
  Windows,Messages,SysUtils,Variants,Classes,Graphics,Controls,Forms,
  Dialogs,RzButton,MSScriptControl_TLB,ComCtrls,ActiveX,StdCtrls,RzEdit,
  Mask, OleCtrls;
// Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
// Dialogs, StdCtrls, ComCtrls;

type
  TFormMain=class(TForm)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    Label1: TLabel;
    Label2: TLabel;
    mmo_FileDirCode: TMemo;
    Button_3: TButton;
    edt_input: TEdit;
    edt_output: TEdit;
    TabSheet2: TTabSheet;
    edt_formula: TEdit;
    Button_2: TButton;
    edt_result: TEdit;
    TabSheet3: TTabSheet;
    mmo_result: TMemo;
    Button_1: TButton;
    mmo_FunGetUrlFile: TMemo;
    edt_www: TEdit;
    ScriptControl1: TScriptControl;
    //    procedure RzBitBtn1Click(Sender:TObject);
//    procedure RzBitBtn_1Click(Sender:TObject);
  //  procedure RzBitBtn_2Click(Sender:TObject);
   // procedure RzBitBtn_3Click(Sender:TObject);
    procedure Button_3Click(Sender: TObject);
    procedure Button_2Click(Sender: TObject);
    procedure Button_1Click(Sender: TObject);
  private
    function CallFunction(a_strCode,a_strProcName:WideString;
      const a_Params:oleVariant;IsVBScript:Boolean=True):OleVariant;
  public
    { Public declarations }
  end;

var
  FormMain          :TFormMain;

implementation

{$R *.dfm}

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

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

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

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

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