请教webbrowser的navigate的用法，包括如何提交表单，如何设置http头 ( 积分: 200 )

请教webbrowser的navigate的用法，包括如何提交表单，如何设置http头

请教webbrowser的navigate的用法，包括如何提交表单，如何设置http头

navigate？？
Delphi中有范例文件
请参考 IEDelphi网站

IEDelphi网站在哪里

//一个QQ号码申请程序
(*//
标题:简单的图象识别
声明:本贴只作为技术交流
设计:Zswang
日期:2003-09-09

http://verify.tencent.com/getimage?0.13927358567975412
这是一个附加码～～

先分析下
难点：
1.四个数字加上了一些随机的布点～～
2.背景和字体颜色也随机～～

弱点：
1.数字大小一致，字体不会发生改变～～
2.只有两种颜色～～

思路：
取得背景色和字体色比较容易，谁的点多就是背景～～
这里是用TBitmap:ixelFormat来处理成单色～～

将标准的数字字体保存下来（就１０个），作为比较的元素～～
把两个图象重叠～～
比较重叠前和重叠后是否发生变化～～
这样就可以避免随机布点的干扰～～

话不多说，代码为例～～
//*)

unit RecogniseUnit;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, ImgList, StdCtrls, OleCtrls, SHDocVw,MSHTML,WinInet,
ComCtrls;

type
TFormRecognise = class(TForm)
ImageList1: TImageList;
Panel1: TPanel;
WebBrowser1: TWebBrowser;
Panel2: TPanel;
ButtonRefresh: TButton;
StatusBar1: TStatusBar;
Panel3: TPanel;
GroupBox1: TGroupBox;
PageControl1: TPageControl;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
Memo1: TMemo;
Memo2: TMemo;
edtCount: TEdit;
Label1: TLabel;
Label2: TLabel;
edtTimeOut: TEdit;
Label3: TLabel;
procedure ButtonRefreshClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
private
{ Private declarations }
Function GetQQ : String;
public
procedure FillIEForm(aValidatecode:String;bPost:boolean=False);
{ Public declarations }
end;

var
FormRecognise: TFormRecognise;
const
cURL='http://freeqq2.qq.com/nom_reg.shtml';
cImgX=231;
cImgY=314;
implementation

{$R *.dfm}

uses Math; //use Math.Min()
procedure TFormRecognise.FillIEForm(aValidatecode:String;bPost:boolean=False);
procedure DoWithHtmlElement(aElementCollection:IHTMLElementCollection);
var
k:integer;
vkleVariant;
Dispatch: IDispatch;
HTMLInputElement:IHTMLInputElement;
HTMLSelectElement:IHTMLSelectElement;
HTMLOptionElement: IHTMLOptionElement;
HTMLTextAreaElement: IHTMLTextAreaElement;
HTMLFormElement:IHTMLFormElement;
HTMLOptionButtonElement:IHTMLOptionButtonElement;
begin
for k:=0 to aElementCollection.length -1 do
begin
Vk:=k;
Application.ProcessMessages;
Dispatch:=aElementCollection.item(Vk,0);
if SUCCEEDED(Dispatch.QueryInterface(IHTMLFormElement,HTMLFormElement))then
begin
with HTMLFormElement do//表单
begin
//处理
if bPost then
begin
HTMLFormElement.submit ;
exit;
end;
end;
end
else if Succeeded(Dispatch.QueryInterface(IHTMLInputElement,HTMLInputElement)) then
begin
With HTMLInputElement do//单行文本
begin
if (UpperCase(Type_)='TEXT') or (UpperCase(Type_)='PASSWORD') then
begin
value:='qq';
if Name='Validatecode' then Value:=aValidatecode
else if Name='Passwd' then Value:='123456'
else if Name='Passwd1' then Value:='123456';
end
else if (UpperCase(Type_)='CHECKBOX') then//复选框
begin
checked:=true;
end
else if (UpperCase(Type_)='RADIO') then//单选框
begin
checked :=true;
end;
end;
end
else if Succeeded(Dispatch.QueryInterface(IHTMLSelectElement,HTMLSelectElement)) then
begin
With HTMLSelectElement do//下拉框
begin
selectedIndex :=1;
end;
end
else if Succeeded(Dispatch.QueryInterface(IHTMLTEXTAreaElement,HTMLTextAreaElement)) then
begin
with HTMLTextAreaElement do//多行文本
begin
value :='textarea';
end;
end
else if Succeeded(Dispatch.QueryInterface(IHTMLOptionElement,HTMLOptionElement)) then
begin
with HTMLOptionElement do//下拉选项
begin
//处理
end;
end
else if SUCCEEDED(Dispatch.QueryInterface(IHTMLOptionButtonElement,HTMLOptionButtonElement))then
begin
//不明
//处理
end
else
//showmessage('other');
;
end;
end;
var
HTMLDocument:IHTMLDocument2;
ElementCollection:IHTMLElementCollection;
begin
HTMLDocument:=IHTMLDocument2(WebBrowser1.Document);
if HTMLDocument<>nil then
begin
if HTMLDocument.frames.length =0 then//无框架
begin
ElementCollection:=HTMLDocument.Get_All;
DoWithHtmlElement(ElementCollection);
end;
end;
end;
function SameCanvas(mCanvasA, mCanvasB: TCanvas): Boolean; { 比较两个画布是否相同 }
var
I, J: Integer;
begin
Result := False;
if not Assigned(mCanvasA) then Exit;
if not Assigned(mCanvasB) then Exit;
for I := Min(mCanvasA.ClipRect.Left, mCanvasB.ClipRect.Left) to
Min(mCanvasA.ClipRect.Right, mCanvasB.ClipRect.Right) do
for J := Min(mCanvasA.ClipRect.Top, mCanvasB.ClipRect.Top) to
Min(mCanvasA.ClipRect.Bottom, mCanvasB.ClipRect.Bottom) do
if mCanvasA.Pixels[I, J] <> mCanvasB.Pixels[I, J] then Exit;
Result := True;
end; { SameCanvas }

procedure TFormRecognise.ButtonRefreshClick(Sender: TObject);
Var
iLoop, iCount, iTimeOut : Integer;
sQQ : String;
begin
Memo1.Lines.Clear;
Memo2.Lines.Clear;
Try
iCount := StrToInt(edtCount.Text);
If iCount<1 Then iCount := 1;
Except
iCount := 1;
End;
Try
iTimeOut := StrToInt(edtTimeOut.Text) * 1000;
Except
iTimeOut := 1000;
End;
//
TButton(Sender).Enabled := False;
For iLoop := 1 To iCount Do
Begin
sQQ := GetQQ;
Memo2.Lines.Add(sQQ);
Try
StrToInt(sQQ);
Memo1.Lines.Add(sQQ);
Except
End;
StatusBar1.Panels[0].Text := IntToStr(iLoop) + '/' + IntToStr(iCount);
Update;
Sleep(iTimeOut);
End;
ButtonRefresh.Enabled := True;
end;


procedure TFormRecognise.FormCreate(Sender: TObject);
begin
//WebBrowser1.Navigate('http://freeqq2.qq.com/nom_reg.shtml');
//WebBrowser1.Navigate('about:blank');
WebBrowser1.Left:=Panel1.Left-CImgX+8;//-223 0 231
WebBrowser1.Top:=Panel1.Top-CImgY+8;; //-306 0 314
WebBrowser1.Width:=CImgX+50;//300 52
WebBrowser1.Height:=CImgY+50;//350 23
end;

procedure TFormRecognise.FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
begin
Tag:=27;
if WebBrowser1.Busy then
Begin
WebBrowser1.Navigate('about:blank');
Application.Terminate;
End;
end;

function TFormRecognise.GetQQ: String;
procedure fNumBitmap(mHandle: THandle; mIndex: Integer; mBitmap: TBitmap);
var
vDC: HDC;
begin
vDC := GetDC(mHandle);
try
mBitmap.Assign(nil);
mBitmap.Width := 5;
mBitmap.Height := 8;
BitBlt(mBitmap.Canvas.Handle, 0, 0, mBitmap.Width, mBitmap.Height, vDC,
CImgX + 6 * mIndex, CImgY, SRCCOPY);
mBitmap.PixelFormat := pf8bit;
mBitmap.PixelFormat := pf1bit;
finally
DeleteDC(vDC);
end;
end;

function fGetNum(mHandle: THandle; mIndex: Integer): Integer;
var
I: Integer;
vBitmapA: TBitmap;
vBitmapB: TBitmap;
begin
Result := -1;
vBitmapA := TBitmap.Create;
vBitmapB := TBitmap.Create;
fNumBitmap(mHandle, mIndex, vBitmapA);
vBitmapB.Width := vBitmapA.Width;
vBitmapB.Height := vBitmapA.Height;
for I := 9 downto 0 do begin //8会覆盖3的基础码，所以反循环
vBitmapB.Canvas.Draw(0, 0, vBitmapA);
ImageList1.Draw(vBitmapB.Canvas, 0, 0, I);
vBitmapB.PixelFormat := pf8bit;
vBitmapB.PixelFormat := pf1bit;
if SameCanvas(vBitmapA.Canvas, vBitmapB.Canvas) then begin
Result := I;
Exit;
end;
end;
vBitmapA.Free;
vBitmapB.Free;
end;
procedure AppendFile(aFileName,aContent:String);
var
StrList:TStringList;
begin
StrList:=TStringList.Create;
//有则追加
if FileExists(aFileName) then
StrList.LoadFromFile(aFileName);
StrList.Add(aContent);
StrList.SaveToFile(aFileName);
StrList.Free;
end;

var
S,tmpStr,tmpContent: string;
I: Integer;
HTMLDocument:IHTMLDocument2;
begin
Result := '';
if not InternetCheckConnection(PChar(CUrl), 1, 0) then
Begin
//ShowMessage('网路不通!');
Result := '网路不通!';
Exit;
End;
WebBrowser1.Navigate(CURL);
while WebBrowser1.ReadyState <READYSTATE_COMPLETE do
Application.ProcessMessages;
S := '';
SetWindowPos(Handle, HWND_TOPMOST, Left, Top, 0, 0, SWP_NOSIZE);
for I := 0 to 3 do S := S + IntToStr(fGetNum(WebBrowser1.Handle, I));
SetWindowPos(Handle, HWND_NOTOPMOST, Left, Top, 0, 0, SWP_NOSIZE);
//填 表
FillIEForm(S);
//提交
FillIEForm('',True);
//等待提交完毕
while (WebBrowser1.LocationURL =CURL) do
Begin
//强制结束
If Tag=27 then Exit;
Application.ProcessMessages;
End;
//显示完毕
while WebBrowser1.ReadyState <READYSTATE_COMPLETE do
Application.ProcessMessages;

if Succeeded(WebBrowser1.Document.QueryInterface(IHTMLDocument2,HTMLDocument)) then
Begin
if assigned(HTMLDocument.body) then
begin
tmpStr := HTMLDocument.body.OuterText;
if tmpStr<>'' then
begin
if Pos('您申请的QQ号码为：', tmpStr)>0 then
Begin
tmpContent := Copy(tmpStr, Pos('您申请的QQ号码为：', tmpStr), 28) + #13#10;
Result := tmpContent;
//ShowMessage(tmpContent+#13#10+#13#10+'保存于<QQ号码申请列表.txt>');
//保存
AppendFile(ExtractFilePath(Application.ExeName) + 'QQ号码申请列表.txt', tmpContent);
End
else if Pos('此ip申请qq号码过多，请稍后再试!!', tmpStr)>0 then
//ShowMessage('此ip申请qq号码过多，请稍后再试!!')
Result := '此IP申请qq号码过多，请稍后再试!'
else
//ShowMessage('未知错误');
Result := '未知错误【' + tmpStr + '】';
end
else //if tmpStr=''
//ShowMessage('该IP已经申请过');
Result := '该IP已经申请过';
End;
End;
WebBrowser1.Navigate('about:blank');
end;

end.

虽然这个答案解决了一部分问题，可是我还是希望知道navigate的范例
因为需要指定一个refer页，而并非webbrowser实际的refer页，有人知道吗

用IdHTTP吧，WebBrowser好像不能指定refer页。

WebBrowser的refer是只读的.

但是webbrowser的navigate可以设置http头，谁知道怎么设置

搜了个C++的代码给你.自己改成delphi的
CString postStr = "&USER=AA&PASS=BB";
CComVariant vPost(postStr);

pBrowser->Navigate2 (&vUrl, &vempty,&vempty,
&vPost,&vempty);

vb的

Sub Command1_Click()
Dim URL As String
Dim Flags As Long
Dim TargetFrame As String
Dim PostData() As Byte
Dim Headers As String

URL = "http://YourServer" ' A URL that will accept a POST
Flags = 0
TargetFrame = ""

PostData = "Information sent to host"

' VB creates a Unicode string by default so we need to
' convert it back to Single byte character set.
PostData = StrConv(PostData, vbFromUnicode)

Headers = "Content-Type: application/x-www-form-urlencoded" & _
vbCrlf
WebBrowser1.Navigate URL, Flags, TargetFrame, PostData, Headers
End Sub