AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein Netzwerke event auslösten in Javascript Page in TWEBBROWSER
Thema durchsuchen
Ansicht
Themen-Optionen

event auslösten in Javascript Page in TWEBBROWSER

Offene Frage von "wschrabi"
Ein Thema von wschrabi · begonnen am 7. Jan 2016 · letzter Beitrag vom 7. Jan 2016
Antwort Antwort
wschrabi

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

event auslösten in Javascript Page in TWEBBROWSER

  Alt 7. Jan 2016, 10: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 13:13 Uhr) Grund: Sourcde TExt added
  Mit Zitat antworten Zitat
nahpets
(Gast)

n/a Beiträge
 
#2

AW: event auslösten in Javascript Page in TWEBBROWSER

  Alt 7. Jan 2016, 13:01
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.)
  Mit Zitat antworten Zitat
wschrabi

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

AW: event auslösten in Javascript Page in TWEBBROWSER

  Alt 7. Jan 2016, 13:23
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 = '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( );
   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.
Angehängte Dateien
Dateityp: zip EventFireJS_DEMO.zip (3,77 MB, 7x aufgerufen)
  Mit Zitat antworten Zitat
wschrabi

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

AW: event auslösten in Javascript Page in TWEBBROWSER

  Alt 7. Jan 2016, 13:36
SUPER DUFTE!
Es klappt!
Musste nur als 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.

  Mit Zitat antworten Zitat
wschrabi

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

AW: event auslösten in Javascript Page in TWEBBROWSER

  Alt 7. Jan 2016, 15:21
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
  Mit Zitat antworten Zitat
Antwort Antwort

 

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 03:00 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz