unit1.~pas

很多人都说webbrowser修改不了GOOKIE 所以做了一个这样的实例..希望能帮助大家 里面全部有注释

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, ImgList, StdCtrls, OleCtrls, SHDocVw, ToolWin,
  ExtCtrls, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  IdHTTP,mshtml, Grids, DBGrids, Sockets, ShellApi;

type
  TForm1 = class(TForm)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    TabSheet3: TTabSheet;
    TabSheet4: TTabSheet;
    TabSheet5: TTabSheet;
    TabSheet6: TTabSheet;
    ImageList1: TImageList;
    StatusBar1: TStatusBar;
    WebBrowser1: TWebBrowser;
    IdHTTP1: TIdHTTP;
    Label6: TLabel;
    Label5: TLabel;
    CoolBar1: TCoolBar;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ToolButton5: TToolButton;
    ToolButton6: TToolButton;
    ToolButton7: TToolButton;
    ToolButton8: TToolButton;
    ToolButton9: TToolButton;
    Panel2: TPanel;
    Label2: TLabel;
    Edit2: TEdit;
    Button2: TButton;
    Panel1: TPanel;
    Label1: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Edit1: TEdit;
    Button1: TButton;
    CoolBar2: TCoolBar;
    DBGrid1: TDBGrid;
    Panel3: TPanel;
    Label7: TLabel;
    Edit3: TEdit;
    Button3: TButton;
    Edit4: TEdit;
    Label8: TLabel;
    CheckBox1: TCheckBox;
    Panel4: TPanel;
    Label9: TLabel;
    CheckBox2: TCheckBox;
    CheckBox3: TCheckBox;
    CheckBox4: TCheckBox;
    CheckBox5: TCheckBox;
    Label10: TLabel;
    Label11: TLabel;
    Edit5: TEdit;
    Label12: TLabel;
    Edit6: TEdit;
    Button4: TButton;
    GroupBox1: TGroupBox;
    Button5: TButton;
    Button6: TButton;
    Button7: TButton;
    Button8: TButton;
    Button9: TButton;
    Button10: TButton;
    Button11: TButton;
    Panel5: TPanel;
    Panel6: TPanel;
    Panel7: TPanel;
    Panel8: TPanel;
    Panel9: TPanel;
    Panel10: TPanel;
    Label13: TLabel;
    Label14: TLabel;
    Label15: TLabel;
    Label16: TLabel;
    Label17: TLabel;
    Label18: TLabel;
    Label19: TLabel;
    Label20: TLabel;
    Label21: TLabel;
    Label22: TLabel;
    Label23: TLabel;
    Label24: TLabel;
    Edit7: TEdit;
    Edit8: TEdit;
    Label25: TLabel;
    Button12: TButton;
    WebBrowser2: TWebBrowser;
    WebBrowser3: TWebBrowser;
    WebBrowser4: TWebBrowser;
    Label26: TLabel;
    Label27: TLabel;
    Label28: TLabel;
    Label29: TLabel;
    WebBrowser5: TWebBrowser;
    TcpServer1: TTcpServer;
    TcpClient1: TTcpClient;
    procedure WebBrowser1DownloadBegin(Sender: TObject);
    procedure WebBrowser1DownloadComplete(Sender: TObject);
    procedure ToolButton1Click(Sender: TObject);
    procedure ToolButton5Click(Sender: TObject);
    procedure ToolButton7Click(Sender: TObject);
    procedure ToolButton9Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure ToolButton3Click(Sender: TObject);
    procedure WebBrowser1DocumentComplete(Sender: TObject;
      const pDisp: IDispatch; var URL: OleVariant);
    procedure Button2Click(Sender: TObject);
    procedure Button12Click(Sender: TObject);
    procedure Label26Click(Sender: TObject);
    procedure WebBrowser1ProgressChange(Sender: TObject; Progress,
      ProgressMax: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  Doc : IHTMLDocument2;
  i:integer;
implementation

{$R *.dfm}

procedure TForm1.WebBrowser1DownloadBegin(Sender: TObject);
begin
StatusBar1.Panels[0].Text:='正在连接：'+Edit1.text;
end;

procedure TForm1.WebBrowser1DownloadComplete(Sender: TObject);
begin
StatusBar1.Panels[0].Text:='完成  '+WebBrowser1.LocationURL ;
end;

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

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

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

procedure TForm1.ToolButton9Click(Sender: TObject);
begin
WebBrowser1.GoHome;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  p:integer;
  s:string;
begin
  if Edit1.Text='' then
  ShowMessage('地址不能为空');
WebBrowser1.Navigate(Edit1.Text);
 s := idHTTP1.Get('http://data.alexa.com/data?cli=10&dat=snba&url=' + Edit1.Text) ;
//先得到网页代码
  p:=pos('" TEXT="',s) + Length('" TEXT="');   //然后查找到text的字符,然后得到他的位置
  s:=copy(s,P,30);  //复制字符和得到正确位置(加" text="的长度后加30位置,开始取值)
  p:=pos('"/>',s); //在同行中遇到"/>结束
  Label3.Caption:=Copy(s,1,P -1); //将取得到的值赋给label3
end;

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

procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject;
  const pDisp: IDispatch; var URL: OleVariant);
begin
  begin
  Doc:=WebBrowser1.Document as IHTMLDocument2;  //获得 一个IHTMLDocument2对象
  edit2.Text:=Doc.cookie;    //Doc.cookie就是页面COOKIE信息了
end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  SList: TStrings;
begin
        if Edit2.Text = '' then Exit;
        SList := TStringList.Create; {修改浏览器的Cookies}
        Slist.CommaText := Edit2.Text;
        for i := 0 to SList.Count - 1 do {将Cookies分段提交给浏览器}
          Doc.cookie := SList.Strings[i];
        Webbrowser1.Refresh; {修改后Cookies后刷新浏览器}
        SList.Free; {释放}
end;

procedure TForm1.Button12Click(Sender: TObject);
begin
Edit8.text:=Tcpclient1.lookuphostaddr(trim(Edit7.Text));    //取得域名IP
    showmessage('提交中.......');
    Webbrowser2.Navigate('http://www.myipneighbors.com/?domainname='+edit8.text+'&security_code=true');
    webbrowser3.Navigate('http://whois.webhosting.info/'+edit8.text);
    webbrowser4.navigate('http://www.pipiki.com//ajax/IPReport.aspx?domain='+edit8.text);
    webbrowser5.Navigate('http://www.114best.com/ip/114?w='+edit8.text);
end;

procedure TForm1.Label26Click(Sender: TObject);
begin
if edit8.text <> '' then
ShellExecute(handle,nil,PChar('http://www.myipneighbors.com/?domainname='+Edit8.text),nil,nil,SW_SHOWNORMAL);
end;

procedure TForm1.WebBrowser1ProgressChange(Sender: TObject; Progress,
  ProgressMax: Integer);
begin
  if WebBrowser1.LocationURL <> 'about:blank' then
    edit1.Text := WebBrowser1.LocationURL
  else
    Edit1.Text := '';
end;

end.