event auslösten in Javascript Page in TWEBBROWSER

[wschrabi]

Hallo,
also ich fand das hier: http://delphidabbler.com/articles?article=21

Jetzt habe ich eine Site: http://isciencesearch.com/iss
wo als einstiegsseite immer dieses Bild kommt. Anhang1: iss1.jpg

Jetzt möchte ich mit Delphi XE6 u.a. ein event Mouseclick auf diesse rote Seite, wo dann die TEXT Suche kommt starten. Wie kann ich das machen? Wenn ich mal einen Ansatz habe, kann ich dann die Suche weiters mit Delphiroutinen in TWEBBROWSER automatisieren. Doch bin ich mir mit JS nicht ganz klar.

Danke

PS: habe ein kleines DEMO dazugelinkt.
Button 1) und 3) sind zu implementieren. Im SOurce ist es QUESTION1 und QUESTION2

Delphi-Quellcode:

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  MSHTML, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.OleCtrls, SHDocVw;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Edit2: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    CheckBox1: TCheckBox;
    WebBrowser2: TWebBrowser;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private-Deklarationen }
    procedure WebFormSetFieldValue( document: IHTMLDocument2; const formNumber: integer; const fieldName, newValue: string) ;
    procedure SetMyProfile(Name:string; Checkbox: TCheckbox);
    function  WebFormGet(const formNumber: integer; document: IHTMLDocument2): IHTMLFormElement; 
    procedure CallFoo( );
    procedure CallStartSearch( );
       
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;
  WWWdocument: IHTMLDocument2;

implementation

{$R *.dfm}

function TFORM1.WebFormGet(const formNumber: integer; document: IHTMLDocument2): IHTMLFormElement; 
var   
   forms : IHTMLElementCollection; 
begin   
   forms := document.Forms as IHTMLElementCollection;
   result := forms.Item(formNumber,'') as IHTMLFormElement ;
end;

procedure TForm1.WebFormSetFieldValue(document: IHTMLDocument2; const formNumber: integer; const fieldName, newValue: string) ;
var   
   form : IHTMLFormElement;
   field: IHTMLElement; 

begin   
   form := WebFormGet(formNumber, WebBrowser2.Document AS IHTMLDocument2) ;
   field := form.Item(fieldName,'') as IHTMLElement;   

   if field = nil then Exit;    

   if field.tagName = 'INPUT' then 
      begin
      (field as IHTMLInputElement).value := newValue;   
      ShowMessage(DateTimeToStr(Now)+': -> CN ausgefüllt! ');
      end;
   //if field.tagName = 'SELECT' then (field as IHTMLSelectElement) := newValue;   
   //if field.tagName = 'TEXTAREA' then (field as IHTMLTextAreaElement) := newValue; 
   
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   // Here the event js handling routine is called. HOW???
   CallFoo( );
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  WWWdocument := WebBrowser2.Document as IHTMLDocument2;
  
  WebFormSetFieldValue(WWWdocument ,0,'NamesearchpageTextbox', Edit2.text) ;
  SetMyProfile('RadTextTile_Namesearchpage_Defaultprofile_ClientState',      Checkbox1);
  
end;

procedure TForm1.CallFoo( );
  { Calls JavaScript foo() function }
var
  Doc: IHTMLDocument2;      // current HTML document
  HTMLWindow: IHTMLWindow2; // parent window of current HTML document
  JSFn: string;             // stores JavaScipt function call
begin
  // Get reference to current document
  Doc := WebBrowser2.Document as IHTMLDocument2;
  if not Assigned(Doc) then
    Exit;
  // Get parent window of current document
  HTMLWindow := Doc.parentWindow;
  if not Assigned(HTMLWindow) then
    Exit;
  // Run JavaScript
  try
    //JSFn := Format('foo("%s",%d)', [S, I]);  // build function call
    // QUESTION 1
    // WHAT FUNCTION NAME must I enter here ??????
    JSFn := 'btn_StartpageTextSearch.close(true)';  // build function call
    HTMLWindow.execScript(JSFn, 'JavaScript'); // execute function
  except on Err:Exception do
   begin
     ShowMessage('Sorry: Exception: '+Err.Classname + ':' + Err.Message);

   end;
  end;
end;

procedure TForm1.CallStartSearch( );
  { Calls JavaScript foo() function }
var
  Doc: IHTMLDocument2;      // current HTML document
  HTMLWindow: IHTMLWindow2; // parent window of current HTML document
  JSFn: string;             // stores JavaScipt function call
begin
  // Get reference to current document
  Doc := WebBrowser2.Document as IHTMLDocument2;
  if not Assigned(Doc) then
    Exit;                                                            


  // Get parent window of current document
  HTMLWindow := Doc.parentWindow;
  if not Assigned(HTMLWindow) then
    Exit;
  // Run JavaScript
  try
    //JSFn := Format('foo("%s",%d)', [S, I]);  // build function call
    // QUESTION 2
    // WHAT FUNCTION NAME must I enter here ??????
    JSFn := 'btn_StartpageTextSearch.close(true)';  // build function call
    HTMLWindow.execScript(JSFn, 'JavaScript'); // execute function
  except on Err:Exception do
   begin
     ShowMessage('Sorry: Exception: '+Err.Classname + ':' + Err.Message);

   end;
  end;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
   //Webbrowser2.Navigate(Edit1.text);
   CallStartSearch( );
   
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
   Webbrowser2.Navigate(Edit1.text);

end;

procedure TForm1.SetMyProfile(Name:string; Checkbox: TCheckbox);
begin
  if Checkbox.checked then
      WebFormSetFieldValue(WWWdocument ,0,Name, '{"selected":true}')
  else
      WebFormSetFieldValue(WWWdocument ,0,Name, '{"selected":false}') ;

end;

end.

[nahpets]

Meinst Du sowas?

Delphi-Quellcode:

procedure ClickImage(wb : TWebBrowser; sImageName : String);
var
  iDoc: IHtmlDocument2;
  i: integer;
  ov: OleVariant;
  iDisp: IDispatch;
  iColl: IHTMLElementCollection;
  InputImage: HTMLInputImage;
begin
  wb.ControlInterface.Document.QueryInterface(IHtmlDocument2, iDoc);
  if not Assigned(iDoc) then begin
    Exit;
  end;
  ov := 'INPUT';
  iDisp := iDoc.all.tags(ov);
  if Assigned(IDisp) then begin
    IDisp.QueryInterface(IHTMLElementCollection, iColl);
    if Assigned(iColl) then begin
      for i := 1 to iColl.Get_length do begin
        iDisp := iColl.item(pred(i), 0);
        iDisp.QueryInterface(HTMLInputImage, InputImage);
        if Assigned(InputImage) then begin
          if InputImage.Name = sImageName then begin
            InputImage.Click;  // klick es
          end;
        end;
      end;
    end;
  end;
end;

(Ein Fundstück von meiner Festplatte, keine Ahnung, wo ich das herhabe.)

[wschrabi]

DANKE nahpets, Ich sehe da ist ein Profi der mir hilft.
Doch leider klappt es nicht. ich habs so gemacht.
Ich möchte in button1 auf die Rote Flache klicken, wo dann der TEXT INPUT Screen kommt
und in Button3) auf die START SEARCH Button Flache klicken.

DANKE DIR TAUSENDMAL!

Delphi-Quellcode:

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  MSHTML, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.OleCtrls, SHDocVw;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Edit2: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    CheckBox1: TCheckBox;
    WebBrowser2: TWebBrowser;
    Button1: TButton;
    Button2: TButton;                   

    Button3: TButton;
    Button4: TButton;
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private-Deklarationen }
    procedure WebFormSetFieldValue( document: IHTMLDocument2; const formNumber: integer; const fieldName, newValue: string) ;
    procedure SetMyProfile(Name:string; Checkbox: TCheckbox);
    function  WebFormGet(const formNumber: integer; document: IHTMLDocument2): IHTMLFormElement; 
    procedure CallFoo( );
    procedure CallStartSearch( );
    procedure ClickImage(wb : TWebBrowser; sImageName : String);
       
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;
  WWWdocument: IHTMLDocument2;

implementation

{$R *.dfm}

function TFORM1.WebFormGet(const formNumber: integer; document: IHTMLDocument2): IHTMLFormElement; 
var   
   forms : IHTMLElementCollection; 
begin   
   forms := document.Forms as IHTMLElementCollection;
   result := forms.Item(formNumber,'') as IHTMLFormElement ;
end;

procedure TForm1.WebFormSetFieldValue(document: IHTMLDocument2; const formNumber: integer; const fieldName, newValue: string) ;
var   
   form : IHTMLFormElement;
   field: IHTMLElement; 

begin   
   form := WebFormGet(formNumber, WebBrowser2.Document AS IHTMLDocument2) ;
   field := form.Item(fieldName,'') as IHTMLElement;   

   if field = nil then Exit;    

   if field.tagName = 'INPUT' then 
      begin
      (field as IHTMLInputElement).value := newValue;   
      ShowMessage(DateTimeToStr(Now)+': -> CN ausgefüllt! ');
      end;
   //if field.tagName = 'SELECT' then (field as IHTMLSelectElement) := newValue;   
   //if field.tagName = 'TEXTAREA' then (field as IHTMLTextAreaElement) := newValue; 
   
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   // Here the event js handling routine is called. HOW???
   //CallFoo( );
   ClickImage(WebBrowser2, 'text_normal_metro.png');
   
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  WWWdocument := WebBrowser2.Document as IHTMLDocument2;
  
  WebFormSetFieldValue(WWWdocument ,0,'NamesearchpageTextbox', Edit2.text) ;
  SetMyProfile('RadTextTile_Namesearchpage_Defaultprofile_ClientState',      Checkbox1);
  
end;

procedure TForm1.CallFoo( );
  { Calls JavaScript foo() function }
var
  Doc: IHTMLDocument2;      // current HTML document
  HTMLWindow: IHTMLWindow2; // parent window of current HTML document
  JSFn: string;             // stores JavaScipt function call
begin
  // Get reference to current document
  Doc := WebBrowser2.Document as IHTMLDocument2;
  if not Assigned(Doc) then
    Exit;
  // Get parent window of current document
  HTMLWindow := Doc.parentWindow;
  if not Assigned(HTMLWindow) then
    Exit;
  // Run JavaScript
  try
    //JSFn := Format('foo("%s",%d)', [S, I]);  // build function call
    // QUESTION 1
    // WHAT FUNCTION NAME must I enter here ??????
    JSFn := 'btn_StartpageTextSearch.close(true)';  // build function call
    HTMLWindow.execScript(JSFn, 'JavaScript'); // execute function
  except on Err:Exception do
   begin
     ShowMessage('Sorry: Exception: '+Err.Classname + ':' + Err.Message);

   end;
  end;
end;

procedure TForm1.CallStartSearch( );
  { Calls JavaScript foo() function }
var
  Doc: IHTMLDocument2;      // current HTML document
  HTMLWindow: IHTMLWindow2; // parent window of current HTML document
  JSFn: string;             // stores JavaScipt function call
begin
  // Get reference to current document
  Doc := WebBrowser2.Document as IHTMLDocument2;
  if not Assigned(Doc) then
    Exit;                                                            


  // Get parent window of current document
  HTMLWindow := Doc.parentWindow;
  if not Assigned(HTMLWindow) then
    Exit;
  // Run JavaScript
  try
    //JSFn := Format('foo("%s",%d)', [S, I]);  // build function call
    // QUESTION 2
    // WHAT FUNCTION NAME must I enter here ??????
    JSFn := 'btn_StartpageTextSearch.close(true)';  // build function call
    HTMLWindow.execScript(JSFn, 'JavaScript'); // execute function
  except on Err:Exception do
   begin
     ShowMessage('Sorry: Exception: '+Err.Classname + ':' + Err.Message);

   end;
  end;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
   //Webbrowser2.Navigate(Edit1.text);
   CallStartSearch( );
   
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
   Webbrowser2.Navigate(Edit1.text);

end;

procedure TForm1.SetMyProfile(Name:string; Checkbox: TCheckbox);
begin
  if Checkbox.checked then
      WebFormSetFieldValue(WWWdocument ,0,Name, '{"selected":true}')
  else
      WebFormSetFieldValue(WWWdocument ,0,Name, '{"selected":false}') ;

end;

procedure TForm1.ClickImage(wb : TWebBrowser; sImageName : String);
var
  iDoc: IHtmlDocument2;
  i: integer;
  ov: OleVariant;
  iDisp: IDispatch;
  iColl: IHTMLElementCollection;
  InputImage: HTMLInputImage;
begin
  wb.ControlInterface.Document.QueryInterface(IHtmlDocument2, iDoc);
  if not Assigned(iDoc) then begin
    Exit;
  end;
  ov := 'INPUT';
  iDisp := iDoc.all.tags(ov);
  if Assigned(IDisp) then begin
    IDisp.QueryInterface(IHTMLElementCollection, iColl);
    if Assigned(iColl) then begin
      for i := 1 to iColl.Get_length do begin
        iDisp := iColl.item(pred(i), 0);
        iDisp.QueryInterface(HTMLInputImage, InputImage);
        if Assigned(InputImage) then begin
          if InputImage.Name = sImageName then begin
            InputImage.Click; // klick es
          end;
        end;
      end;
    end;
  end;
end;

end.

[wschrabi]

SUPER DUFTE!
Es klappt!
Musste nur als

Delphi-Quellcode:

sImageName:='btn_StartpageTextsearch_ClientState'

eintragen!!!

TAUSEND DANK.
Leider habe ich nicht gelernt wie man mit JAvascript ein event in einem TWEBBROWSER Document auslöst.
egal.

:-D:thumb:

[wschrabi]

noch eine Frage.
ich habe in TWEBBRowser ein iframe göffnet, das bei Beendigung des searchprocesses geschlossen wird.
WIe kann ich in Delphi eine Routine triggern, wenn dieses iframe geschlossen worden ist.

DANKE.
mfg
Walter