Przeglądarka oprata na machanizmach Internet Explorera

jaroslaw_szulc

2003-12-16 20:00:42
2003-12-16 20:00:42
14 komentarzy
2227 odsłon

Delphi posiada doskonały komponent, który pozwoli nam w prosty sposób utworzyć własną przeglądarkę internetową opartą na enignie Internet Explorera firmy Microsoft. Na początku musimy umieścić na formie komponent, który wyświetlał będzie strony internetowe. Znajduje się on w zakładce 'Internet' pod nazwą TWebBrowser. Umieśćmy go na formie i pozostawmy domyślną nazwę czyli 'WebBrowser1'. Teraz na formie umieśćmy komponent TEdit o nazwie TEdit1. Ustawmy jego zdarzenie OnKeyPress:

if key = #13 then
begin
WebBrowser1.Navigate(Edit1.text);
end;

Ten fragment kodu pozwoli nam wyświetlić zawartość strony o adresie wpisanym w Edit1 po wciśnięciu przycisku enter.

Teraz możemy umieścić dodatkowe przyciski zwane przyciskami nawigacyjnymi. Oto ich kody:

Wstecz:
WebBrowser1.GoBack;

Dalej:
WebBrowser1.GoForward;

Stop:
WebBrowser1.Stop;

Odśwież:
WebBrowser1.Refresh;

W taki prosty sposób mamy już bardzo okrojoną przeglądarkę internetową o standardowych funkcjach nawigacyjnych.

Teraz dodajemy dodatkowe funkcje. Najpierw dodamy procedurę, która umożliwi nam wyświetlanie postępu ładowania strony.

Na formę dodaj komponent TGauge z zakładki 'Samples'. Ten komponent yświetli postęp ładowania strony.

Teraz musimy ustawić zdarzenie 'OnProgressChange' dla WebBrowser1:

ProgressMax := 100;
Gauge1.Progress := Progress;

Tak w prosty sposób otrzymaliśmy pasek postepu. Teraz następna przydatna funkcja. Internet Explorer wyświetla bowiem na pasku tytułowym zaratość znaczników title. Aby nasz program także wyświetlał title musimy dodać zdarzenie OnTitleChange dla WebBrowse1:

Form1.Caption := text;

OK. Jeszcze kilka zdarzeń. Teraz OnstatusTextChange. Zdarzenie to pozwoli pyświetlać tekst statusu. W IE przedstawiony jest on na dolnym panelu i wyświetla m.in. adresy odnośników. W naszym przypadku odpowiada za to właśnie zdarzenie OnstatusTextChange. Gdy chcemy aby status był wyświetlany na panelu najpierw umieszczamy na formie komponent TStatusBar o nazwie StatusBar1. Teraz musimy dodać panel na StatusBar1. Robi się to poprzez dwukrotne kliknięcie na panel i kliknięcie ikonki 'Add New'. Teraz OnstatusTextChange WebBrowser1:

StatusBar1.Panels[0].text := Text;

I jeszcze jedna bardzo ważna funkcja, która uniemożliwi przejęcie okien innej przeglądarce. Oznacza to, że w przypadku kiedy link zostanie otwarty w nowym oknie otworzy go nasza przeglądarka a nie np. IE. Aby to zrobić musimy ustawiś zdarzenie webBrowser1 OnNewWindow2:

var NewWindow: TForm1;
begin
  NewWindow := TForm1.Create(self);
  NewWindow.Show;
  ppDisp := NewWindow.Webbrowser1.DefaultDispatch;
end;

A tak wygląda źródło bardziej rozbudowanej przeglądarki mojego autorstwa:

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
OleCtrls, SHDocVw, Menus, ShellApi, ExtCtrls, StdCtrls, Psock, NMHttp,
ComCtrls, ActnList, URLMon, Spin, Gauges, Buttons, HTTPApp, DSProd, NMURL;

type
TForm1 = class(TForm)
WebBrowser1: TWebBrowser;
Panel1: TPanel;
Panel4: TPanel;
NMHTTP1: TNMHTTP;
NMURL1: TNMURL;
OpenDialog1: TOpenDialog;
SaveDialog1: TSaveDialog;
Image1: TImage;
Shape1: TShape;
Image2: TImage;
Image3: TImage;
Image4: TImage;
Image5: TImage;
Gauge1: TGauge;
Edit1: TEdit;
Shape2: TShape;
Animate1: TAnimate;
Panel2: TPanel;
Image7: TImage;
Image8: TImage;
Label2: TLabel;
Panel3: TPanel;
Image6: TImage;
Image9: TImage;
Label1: TLabel;
PopupMenu1: TPopupMenu;
Zakocz2: TMenuItem;
N4: TMenuItem;
Zapisz2: TMenuItem;
Otwrz2: TMenuItem;
Plikzdysku2: TMenuItem;
Stronsieciweb2: TMenuItem;
Info2: TMenuItem;
Kodowanyformatadresustrony1: TMenuItem;
Pobierzrdo2: TMenuItem;
Pobierznagwki1: TMenuItem;
Zawszenawierzchu2: TMenuItem;
Nawigacja2: TMenuItem;
Sprzejddo2: TMenuItem;
httpcdhitnewsplStronaonagrywarkach2: TMenuItem;
N5: TMenuItem;
httpwwwsecurityplcjbnetStronadomowa2: TMenuItem;
Stronastartowa1: TMenuItem;
N6: TMenuItem;
Odwie2: TMenuItem;
Zatrzymaj2: TMenuItem;
Dalej2: TMenuItem;
Wstecz2: TMenuItem;
Start2: TMenuItem;
N1: TMenuItem;
N2: TMenuItem;
Panel5: TPanel;
Panel6: TPanel;
Panel7: TPanel;
Image10: TImage;
Image11: TImage;
Label3: TLabel;
Shape3: TShape;
Label4: TLabel;
Memo1: TMemo;
procedure Image1Click(Sender: TObject);
procedure Image2Click(Sender: TObject);
procedure Image4Click(Sender: TObject);
procedure Image3Click(Sender: TObject);
procedure Edit1KeyPress(Sender: TObject; var Key: Char);
procedure FormKeyPress(Sender: TObject; var Key: Char);
procedure WebBrowser1DownloadBegin(Sender: TObject);
procedure WebBrowser1DocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
procedure WebBrowser1Enter(Sender: TObject);
procedure WebBrowser1FullScreen(Sender: TObject; FullScreen: WordBool);
procedure WebBrowser1TitleChange(Sender: TObject;
const Text: WideString);
procedure WebBrowser1StatusTextChange(Sender: TObject;
const Text: WideString);
procedure fsdf1Click(Sender: TObject);
procedure Zakocz1Click(Sender: TObject);
procedure Zapisz1Click(Sender: TObject);
procedure Dalej1Click(Sender: TObject);
procedure Zatrzymaj1Click(Sender: TObject);
procedure Odwie1Click(Sender: TObject);
procedure WebBrowser1ProgressChange(Sender: TObject; Progress,
ProgressMax: Integer);
procedure WebBrowser1NewWindow2(Sender: TObject; var ppDisp: IDispatch;
var Cancel: WordBool);
procedure FormCreate(Sender: TObject);
procedure Image6MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Label1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Image9MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Stronsieciweb2Click(Sender: TObject);
procedure Plikzdysku2Click(Sender: TObject);
procedure Zapisz2Click(Sender: TObject);
procedure Zakocz2Click(Sender: TObject);
procedure Zawszenawierzchu2Click(Sender: TObject);
procedure Pobierznagwki1Click(Sender: TObject);
procedure Pobierzrdo2Click(Sender: TObject);
procedure Kodowanyformatadresustrony1Click(Sender: TObject);
procedure Wstecz2Click(Sender: TObject);
procedure Dalej2Click(Sender: TObject);
procedure Zatrzymaj2Click(Sender: TObject);
procedure Odwie2Click(Sender: TObject);
procedure Image11MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Label4Click(Sender: TObject);
procedure Shape3MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
procedure WMDropFiles(var Msg: TWMDropFiles); message WM_DROPFILES;
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
licznik : integer;

implementation

{$R *.DFM}

procedure TForm1.WMDropFiles(var Msg: TWMDropFiles);
var NazwaPliku: array[0..MAX_PATH] of Char;
begin
if DragQueryFile(Msg.Drop, 0, NazwaPliku, MAX_PATH) > 0 then
edit1.Text:=NazwaPliku;
WebBrowser1.Navigate(NazwaPliku);
end;

procedure TForm1.Image1Click(Sender: TObject);
begin
WebBrowser1.GoBack;
end;

procedure TForm1.Image2Click(Sender: TObject);
begin
WebBrowser1.GoForward;
end;

procedure TForm1.Image4Click(Sender: TObject);
begin
WebBrowser1.Refresh;
end;

procedure TForm1.Image3Click(Sender: TObject);
begin
WebBrowser1.Stop;
end;

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
if key = #13 then
begin
WebBrowser1.Navigate(Edit1.text);
end;
end;

procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
begin
if key = #49 then panel1.visible := false;
end;

procedure TForm1.WebBrowser1DownloadBegin(Sender: TObject);
begin
Label2.Caption := 'Rozpoczęto zaysanie';
Animate1.Active := true;
end;

procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
begin
Edit1.Text := URL;
Label2.Caption := 'Zakończono zasysanie';
Animate1.Active := false;
end;

procedure TForm1.WebBrowser1Enter(Sender: TObject);
begin
Label2.Caption := ('Witamy w programie');
end;

procedure TForm1.WebBrowser1FullScreen(Sender: TObject;
FullScreen: WordBool);
begin
FullScreen := false;
end;

procedure TForm1.WebBrowser1TitleChange(Sender: TObject;
const Text: WideString);
begin
Label1.Caption := text;
Label1.Hint := text;
end;

procedure TForm1.WebBrowser1StatusTextChange(Sender: TObject;
const Text: WideString);
begin
Form1.Caption := 'Dr.Boo Browse: ' + text;
end;

procedure TForm1.fsdf1Click(Sender: TObject);
begin
Application.Terminate;
end;

procedure TForm1.Zakocz1Click(Sender: TObject);
begin
Application.Terminate;
end;

procedure TForm1.Zapisz1Click(Sender: TObject);
begin
if SaveDialog1.Execute then
    begin
    UrlDownloadToFile(nil,PChar(edit1.Text), PChar(SaveDialog1.Filename), 1, nil);
end;
end;

procedure TForm1.Dalej1Click(Sender: TObject);
begin
WebBrowser1.GoForward;
end;

procedure TForm1.Zatrzymaj1Click(Sender: TObject);
begin
WebBrowser1.Stop;
end;

procedure TForm1.Odwie1Click(Sender: TObject);
begin
WebBrowser1.Refresh;
end;

procedure TForm1.WebBrowser1ProgressChange(Sender: TObject; Progress,
ProgressMax: Integer);
begin
ProgressMax := 100;
Gauge1.Progress := Progress;
end;

procedure TForm1.WebBrowser1NewWindow2(Sender: TObject;
var ppDisp: IDispatch; var Cancel: WordBool);
var
NewWindow: TForm1;
begin
NewWindow := TForm1.Create(self);
NewWindow.Show;
ppDisp := NewWindow.Webbrowser1.DefaultDispatch;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
DragAcceptFiles(Handle, True);
end;

procedure TForm1.Image6MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
// ruszaj okinkiem
if button = mbleft then
begin
releasecapture;
TWincontrol(Panel1).perform(WM_syscommand, $F012, 0);
end;
end;

procedure TForm1.Label1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
// ruszaj okinkiem
if button = mbleft then
begin
releasecapture;
TWincontrol(Panel1).perform(WM_syscommand, $F012, 0);
end;
end;

procedure TForm1.Image9MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
// ruszaj okinkiem
if button = mbleft then
begin
releasecapture;
TWincontrol(Panel1).perform(WM_syscommand, $F012, 0);
end;
end;

procedure TForm1.Stronsieciweb2Click(Sender: TObject);
var address : string;
begin
InputBox( 'Otwórz stronę sieci web', 'Adres strony:', address );
edit1.text := address;
WebBrowser1.Navigate(address);
end;

procedure TForm1.Plikzdysku2Click(Sender: TObject);
begin
if OpenDialog1.Execute then
edit1.text := OpenDialog1.FileName;
WebBrowser1.Navigate(edit1.text);
end;

procedure TForm1.Zapisz2Click(Sender: TObject);
begin
if SaveDialog1.Execute then
    begin
    UrlDownloadToFile(nil,PChar(edit1.Text), PChar(SaveDialog1.Filename), 1, nil);
end;
end;

procedure TForm1.Zakocz2Click(Sender: TObject);
begin
Application.Terminate;
end;

procedure TForm1.Zawszenawierzchu2Click(Sender: TObject);
begin
    If Zawszenawierzchu2.Checked Then
Begin
    Zawszenawierzchu2.Checked:=Not(Zawszenawierzchu2.Checked);
SetWindowPos(TForm1(Self).Handle,HWND_NOTOPMOST,0,0,0,0,SWP_NOSIZE+SWP_NOMOVE);
End
Else
Begin
    Zawszenawierzchu2.Checked:=Not(Zawszenawierzchu2.Checked);
SetWindowPos(TForm1(Self).Handle,HWND_TOPMOST,0,0,0,0,SWP_NOSIZE+SWP_NOMOVE);
end;
end;

procedure TForm1.Pobierznagwki1Click(Sender: TObject);
begin
NMHTTP1.ReportLevel := Status_Basic;
NMHTTP1.Get(Edit1.Text);
Memo1.Text := NMHTTP1.Header;
panel5.visible := true;
end;

procedure TForm1.Pobierzrdo2Click(Sender: TObject);
begin
NMHTTP1.Body := '';
NMHTTP1.ReportLevel := Status_Basic;
NMHTTP1.Get(WebBrowser1.LocationURL);
Memo1.Text := NMHTTP1.Body;
panel5.visible := true;
end;

procedure TForm1.Kodowanyformatadresustrony1Click(Sender: TObject);
begin
NMURL1.InputString := Edit1.Text;
MessageDlg('Kodowany format adresu strony: ' + NMURL1.Encode , mtInformation, [mbOK], 0);
end;

procedure TForm1.Wstecz2Click(Sender: TObject);
begin
WebBrowser1.GoBack;
end;

procedure TForm1.Dalej2Click(Sender: TObject);
begin
WebBrowser1.GoForward;
end;

procedure TForm1.Zatrzymaj2Click(Sender: TObject);
begin
WebBrowser1.Stop;
end;

procedure TForm1.Odwie2Click(Sender: TObject);
begin
WebBrowser1.Refresh;
end;

procedure TForm1.Image11MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
// ruszaj okinkiem
if button = mbleft then
begin
releasecapture;
TWincontrol(Panel5).perform(WM_syscommand, $F012, 0);
end;
end;

procedure TForm1.Label4Click(Sender: TObject);
begin
panel5.Visible := false;
end;

procedure TForm1.Shape3MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
panel5.Visible := false;
end;

end.

OldShaterhan
• 2009-10-08 10:16

Ja mam taki problem otóż przestał działać mi Enter...

Scoti
• 2010-02-11 22:15

Mam komponent TWebBrowser i jak robie button z kodem: WebBrowser1.GoBack to wyskakuje blad na WebBrowser1.GoBack.. Dlaczego?

gates22
• 2008-08-03 11:41

co to jest to Animatel?

ptr20
• 2007-03-26 20:14

może u ciebie to działa a patrz że prawnie nie u wszystkich więć może byś zamieścił plik

hacker92
• 2005-08-16 14:34

ej mam delphi7 i nie wiem gdzie moge znaleść TWebBrowser jak chcecie mi pomóc to piszcie na g9187211

unkind
• 2005-06-21 07:17

nie mam tych komponentow : Psock, NMHttp moze byscie mi pomogli :(
:)

jakubkrol
• 2005-06-13 19:46

WOW A MI NIE DZIAŁA :P:P:P

Sebek
• 2004-03-01 22:49

http://4programmers.net/view.php?id=192 i po co dwa razy to samo ? :/

Vendro
• 2003-12-25 11:49

Mógłbyś jeszcze na początku dodać, że w wersji Enterprise komponent TWebBrowser jest domyślnie zainstalowany, a w wersjach Personal trzeba go zainstalować ręcznie korzystając z ActiveX. !!

mcbury
• 2003-12-18 21:24

Ej... ale to już było!! idz sobie i coś wymyśl lepszego a nie kopiuj edytuj i wklejaj z powrotem!!

Adam Boduch
• 2003-12-17 14:46

Cóż, chciał dobrze, ale wyszło tak sobie. Lepiej napisać lepszy artykuł i dłużej się pomęczyć niż wklejac na szybko...
Dodałem kolorowanie składni, przeniosłem do gotowców - na przyszłość prosze dokładniej wybierać lokalizację artykułu. No i proszę wziąć pod uwagę zastrzeżenia Łukasza; artykuł zawsze można edytować...

ŁF
• 2003-12-16 23:53

znowu to samo... co za porażka... po pierwsze: formatuj kod, rób wcięcia, i uzywaj tagów delphi. po drugie - to nie jest materiał na artykuł, tylko na gotowca. po trzecie - robisz literówki, nie tylko w treści tego tekstu, ale i w kodzie źródłowym.

obciach!!!!!!

migajek
• 2003-12-22 20:17

Wiesz, to jest ok. tylko że trochę to prymitywne, ale pozatym nie jest źle

m@ti
• 2003-12-22 22:30

można dodać jezcze: procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
begin
Edit1.Text:=WebBrowser1.LocationURL;
end;

Przeglądarka oprata na machanizmach Internet Explorera

jaroslaw_szulc

14 komentarzy

Praca dla programistów

Forum dyskusyjne

Sprawy administracyjne

O nas

Skontaktuj się z nami