源代码如下:
unit Unit2;
interface
uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, OleCtrls, SHDocVw;
type TForm2 = class(TForm) WebBrowser1: TWebBrowser; Button1: TButton; ListBox1: TListBox; procedure FormShow(Sender: TObject); procedure Button1Click(Sender: TObject); procedure WebBrowser1DocumentComplete(ASender: TObject; const pDisp: IDispatch; var URL: OleVariant); ******* { Private declarations } public { Public declarations } end;
var Form2: TForm2; ok:Boolean;
implementation
{$R *.dfm} //{$APPTYPE CONSOLE}
procedure TForm2.Button1Click(Sender: TObject); var I: Integer; begin //循环读取网站 for I := 0 to ListBox1.Count-1 do begin WebBrowser1.Navigate(ListBox1.Items[i]);
while True do begin if ok then break; Application.ProcessMessages(); end; ok:=false; end;
end;
procedure TForm2.FormShow(Sender: TObject); var filename:string; myfile:TextFile; s:string; i:integer; begin //全局变量初始化 ok:=false; //初始化列表框 filename:=ExtractFilePath(Application.ExeName)+'\list.txt'; AssignFile(myfile,filename); try Reset(myfile); except on e:Exception do begin ShowMessage(e.Message); Rewrite(myfile); end;
end; i:=0; while not SeekEof(myfile) do begin Readln(myfile,s); ListBox1.Items.Add(s); inc(i); end; CloseFile(myfile);
end;
procedure TForm2.WebBrowser1DocumentComplete(ASender: TObject; const pDisp: IDispatch; var URL: OleVariant); begin
if(pDisp=WebBrowser1.Application) then begin //Writeln('ok'); ok:=true; end; end;
end.
源代码下载:http://www.rayfile.com/files/264444e1-1488-11df-9b90-0015c55db73d/
|
请发表评论