自动提交表单

本文摘自:http://hlake.blogchina.com/2421795.html
用程式控制表单的提交。做一个自动用网页发送短信息的东东。

语言：delphi 7.0


unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, OleCtrls, SHDocVw, StdCtrls, IdBaseComponent, IdComponent,
IdTCPConnection, IdTCPClient, IdHTTP,MSHTML ,ActiveX, ExtCtrls;

type
TForm1 = class(TForm)
WebBrowser1: TWebBrowser;
Memo1: TMemo;
Button1: TButton;
Edit2: TEdit;
Edit3: TEdit;
Edit4: TEdit;
Timer1: TTimer;
Edit5: TEdit;
Label1: TLabel;
Memo2: TMemo;
Button2: TButton;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
CheckBox1: TCheckBox;
procedure FormCreate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure WebBrowser1NavigateComplete2(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
procedure WebBrowser1BeforeNavigate2(Sender: TObject;
const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
Headers: OleVariant; var Cancel: WordBool);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

//因发送一个短信时会有一个弹出窗口，用来开关处理短信息或关闭弹出窗口
closeMessgeWindow: integer;

//memo2 的 lines index
scro:integer;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);

begin
WebBrowser1.Navigate('http://xxx.xxx.xxx.xxx/index.asp');
scro := 0;
end;


procedure TForm1.Timer1Timer(Sender: TObject);
var Form : IHTMLFormElement ;
D:IHTMLDocument2 ;
hCurrentWindow: HWnd;
szText: array[0..254] of char;
oldcmw:integer;
oldscro:integer;
begin
Timer1.Interval := strtoint(edit5.text) * 1000;
if (closeMessgeWindow = 1) then
begin

//关闭处理短信息后弹出窗口
closeMessgeWindow := 0;
hCurrentWindow := GetWindow(Handle, GW_HWNDFIRST);
while hCurrentWindow <> 0 do
begin
if GetWindowText(hCurrentWindow, @szText, 255)>0 then
begin
if (StrPas(@szText))='Microsoft Internet Explorer' then
// if GetClassName(hCurrentWindow, @szText, 255)>0 then
// if (StrPas(@szText))='窗体类名称' then
break;
end;
hCurrentWindow:=GetWindow(hCurrentWindow, GW_HWNDNEXT);
end;
If hCurrentWindow<>0 then
PostMessage(hCurrentWindow, WM_CLOSE, 0, 0)
end
else
begin

oldcmw := closeMessgeWindow;
oldscro := scro;

closeMessgeWindow := 1;
scro := scro + 1;
if (memo2.Lines.Count < scro) then
begin
scro := 1;
if not checkbox1.Checked then
Button2Click(sender);
end;
try

//取的网页上的控件并操作后提交

with WebBrowser1 do begin
D := Document as IHTMLDocument2;
Form := D.Forms.item('form1',0) as IHTMLFormElement;
(form.item('message',0) as IHTMLElement).setAttribute('value',Memo1.Text,0);
(form.item('tarphone',0) as IHTMLElement).setAttribute('value',memo2.Lines.ValueFromIndex[scro-1],0);
(form.item('sign',0) as IHTMLElement).setAttribute('value',edit2.Text,0);
(form.item('srcphone',0) as IHTMLElement).setAttribute('value',edit3.Text,0);
(form.item('password',0) as IHTMLElement).setAttribute('value',edit4.Text,0);
(form.item('Submit3',0) as IHTMLElement).click;
end;

except
closeMessgeWindow:=oldcmw;
scro:= oldscro;
end;

end;
end;


procedure TForm1.Button1Click(Sender: TObject);
var Form : IHTMLFormElement ;
D:IHTMLDocument2 ;
begin
closeMessgeWindow := 1;
try
with WebBrowser1 do begin
D := Document as IHTMLDocument2;
Form := D.Forms.item('form1',0) as IHTMLFormElement;
(form.item('message',0) as IHTMLElement).setAttribute('value',Memo1.Text,0);
(form.item('tarphone',0) as IHTMLElement).setAttribute('value',memo2.Lines.ValueFromIndex[0],0);
(form.item('sign',0) as IHTMLElement).setAttribute('value',edit2.Text,0);
(form.item('srcphone',0) as IHTMLElement).setAttribute('value',edit3.Text,0);
(form.item('password',0) as IHTMLElement).setAttribute('value',edit4.Text,0);
//form.submit; // this line work too
(form.item('Submit3',0) as IHTMLElement).click;
//goback();
end;
except
showmessage('fail!');
end;
end;

procedure TForm1.WebBrowser1NavigateComplete2(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
begin

//如果发送失败（没有弹出信息框返回上页）

if (url<> 'http://xxx.xx.xx.xx/index.asp') then
begin
WebBrowser1.GoBack;
end;
end;


procedure TForm1.Button2Click(Sender: TObject);
begin
if not timer1.Enabled then
begin
timer1.Enabled := true;
button2.Caption := '停止自动';
end
else
begin
timer1.Enabled := false;
button2.Caption := '自动发送';
end;
end;

end.