Advertisement
hosttimer

FAZER BUSCA NAVEGADO DELPHI NO EDIT DELPHI

Oct 13th, 2017
86
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Delphi 1.76 KB | None | 0 0
  1. unit Unit1;
  2.  
  3. interface
  4.  
  5. uses
  6.   Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  7.   Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.OleCtrls, SHDocVw, Vcl.StdCtrls;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     Button1: TButton;
  12.     Memo1: TMemo;
  13.     WebBrowser1: TWebBrowser;
  14.     Edit1: TEdit;
  15.     procedure Button1Click(Sender: TObject);
  16.     procedure WebBrowser1DocumentComplete(ASender: TObject;
  17.       const pDisp: IDispatch; const URL: OleVariant);
  18.   private
  19.   procedure HtmlTomemo(web: TWebBrowser; memo: TMemo);
  20.     { Private declarations }
  21.   public
  22.     { Public declarations }
  23.   end;
  24.  
  25. var
  26.   Form1: TForm1;
  27.  
  28. implementation
  29.  
  30. {$R *.dfm}
  31.  
  32. { TForm1 }
  33.  
  34. procedure TForm1.Button1Click(Sender: TObject);
  35. begin
  36.  WebBrowser1.Navigate
  37.     ('https://www.google.com.br/?gfe_rd=cr&ei=IZNaVanWNuWp8we574CACQ#q=' +
  38.     Edit1.Text);
  39. end;
  40.  
  41. procedure TForm1.HtmlTomemo(web: TWebBrowser; memo: TMemo);
  42.  
  43.  var
  44.   documentoAtivo: variant;
  45.   txt, link: string;
  46.   p: integer;
  47. begin
  48.   documentoAtivo := web.Document;
  49.   txt := documentoAtivo.Body.OuterHTML;
  50.   txt := StringReplace(txt, '&', '&', [rfReplaceAll, rfIgnoreCase]);
  51.   txt := StringReplace(txt, '"', '"', [rfReplaceAll, rfIgnoreCase]);
  52.   p := pos('href="', txt);
  53.   while pos('href="', txt) <> 0 do
  54.   begin
  55.     delete(txt, 1, p + length('href="') - 1);
  56.     p := pos('"', txt);
  57.     link := copy(txt, 1, p - 1);
  58.     if link[1] = '/' then
  59.       link := 'http://www.google.com.br' + link;
  60.     memo1.Lines.Add(link);
  61.     delete(txt, 1, p + length('"'));
  62.     p := pos('href="', txt);
  63.   end;
  64. end;
  65. procedure TForm1.WebBrowser1DocumentComplete(ASender: TObject;
  66.   const pDisp: IDispatch; const URL: OleVariant);
  67. begin
  68.   HtmlTomemo(TWebBrowser(ASender), Memo1);
  69. end;
  70. end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement