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;

最后修改:2010 年 08 月 05 日
卧槽,全是白嫖客,服务器不要钱吗?