unit Unit1; interface uses 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 end end ———————————————— 原文链接：https://blog.csdn.net/xiuzhentianting/article/details/48377259
标签：begin,end,程序实现,Delphi,TObject,html,Exit,False,procedure From： https://www.cnblogs.com/tang-delphi/p/16709445.html