用程序实现自动的html操作

来源:互联网 发布:淘宝澳洲代购真假 编辑:程序博客网 时间:2024/06/04 22:17
unit Unit1;interfaceuses  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,  Dialogs, OleCtrls, SHDocVw, mshtml, StdCtrls, ExtCtrls;const      CMySearchName: string = 'test';type  TForm1 = class(TForm)    WebBrowser1: TWebBrowser;    ButtonSearch: TButton;    ButtonRefresh: TButton;    TimerRefresh: TTimer;    TimerSearch: TTimer;    ButtonIsFind: TButton;    TimerFind: TTimer;    TimerDial: TTimer;    ButtonDial: TButton;    procedure ButtonRefreshClick(Sender: TObject);    procedure ButtonSearchClick(Sender: TObject);    procedure WebBrowser1NavigateComplete2(ASender: TObject;      const pDisp: IDispatch; var URL: OleVariant);    procedure WebBrowser1NavigateError(ASender: TObject; const pDisp: IDispatch;      var URL, Frame, StatusCode: OleVariant; var Cancel: WordBool);    procedure TimerRefreshTimer(Sender: TObject);    procedure TimerSearchTimer(Sender: TObject);    procedure ButtonIsFindClick(Sender: TObject);    procedure TimerFindTimer(Sender: TObject);    procedure FormShow(Sender: TObject);    procedure ButtonDialClick(Sender: TObject);    procedure TimerDialTimer(Sender: TObject);  private    FIsNavSuccess: Boolean;    FHasExcScript: Boolean;    FHasSearch: Boolean;    FHasFind: Boolean;  public    { Public declarations }  end;var  Form1: TForm1;implementation{$R *.dfm}procedure ExecuteScript(aWebBrowser: TWebBrowser; XScript: WideString; language: WideString = 'javascript');var  HTDoc: IHTMLDocument2;begin  HTDoc := (aWebBrowser.Document as IHTMLDocument2);  if (HTDoc <> nil) then  begin      if HTDoc.parentWindow <> nil then        HTDoc.parentWindow.ExecScript(XScript, Olevariant(language)) ;  end;end;procedure DoIdle(XMsSec: Cardinal);var  ElapsedTime: Cardinal;begin  ElapsedTime := 0;  while ElapsedTime < XMsSec do  begin    Application.ProcessMessages;    Sleep(10);    Inc(ElapsedTime, 10);  end;end;procedure MoniClick(X, Y: Integer);var  LCount: Integer;begin  LCount := 0;  while not SetCursorPos(X, Y) do  begin    Inc(LCount);    if LCount > 100 then      Exit;  end;    DoIdle(100);  mouse_event(MOUSEEVENTF_LEFTDOWN, 0,0,0,GetMessageExtraInfo());  DoIdle(100);  mouse_event(MOUSEEVENTF_LEFTUP, 0,0,0,GetMessageExtraInfo());end;function GetBodyAll(XDoc: IDispatch): IHTMLElementCollection;var  LDoc: HTMLDocument;  LBody: HTMLBody;begin  Result := nil;      LDoc := XDoc as HTMLDocument;  if LDoc = nil then    Exit;  LBody := LDoc.body as HTMLBody;  if LBody = nil then    Exit;  Result := LBody.all as IHTMLElementCollection;end;function GetBodyElement(const ABodyAll: IHTMLElementCollection; const AnElementName: string): IHTMLElement;var  LName: OleVariant;  LIndex: OleVariant;begin  Result := nil;  LName := AnElementName;  Result := ABodyAll.item(LName, LIndex) as IHTMLElement;end;function GetBodyElementStrValue(XBodyAll: IHTMLElementCollection; const AnItemName: string; var RetStr: string): Boolean;var  LElem: IHTMLElement;begin  Result := False;  LElem := GetBodyElement(XBodyAll, AnItemName);  if LElem <> nil then  begin    try      RetStr := Trim(LElem.getAttribute('value', 0));      Result := True;    except    end;  end;end;function GetIFrameBodyAll(XDoc: IDispatch; XFrameIndex: Integer): IHTMLElementCollection;var  LIframeCollection:IHTMLElementCollection;  L1Iframe:IWebBrowser;  LLen: Integer;  LDoc: HTMLDocument;  LBody: HTMLBody;begin  Result := nil;  LIframeCollection:=GetBodyAll(XDoc).tags('iframe') as IHTMLElementCollection;  LLen := LIframeCollection.length;  if (LLen > 0) and (XFrameIndex >= 0) and (XFrameIndex < LLen) then  begin    L1Iframe:= LIframeCollection.item(XFrameIndex, varEmpty) as IWebBrowser;    LDoc := L1Iframe.document as HTMLDocument;    if LDoc = nil then      Exit;    LBody := LDoc.body as HTMLBody;    if LBody = nil then      Exit;    Result := LBody.all as IHTMLElementCollection;  end;end;function SetBodyElementStrValue(XBodyAll: IHTMLElementCollection; const AnItemName: string; const XValueStr: string): Boolean;var  LElem: IHTMLElement;  LValue: OleVariant;begin  Result := False;  LElem := GetBodyElement(XBodyAll, AnItemName);  if LElem <> nil then  begin    try      LValue := XValueStr;      LElem.setAttribute('value', LValue, 0);      Result := True;    except    end;  end;end;procedure TForm1.ButtonSearchClick(Sender: TObject);const  CNameSearchName = 'J_SearchKeyword';  CNameBtn = 'J_SerachList';var  LOldValue: string;  LBodyAll: IHTMLElementCollection;  LEdit: IHTMLInputElement;  LBtn: IHTMLElement;begin  inherited;  if not FIsNavSuccess then    Exit;  // 不模拟实现了   t1.focus(); t1.blur();  //MoniClick(Left + WebBrowser1.Left + 200, Top + WebBrowser1.Top + WebBrowser1.Height + 15);  //LBodyAll := GetIFrameBodyAll(WebBrowser1.Document, 0);  LBodyAll := GetBodyAll(WebBrowser1.Document);  if LBodyAll = nil then    Exit;  if FHasExcScript then  begin    LBtn := GetBodyElement(LBodyAll, CNameBtn);    if LBtn = nil then      Exit;    LBtn.click;    FHasSearch := True;    TimerFind.Enabled := True;    Exit;  end;  if not GetBodyElementStrValue(LBodyAll, CNameSearchName, LOldValue) then  begin    Exit;  end;  if LOldValue <> CMySearchName then  begin    if not SetBodyElementStrValue(LBodyAll, CNameSearchName, CMySearchName) then      Exit;    LEdit := GetBodyElement(LBodyAll, CNameSearchName) as IHTMLInputElement;    if LEdit = nil then      Exit;    ExecuteScript(WebBrowser1, ' var t1 = document.getElementById("J_SearchKeyword");  t1.focus(); t1.blur();');    FHasExcScript := True;  end;end;procedure TForm1.FormShow(Sender: TObject);begin  TimerRefreshTimer(nil);end;procedure TForm1.ButtonDialClick(Sender: TObject);var  LParent: HWND;  LHandle: HWND;  LRect: TRect;begin  //  class:  //  btn: tSkMainForm -> TConversationForm -> TNonLiveCallToolbar  LHandle := FindWindow('tSkMainForm', nil);  if LHandle = 0 then    Exit;  if not ShowWindow(LHandle,SW_SHOWNORMAL) then    Exit;  if not SetForegroundWindow(LHandle) then    Exit;  DoIdle(100);  LParent := LHandle;  LHandle := FindWindowEx(LParent, 0, 'TConversationForm', nil);  if LHandle = 0 then    Exit;  LParent := LHandle;  LHandle := FindWindowEx(LParent, 0, 'TNonLiveCallToolbar', nil);  if LHandle = 0 then    Exit;    if not GetWindowRect(LHandle, LRect) then    Exit;  MoniClick(LRect.Left + 50, LRect.Top + 22);  TimerDial.Enabled := False;end;procedure TForm1.ButtonIsFindClick(Sender: TObject);  function IsFindIndex(XAllChild: IHTMLElementCollection; XIndex: Integer): Boolean;  var    LItem0: IHTMLElement;    LIndex0: OleVariant;    LName: OleVariant;    LFindText: WideString;    LSearchName: WideString;  begin    Result := False;    LIndex0 := XIndex;    // activity-item clearfix    LItem0 := XAllChild.item(LName, LIndex0) as IHTMLElement;    if LItem0 = nil then      Exit;    LFindText := LItem0.innerHTML;    LSearchName := CMySearchName;    if Pos(LSearchName, LFindText) > 0 then    begin      Result := True;    end;  end;  const  CNameActiveListName = 'J_ActivityList';var  LBodyAll: IHTMLElementCollection;  LList: IHTMLElement;  LChild: IHTMLElementCollection;  I: Integer;begin  inherited;  if not FHasSearch then    Exit;  LBodyAll := GetBodyAll(WebBrowser1.Document);  if LBodyAll = nil then    Exit;  LList := GetBodyElement(LBodyAll, CNameActiveListName);  if LList = nil then    Exit;  LChild := LList.children as IHTMLElementCollection;  if LChild = nil then    Exit;  if LChild.length > 0 then  begin    for I := 0 to LChild.length - 1 do    begin      if IsFindIndex(LChild, I) then      begin        TimerFind.Enabled := False;        TimerRefresh.Enabled := False;        TimerSearch.Enabled := False;        FHasFind := True;        TimerDial.Enabled := True;        Break;      end;    end;  end;end;procedure TForm1.ButtonRefreshClick(Sender: TObject);begin  FIsNavSuccess := False;  FHasExcScript := False;  FHasSearch := False;  FHasFind := False;  TimerSearch.Enabled := False;  TimerFind.Enabled := False;  TimerDial.Enabled := False;    WebBrowser1.Navigate('http://yingxiao.taobao.com/list.htm');end;procedure TForm1.TimerDialTimer(Sender: TObject);begin  if not TimerDial.Enabled then    Exit;  if not FHasFind then    Exit;  ButtonDial.Click;end;procedure TForm1.TimerFindTimer(Sender: TObject);begin  if not TimerFind.Enabled then    Exit;  ButtonIsFind.Click;end;procedure TForm1.TimerRefreshTimer(Sender: TObject);begin  if not TimerRefresh.Enabled then    Exit;  ButtonRefresh.Click;end;procedure TForm1.TimerSearchTimer(Sender: TObject);begin  if not TimerSearch.Enabled then    Exit;  ButtonSearch.Click;end;procedure TForm1.WebBrowser1NavigateComplete2(ASender: TObject;  const pDisp: IDispatch; var URL: OleVariant);begin  FIsNavSuccess := True;  TimerSearch.Enabled := True;end;procedure TForm1.WebBrowser1NavigateError(ASender: TObject;  const pDisp: IDispatch; var URL, Frame, StatusCode: OleVariant;  var Cancel: WordBool);begin  FIsNavSuccess := False;end;end.object Form1: TForm1  Left = 0  Top = 0  BorderStyle = bsDialog  Caption = 'Form1'  ClientHeight = 552  ClientWidth = 930  Color = clBtnFace  Font.Charset = DEFAULT_CHARSET  Font.Color = clWindowText  Font.Height = -11  Font.Name = 'Tahoma'  Font.Style = []  OldCreateOrder = False  OnShow = FormShow  DesignSize = (    930    552)  PixelsPerInch = 96  TextHeight = 13  object WebBrowser1: TWebBrowser    AlignWithMargins = True    Left = 0    Top = 0    Width = 930    Height = 452    Margins.Left = 0    Margins.Top = 0    Margins.Right = 0    Margins.Bottom = 100    Align = alClient    TabOrder = 0    OnNavigateComplete2 = WebBrowser1NavigateComplete2    OnNavigateError = WebBrowser1NavigateError    ExplicitLeft = 3    ExplicitTop = 3    ExplicitWidth = 637    ExplicitHeight = 301    ControlData = {      4C0000001E600000B72E00000000000000000000000000000000000000000000      000000004C000000000000000000000001000000E0D057007335CF11AE690800      2B2E126208000000000000004C0000000114020000000000C000000000000046      8000000000000000000000000000000000000000000000000000000000000000      00000000000000000100000000000000000000000000000000000000}  end  object ButtonSearch: TButton    Left = 288    Top = 506    Width = 89    Height = 25    Anchors = [akLeft, akBottom]    Caption = 'ButtonSearch'    TabOrder = 1    Visible = False    OnClick = ButtonSearchClick  end  object ButtonRefresh: TButton    Left = 144    Top = 506    Width = 97    Height = 25    Anchors = [akLeft, akBottom]    Caption = 'ButtonRefresh'    TabOrder = 2    Visible = False    OnClick = ButtonRefreshClick  end  object ButtonIsFind: TButton    Left = 424    Top = 506    Width = 89    Height = 25    Caption = 'ButtonIsFind'    TabOrder = 3    Visible = False    OnClick = ButtonIsFindClick  end  object ButtonDial: TButton    Left = 560    Top = 506    Width = 75    Height = 25    Caption = 'ButtonDial'    TabOrder = 4    Visible = False    OnClick = ButtonDialClick  end  object TimerRefresh: TTimer    Interval = 50000    OnTimer = TimerRefreshTimer    Left = 8    Top = 464  end  object TimerSearch: TTimer    Enabled = False    Interval = 10000    OnTimer = TimerSearchTimer    Left = 40    Top = 464  end  object TimerFind: TTimer    Enabled = False    OnTimer = TimerFindTimer    Left = 72    Top = 464  end  object TimerDial: TTimer    Enabled = False    Interval = 5000    OnTimer = TimerDialTimer    Left = 112    Top = 464  endend 

0 0