unit_formmain.pas

破解网页中的 VB.Encode 加密, 批量操作, 超快,爽

unit Unit_FormMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, ExtCtrls, FindFile;

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;
    TabSheet4: TTabSheet;
    Panel1: TPanel;
    Splitter1: TSplitter;
    Memo1: TMemo;
    Memo2: TMemo;
    Memo3: TMemo;
    Splitter2: TSplitter;
    Splitter3: TSplitter;
    Panel2: TPanel;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    Button7: TButton;
    Panel3: TPanel;
    ListBox1: TListBox;
    Panel4: TPanel;
    Edit1: TEdit;
    Edit2: TEdit;
    Label3: TLabel;
    Label4: TLabel;
    Button8: TButton;
    Edit3: TEdit;
    Label5: TLabel;
    FindFile1: TFindFile;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure FindFile1FileMatch(Sender: TObject; const Folder: String;
      const FileInfo: TSearchRec);
    procedure Button8Click(Sender: TObject);
    procedure ListBox1DblClick(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure FindFile1SearchFinish(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
  private
    function CallFunction(a_strCode, a_strProcName: WideString;
      const a_Params: oleVariant; IsVBScript: Boolean= True): OleVariant;
    { Private declarations }
  public
    { Public declarations }
    function callJsFunction(JsText,FunText,Intext : string; IsVBS : Boolean=False): string;
  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+#13#10+
      '出错行:'+ IntToStr(l_Script.Error.Line)+#13#10+
      '出错原因:'+ 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([0, 0], varVariant);
  a_var[0] := 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 := 0;
  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([0, 0], varVariant);
  a_var[0] := edt_input.Text;
  edt_output.Text:= CallFunction(mmo_FileDirCode.Text, 'ParseFileDir', a_var, False);
end;


















procedure TFormMain.FindFile1FileMatch(Sender: TObject;
  const Folder: String; const FileInfo: TSearchRec);
begin


  ListBox1.Items.Add(folder + FileInfo.Name)
end;

procedure TFormMain.Button8Click(Sender: TObject);
begin

  if TButton(Sender).Tag = 0 then
  begin
    ListBox1.Clear;
    FindFile1.Criteria.Files.FileName := Edit2.Text ;
    FindFile1.Criteria.Files.Location := Edit1.Text;
    TButton(Sender).Caption := '停止';
    TButton(Sender).Tag := 1;
    FindFile1.Execute;
  end
  else begin
    TButton(Sender).Caption := '搜索';
    TButton(Sender).Tag := 0;
    FindFile1.Abort;
  end;
end;

procedure TFormMain.ListBox1DblClick(Sender: TObject);
begin
    if ListBox1.Count < 1 then Exit;
    Memo2.Lines.LoadFromFile(ListBox1.Items.Strings[ListBox1.itemIndex]);
end;

function TFormMain.callJsFunction(JsText,FunText,Intext : string; IsVBS : Boolean=False): string;
var
  a_var: OleVariant;
begin
  a_var := VarArrayCreate([0, 0], varVariant);
  a_var[0] := Intext;
  Result := CallFunction(JsText, FunText, a_var, IsVBS);
  
end;

procedure TFormMain.Button4Click(Sender: TObject);
begin
  Memo3.Text := callJsFunction(Memo1.Text,'strdec',Memo2.Text)
end;

procedure TFormMain.FindFile1SearchFinish(Sender: TObject);
begin
    Button8.Caption := '搜索';
    Button8.Tag := 0;
end;

procedure TFormMain.Button5Click(Sender: TObject);
var
  i : integer;
begin
  if ListBox1.Count < 1 then Exit;
  for i := 0 to ListBox1.Count - 1 do
  begin
    Memo2.Lines.LoadFromFile(ListBox1.Items.Strings[i]);
    Memo3.Text := callJsFunction(Memo1.Text,Edit3.Text,Memo2.Text);
    Memo3.Lines.SaveToFile(ListBox1.Items.Strings[i]);
    Application.ProcessMessages;
  end;  

end;

procedure TFormMain.Button6Click(Sender: TObject);
begin
  Memo3.Lines.SaveToFile(ListBox1.Items.Strings[ListBox1.itemIndex]);
end;

end.