delphi里使用IDHTTP实现多线程下载网页源码

减小字体 增大字体 作者:佚名  来源:不详  发布时间:2011-01-25 11:14:45

unit ipscanthread;

interface

uses
Classes, StdCtrls, dialogs,SysUtils, ComCtrls, Windows, idtcpclient,IdHTTP,WinInet;
var
CS:TRTLCriticalSection;    //定义全局临界区

type
ipscan = class(TThread)
private
    ipUrl:string;
    ViewList:TTreeview;
    { Private declarations }
protected
    procedure Execute; override;
    function CheckUrl(const Url: string):boolean;
    procedure ViewInfo();
    function checkweb(ip:string):string;
public
    constructor Create(hurl:string;vlist:TTreeview);
end;

implementation
uses unit1;

constructor ipscan.Create(hurl:string;vlist:TTreeview); //取id!!
begin
ipUrl:=hurl;
ViewList:=vlist;
FreeOnTerminate := True;
inherited create(false);
end;

function ipscan.checkweb(web:string):string;
var
idweb:TIdHTTP;
value:string;
begin
idweb:=Tidhttp.Create(nil);
idweb.ReadTimeout:= 30000;
try
try
   Values:= Idweb.Get(web);
   except idweb.Free;
   end;
finally
    idweb.Free;
end;
result:=web;
end;

function ipscan.CheckUrl(const Url: string):boolean;
var
idping:TIdTCPClient;
begin
result:=false;
idping:=TidTCPClient.Create(nil);
idping.Port:=80;
idping.Host:=Url;
try
try
   idping.Connect(5000);
   if idping.Connected then result:=true;
   except idping.Disconnect;
end;
finally
    idping.Free;
end;
end;

procedure ipscan.ViewInfo();
begin
viewlist.Items.Add(nil,ipurl);
memo1.lines.add(checkweb(ipurl));
end;

procedure ipscan.Execute;
begin
if CheckUrl(ipUrl) then
begin
    Synchronize(ViewInfo);
end;
end;

Tags:

作者:佚名
  • 好的评价 如果您觉得此文章好,就请您
      0%(0)
  • 差的评价 如果您觉得此文章差,就请您
      0%(0)

文章评论评论内容只代表网友观点,与本站立场无关!

   评论摘要(共 0 条,得分 0 分,平均 0 分) 查看完整评论

广告位置B