Einzelnen Beitrag anzeigen

wschrabi

Registriert seit: 16. Jan 2005
448 Beiträge
 
#1

event auslösten in Javascript Page in TWEBBROWSER

  Alt 7. Jan 2016, 09:54
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 = 'INPUTthen
      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.
Miniaturansicht angehängter Grafiken
iss1.jpg  
Angehängte Dateien
Dateityp: zip EventFireJS_DEMO.zip (3,77 MB, 7x aufgerufen)

Geändert von wschrabi ( 7. Jan 2016 um 12:13 Uhr) Grund: Sourcde TExt added
  Mit Zitat antworten Zitat