Delphi

[opiumhautopium1]

Hi guys . I need a little help in a Delphi (Xe3) script ..... I hope u can help

It is a small Web browser to extract Links from a webside

The "TwebBroser" work in TabSheeds ..... I store The TabSheet in a String and extract the url from String ( not a second webrequest because captcha));

 

My Problem is

 

The Code store the first TabSheet to the string but i need to store the ACTIVE TabSheet

 

 

unit WebBrowser;interfaceuses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.OleCtrls, SHDocVw,MsHtml, Vcl.ComCtrls, Vcl.Menus,Seit2Browser,ActiveX, COMObj, IdHTTP, idURI,StrUtils,RegularExpressions;type TForm2 = class(TForm)   Button1: TButton;   Button2: TButton;   Button3: TButton;   Button4: TButton;   Button5: TButton;   Button6: TButton;   Edit1: TEdit;   MainMenu1: TMainMenu;   Einstelungen1: TMenuItem;   Button7: TButton;   PageControl1: TPageControl;   TabSheet1: TTabSheet;   WebBrowser1: TWebBrowser;   TabSheet2: TTabSheet;   WebBrowser2: TWebBrowser;   TabSheet5: TTabSheet;   Memo3: TMemo;   procedure Button6Click(Sender: TObject);   procedure Button1Click(Sender: TObject);   procedure Button2Click(Sender: TObject);   procedure Button4Click(Sender: TObject);   procedure Button3Click(Sender: TObject);   procedure TabSheet1Rename(ASender: TObject; const pDisp: IDispatch;     const URL: OleVariant);   //procedure ReturnDrucken(Sender: TObject; var Key: Char);   procedure webbrowser1NewWindow2(ASender: TObject; var ppDisp: IDispatch;     var Cancel: WordBool);   procedure TabSheet2Rename(ASender: TObject; const pDisp: IDispatch;     const URL: OleVariant);   procedure Einstelungen1Click(Sender: TObject);   procedure FormCreate(Sender: TObject);   procedure Button7Click(Sender: TObject);   procedure WenStartTest(Sender: TObject);   procedure Webbrowser1CommandStateChange(ASender: TObject; Command: Integer;     Enable: WordBool);   procedure Webbrowser1documentcomplete(ASender: TObject;     const pDisp: IDispatch; const URL: OleVariant); private   { Private-Deklarationen } public   { Public-Deklarationen } end;var Form2: TForm2; Auslese: String; Adposi,BPosi: Integer ; PosSpeicher: Array of integer; SUrl: Array of String;implementation{$R *.dfm}procedure TForm2.Button1Click(Sender: TObject);Begin try WebBrowser1.GoBack; except Button1.Enabled:= False; end;end;procedure TForm2.Button2Click(Sender: TObject);beginWebBrowser1.GoForward;end;procedure TForm2.Button3Click(Sender: TObject);beginWebBrowser1.Navigate(Startseite);end;procedure TForm2.Button4Click(Sender: TObject);beginWebBrowser1.Refresh2;end;procedure TForm2.Button6Click(Sender: TObject);beginButton1.Enabled:= True;WebBrowser1.Navigate(Edit1.text);end;procedure TForm2.Button7Click(Sender: TObject);var UPloadedRegEx,refLinkFilter,htmlcode: String; Uploadedmatches: TMatchCollection; UPloadedmatch: TMatch; Begin ////////////////// Here it Store The String ( FIRST TAB) //////// htmlcode:=WebBrowser1.OleObject.Document.Body.InnerHtml;//////////// But need The ACTIVE Tab////////////////////////////////////// UPloadedRegEx:= ('(http|ftp|https):\/\/[\w\-_]+(\.[\w\-_]+)+([\w\-\.,@?^=%&~\+#]*[\w\-\@?^=%&/~\+#])?'); Uploadedmatches := TRegEx.Matches(htmlcode,UPloadedRegEx); if UPloadedmatches.Count > 0 then   begin     for UPloadedmatch in UPloadedmatches do     begin     refLinkFilter:=uploadedMatch.Value;     if not TRegEx.IsMatch(refLinkFilter, '/ref/') then     Memo3.Lines.Add(refLinkFilter) ;     end;     TabSheet5.TabVisible:= True;   end; end;procedure TForm2.Einstelungen1Click(Sender: TObject);beginForm3.Show;end;procedure TForm2.FormCreate(Sender: TObject);Begintry  AssignFile(f,'Startseite.txt');  Reset(f);  ReadLn(f,Startseite);finally Closefile(f);end;end;procedure TForm2.Webbrowser1CommandStateChange(ASender: TObject; Command: Integer; Enable: WordBool);begincase Command of   CSC_NAVIGATEBACK: Button1.Enabled := Enable;   CSC_NAVIGATEFORWARD: Button2.Enabled := Enable; end;end;procedure TForm2.Webbrowser1documentcomplete(ASender: TObject; const pDisp: IDispatch; const URL: OleVariant);var CurWebrowser : IWebBrowser; TopWebBrowser: IWebBrowser; Document     : OLEvariant; WindowName   : string;begin { TForm1.WebBrowser1DocumentComplete } CurWebrowser := pDisp as IWebBrowser; TopWebBrowser := (ASender as TWebBrowser).DefaultInterface; if CurWebrowser=TopWebBrowser then begin   //ShowMessage('Document is complete.') end else begin   Document := CurWebrowser.Document;   WindowName := Document.ParentWindow.Name;   //ShowMessage('Frame ' + WindowName + ' is loaded.') end;end;procedure TForm2.webbrowser1NewWindow2(ASender: TObject; var ppDisp: IDispatch;     var Cancel: WordBool);var TabSheet: TTabSheet; Web: TWebbrowser;begin TabSheet := TTabSheet.Create(Form2.pagecontrol1); with TabSheet do begin   PageControl := Form2.pagecontrol1; end; Web := TWebbrowser.CreateParented(TabSheet.Handle); TabSheet.InsertControl(Web); TWinControl(Web).align := alClient; ppDisp := Web.DefaultDispatch;// PageControl1.activepage.pageindex := PageControl1.PageCount- 1; Web.OnNewWindow2 := webbrowser1NewWindow2; Web.OnCommandStateChange := Webbrowser1CommandStateChange; web.OnDocumentComplete := Webbrowser1documentcomplete; //Web.OnNavigateComplete2 := Webbrowser1NavigateComplete2; //Web.OnProgressChange := Webbrowser1ProgressChange; //Web.OnstatusTextChange := Webbrowser1StatusTextChange; Pagecontrol1.Pages[pagecontrol1.PageCount - 1].caption := 'Lade...';end;procedure TForm2.TabSheet1Rename(ASender: TObject; const pDisp: IDispatch; const URL: OleVariant);beginEdit1.Text:= WebBrowser1.LocationURL;TabSheet1.Caption:= Edit1.Text;end;procedure TForm2.TabSheet2Rename(ASender: TObject; const pDisp: IDispatch; const URL: OleVariant);beginTabSheet2.Caption:= WebBrowser2.LocationName;end;procedure TForm2.WenStartTest(Sender: TObject);beginMemo3.Clear;TabSheet1.Show ;WebBrowser1.Navigate('www.google.de');end;end.

 

[opiumhautopium1]

done

 

Begin Memo1.Clear;  if PageControl1.ActivePageIndex <= 0 then  begin   htmlcode:=WebBrowser1.OleObject.Document.Body.InnerHtml;  end else with PageControl1.ActivePage do     begin      with PageControl1.ActivePage.Controls[0] as TWebbrowser do      htmlcode:=      OleObject.Document.Body.InnerHtml;     end;

 

[slacky]

Really? The threads name is "Delphi", in the forum-section: "Programming"... aiiight...

Next time you need help, please do use better topic, "Delphi" tells us NOTHING about what you are trying to achieve! It' does not help the site to evolve as well.. If someone was to try to do the same as you in a month or two, they would not find your post (by searching), because your topic is useless, it tells us nothing about the problem or the goal.

Edited May 16, 2013 by slacky