Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- unit Unit1;
- interface
- uses
- Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
- Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.OleCtrls, SHDocVw, Vcl.StdCtrls;
- type
- TForm1 = class(TForm)
- Button1: TButton;
- Memo1: TMemo;
- WebBrowser1: TWebBrowser;
- Edit1: TEdit;
- procedure Button1Click(Sender: TObject);
- procedure WebBrowser1DocumentComplete(ASender: TObject;
- const pDisp: IDispatch; const URL: OleVariant);
- private
- procedure HtmlTomemo(web: TWebBrowser; memo: TMemo);
- { Private declarations }
- public
- { Public declarations }
- end;
- var
- Form1: TForm1;
- implementation
- {$R *.dfm}
- { TForm1 }
- procedure TForm1.Button1Click(Sender: TObject);
- begin
- WebBrowser1.Navigate
- ('https://www.google.com.br/?gfe_rd=cr&ei=IZNaVanWNuWp8we574CACQ#q=' +
- Edit1.Text);
- end;
- procedure TForm1.HtmlTomemo(web: TWebBrowser; memo: TMemo);
- var
- documentoAtivo: variant;
- txt, link: string;
- p: integer;
- begin
- documentoAtivo := web.Document;
- txt := documentoAtivo.Body.OuterHTML;
- txt := StringReplace(txt, '&', '&', [rfReplaceAll, rfIgnoreCase]);
- txt := StringReplace(txt, '"', '"', [rfReplaceAll, rfIgnoreCase]);
- p := pos('href="', txt);
- while pos('href="', txt) <> 0 do
- begin
- delete(txt, 1, p + length('href="') - 1);
- p := pos('"', txt);
- link := copy(txt, 1, p - 1);
- if link[1] = '/' then
- link := 'http://www.google.com.br' + link;
- memo1.Lines.Add(link);
- delete(txt, 1, p + length('"'));
- p := pos('href="', txt);
- end;
- end;
- procedure TForm1.WebBrowser1DocumentComplete(ASender: TObject;
- const pDisp: IDispatch; const URL: OleVariant);
- begin
- HtmlTomemo(TWebBrowser(ASender), Memo1);
- end;
- end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement