webbrower应用实例
unit webjb;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,OleCtrls, SHDocVw, StdCtrls, ExtCtrls, DBCtrls,
Db, DBTables, newcomb;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
Memo1: TMemo;
WebBrowser1: TWebBrowser;
Button5: TButton;
Button6: TButton;
Button7: TButton;
Table1: TTable;
Panel1: TPanel;
WebBrowser2: TWebBrowser;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Edit1: TEdit;
newcomb1: Tnewcomb;
Edit2: TEdit;
Edit3: TEdit;
Edit4: TEdit;
Label6: TLabel;
newcomb2: Tnewcomb;
Button8: TButton;
CheckBox1: TCheckBox;
procedure Button1Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure WebBrowser1NewWindow2(Sender: TObject; var ppDisp: IDispatch;
var Cancel: WordBool);
procedure Button7Click(Sender: TObject);
procedure WebBrowser2BeforeNavigate2(Sender: TObject;
const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
Headers: OleVariant; var Cancel: WordBool);
procedure FormCreate(Sender: TObject);
procedure newcomb2Change(Sender: TObject);
procedure WebBrowser1DownloadComplete(Sender: TObject);
procedure Button8Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses OleServer, MSHTML,ActiveX; //使用Olevariant类型必须使用的东西
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
begin
close;
end;
procedure TForm1.Button3Click(Sender: TObject);
var
Myinput : Olevariant;
begin
Myinput := WebBrowser1.OleObject.document.all.item('txtLoginID',0); //找到登录用户名的输入框 ,用寻找内容相应INPUT的ID值
Myinput.value := 'sw'; //输入用户名
Myinput := WebBrowser1.oleobject.document.all.item('txtPwd',0); //找到登录密码的输入框
Myinput.value := '123456'; //输入密码
//提交操作
Myinput :=WebBrowser1.oleobject.document.all.item('btnLogin',0); //或者用指定表单名称提交
Myinput.Click; //点击操作，对其它对象也可同样操作
end;
procedure TForm1.Button4Click(Sender: TObject);
//用这个函数，可以看到编辑框 和按钮的Name属性（控件的名称）
var
Count:Integer;
begin
memo1.Text:='';
for Count :=0 to WebBrowser2.OleObject.Document.All.Length -1 do //当前页面中所有对象数量
Begin
if WebBrowser2.OleObject.Document.All.Item(Count).TagName ='TD' then //找出所有属性为TD的对象//
Begin
memo1.Lines.Add('当前网页查找的内容有：');
memo1.Lines.Add(WebBrowser2.OleObject.Document.All.Item(Count).InnerText); //显示找到的对象的文本信息
memo1.Lines.Add('');
memo1.Lines.Add(WebBrowser2.OleObject.Document.All.Item(Count).InnerHtml); //显示找到的对象的HTML源码信息
end;
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
Form1.WebBrowser1.Navigate('http://www.....);
button3.Enabled:=true;
button4.Enabled:=true;
end;
procedure TForm1.Button5Click(Sender: TObject);
var //uses MSHTML
doc:IHTMLDocument2;
all:IHTMLElementCollection;
item,itemc:olevariant;
begin
doc:=webbrowser1.Document as IHTMLDocument2;
all:=doc.all;
item:=all.tags('INPUT');
itemc:=item.item(0);
itemc.innerText:='abc';
end;
procedure TForm1.Button6Click(Sender: TObject);
//uses ActiveX;
var ms: TMemoryStream;
begin
if not Assigned(WebBrowser1.Document) then Exit;
ms := TMemoryStream.Create;
(WebBrowser1.Document as IPersistStreamInit).Save(TStreamAdapter.Create(ms), True);
ms.Position := 0;
// Memo1.Lines.LoadFromStream(ms,TEncoding.UTF8);
Memo1.Lines.LoadFromStream(ms);
// Memo1.Lines.LoadFromStream(ms, TEncoding.Default); {GB2312 等双字节}
ms.Free;
end;
procedure TForm1.WebBrowser1NewWindow2(Sender: TObject;
var ppDisp: IDispatch; var Cancel: WordBool);
begin
// 將新視窗在自身開啟
ppdisp := webBrowser2.Application;
end;
procedure TForm1.Button7Click(Sender: TObject);
var
Myinput1 : Olevariant;
xh1,wjbh1,jbrq1,xm1,grdm1:string;
begin
with table1 do
begin
open;
if eof then showmessage('已经是最后一条记录了!');
while not eof do
begin
xh1:=fieldbyname('xh').asstring;
wjbh1:=fieldbyname('wjbh').asstring;
jbrq1:=fieldbyname('jbrq').asstring;
xm1:=fieldbyname('xm').asstring;
grdm1:=fieldbyname('grdm').asstring;
Myinput1 := WebBrowser1.OleObject.document.all.item('writ_sort',0); //找件号输入框 ,用寻找内容相应INPUT的ID值
Myinput1.value := xh1; //输入件号
Myinput1 := WebBrowser1.oleobject.document.all.item('writ_code',0); //找到文件编号的输入框
Myinput1.value := wjbh1; //输入文件编号
Myinput1 := WebBrowser1.oleobject.document.all.item('writ_keep_time',0); //找到保管期限输入框
//Myinput1.selectedIndex :=2;
Myinput1.selectedIndex :=newcomb1.Itemindex;
Myinput1 := WebBrowser1.oleobject.document.all.item('writ_done_date',0); //找到文件编号的输入框
Myinput1.value := jbrq1; //输入形成时间
Myinput1 := WebBrowser1.oleobject.document.all.item('writ_name',0); //找到文件编号的输入框
//Myinput1.value := xm1+'('+grdm1+')'+'医疗转移参保凭证'; //输入题名
Myinput1.value := xm1+'('+grdm1+')'+newcomb2.text;
Myinput1 := WebBrowser1.oleobject.document.all.item('writ_entity',0); //找到机构代码的输入框
Myinput1.value := edit1.text;
Myinput1 := WebBrowser1.oleobject.document.all.item('writ_duty',0); //找到责任者的输入框
Myinput1.value := edit2.text;
//Myinput1 := WebBrowser1.oleobject.document.all.item('writ_date',0); //找到归档日期的输入框
//Myinput1.value := edit3.text;
Myinput1 := WebBrowser1.oleobject.document.all.item('writ_page_num',0); //找到责任者的输入框
Myinput1.value := edit4.text;
if checkbox1.Checked=true then
button8.Click();
if not eof then
begin
next;
break;
end
else
showmessage('已经是最后一条记录!'); //这条提示在循环内，没用
end;
end;
{Myinput1 := WebBrowser2.OleObject.document.all.item('writ_sort',0); //找件号输入框 ,用寻找内容相应INPUT的ID值
Myinput1.value := '120'; //输入件号
Myinput1 := WebBrowser2.oleobject.document.all.item('writ_code',0); //找到文件编号的输入框
Myinput1.value := '123456'; //输入文件编号
Myinput1 := WebBrowser2.oleobject.document.all.item('writ_done_date',0); //找到文件编号的输入框
Myinput1.value := '20110501'; //输入形成时间
Myinput1 := WebBrowser2.oleobject.document.all.item('writ_name',0); //找到文件编号的输入框
Myinput1.value := '（）门诊报销结算材料'; //输入题名
}
end;
procedure TForm1.WebBrowser2BeforeNavigate2(Sender: TObject;
const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
Headers: OleVariant; var Cancel: WordBool);
begin
WebBrowser1.Navigate(string(URL)); // 在webbrower2出现前,再指回WebBrowser1
Cancel := True
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
newcomb1.itemindex:=0;
newcomb2.text:='';
edit4.text:='1'
end;
procedure TForm1.newcomb2Change(Sender: TObject);
begin
case newcomb2.itemindex of
0: edit1.text:='2560';
1: edit1.text:='2570';
2: edit1.text:='2591';
3: edit1.text:='2580';
4: edit1.text:='2502';
end;
end;
procedure TForm1.WebBrowser1DownloadComplete(Sender: TObject);
begin
(WebBrowser1.Document as IHTMLDocument2).parentWindow.execScript('window.onerror=function(){return true}','JavaScript');
end;
procedure TForm1.Button8Click(Sender: TObject);
var
i:integer;
t:OleVariant;
begin
t := WebBrowser1.OleObject.Document;
for i := 0 to t.all.length - 1 do
begin
if t.all.item(i).tagName = 'INPUT' then
begin
if t.all.item(i).type = 'submit' then //如submit改为reset，则为点击取消键
begin
t.all.item(i).click;
end;
end;
end;
end;
initialization
oleinitialize(nil);
finalization
oleuninitialize;
end.
