怎么测试一个网址是否有效 (200分)

  • 主题发起人 主题发起人 xsh123
  • 开始时间 开始时间
X

xsh123

Unregistered / Unconfirmed
GUEST, unregistred user!
原来的问题自己解决了,重新问一个,还是200分,有谁知道怎么测试一个网址是否有效?
 
恩,用定时器做,但是感觉上占用资源太厉害了,有朋友有更好的办法吗?
 
我也想知道。。。。。up
 
自己解决了,重新问一个,还是200分,有谁知道怎么测试一个网址是否有效?
 
我也想知道!!!
 
帮你提前。
 
别人写的,我试过能用
Function CheckUrl(url:string):boolean;
var
hSession, hfile, hRequest: hInternet;
dwindex,dwcodelen :dword;
dwcode:array[1..20] of char;
res : pchar;
begin
if pos('http://',lowercase(url))=0 then
url := 'http://'+url;
Result := false;
hSession := InternetOpen('InetURL:/1.0',
INTERNET_OPEN_TYPE_PRECONFIG,nil, nil, 0);
if assigned(hsession) then
begin
hfile := InternetOpenUrl(hsession,pchar(url),nil,0,INTERNET_FLAG_RELOAD,0);
dwIndex := 0;
dwCodeLen := 10;
HttpQueryInfo(hfile, HTTP_QUERY_STATUS_CODE,
@dwcode, dwcodeLen, dwIndex);
res := pchar(@dwcode);
result:= (res ='200') or (res ='302');
if assigned(hfile) then
InternetCloseHandle(hfile);
InternetCloseHandle(hsession);
end;
end;
 
如何实现PING功能测试某一IP地址通迅状况 (我这有这个资料,你需不需要??)
 
要,提供资料也有分
 
用Indyhttp 連一下﹐如果連上去就有效﹐連不上的就無
 
简单一点,链接上去看返回值!!
 
我有几百万个链接.一个一个手工连?这玩笑开大了吧.
Indyhttp我没用过,有用吗?
 
TIdHttp.Get(AUrl);
if TIdHttp.ResponseCode = 200 then OK
else Not OK.
 
moonbird兄
详细点
 
这个资料你看看吧
PING实际上是用ICMP.dll中的一组函数实现的。
unit icmp;

interface

{$IFDEF VER80}
// This source file is *NOT* compatible with Delphi 1 because it uses
// Win 32 features.
{$ENDIF}

uses
Windows, SysUtils, Classes, WinSock;

const
IcmpVersion = 102;
IcmpDLL = 'icmp.dll';

// IP status codes returned to transports and user IOCTLs.
IP_SUCCESS = 0;
IP_STATUS_BASE = 11000;
IP_BUF_TOO_SMALL = (IP_STATUS_BASE + 1);
IP_DEST_NET_UNREACHABLE = (IP_STATUS_BASE + 2);
IP_DEST_HOST_UNREACHABLE = (IP_STATUS_BASE + 3);
IP_DEST_PROT_UNREACHABLE = (IP_STATUS_BASE + 4);
IP_DEST_PORT_UNREACHABLE = (IP_STATUS_BASE + 5);
IP_NO_RESOURCES = (IP_STATUS_BASE + 6);
IP_BAD_OPTION = (IP_STATUS_BASE + 7);
IP_HW_ERROR = (IP_STATUS_BASE + 8);
IP_PACKET_TOO_BIG = (IP_STATUS_BASE + 9);
IP_REQ_TIMED_OUT = (IP_STATUS_BASE + 10);
IP_BAD_REQ = (IP_STATUS_BASE + 11);
IP_BAD_ROUTE = (IP_STATUS_BASE + 12);
IP_TTL_EXPIRED_TRANSIT = (IP_STATUS_BASE + 13);
IP_TTL_EXPIRED_REASSEM = (IP_STATUS_BASE + 14);
IP_PARAM_PROBLEM = (IP_STATUS_BASE + 15);
IP_SOURCE_QUENCH = (IP_STATUS_BASE + 16);
IP_OPTION_TOO_BIG = (IP_STATUS_BASE + 17);
IP_BAD_DESTINATION = (IP_STATUS_BASE + 18);

// status codes passed up on status indications.
IP_ADDR_DELETED = (IP_STATUS_BASE + 19);
IP_SPEC_MTU_CHANGE = (IP_STATUS_BASE + 20);
IP_MTU_CHANGE = (IP_STATUS_BASE + 21);

IP_GENERAL_FAILURE = (IP_STATUS_BASE + 50);

MAX_IP_STATUS = IP_GENERAL_FAILURE;

IP_PENDING = (IP_STATUS_BASE + 255);

// IP header flags
IP_FLAG_DF = $02; // Don't fragment this packet.

// IP Option Types
IP_OPT_EOL = $00; // End of list option
IP_OPT_NOP = $01; // No operation
IP_OPT_SECURITY = $82; // Security option.
IP_OPT_LSRR = $83; // Loose source route.
IP_OPT_SSRR = $89; // Strict source route.
IP_OPT_RR = $07; // Record route.
IP_OPT_TS = $44; // Timestamp.
IP_OPT_SID = $88; // Stream ID (obsolete)
MAX_OPT_SIZE = $40;

type
// IP types
TIPAddr = DWORD; // An IP address.
TIPMask = DWORD; // An IP subnet mask.
TIPStatus = DWORD; // Status code returned from IP APIs.

PIPOptionInformation = ^TIPOptionInformation;
TIPOptionInformation = packed record
TTL: Byte; // Time To Live (used for traceroute)
TOS: Byte; // Type Of Service (usually 0)
Flags: Byte; // IP header flags (usually 0)
OptionsSize: Byte; // Size of options data (usually 0, max 40)
OptionsData: PChar; // Options data buffer
end;

PIcmpEchoReply = ^TIcmpEchoReply;
TIcmpEchoReply = packed record
Address: TIPAddr; // Replying address
Status: DWord; // IP status value
RTT: DWord; // Round Trip Time in milliseconds
DataSize: Word; // Reply data size
Reserved: Word; // Reserved
Data: Pointer; // Pointer to reply data buffer
Options: TIPOptionInformation; // Reply options
end;

// IcmpCreateFile:
// Opens a handle on which ICMP Echo Requests can be issued.
// Arguments:
// None.
// Return Value:
// An open file handle or INVALID_HANDLE_VALUE. Extended error information
// is available by calling GetLastError().
TIcmpCreateFile = function: THandle; stdcall;

// IcmpCloseHandle:
// Closes a handle opened by ICMPOpenFile.
// Arguments:
// IcmpHandle - The handle to close.
// Return Value:
// TRUE if the handle was closed successfully, otherwise FALSE. Extended
// error information is available by calling GetLastError().
TIcmpCloseHandle = function(IcmpHandle: THandle): Boolean; stdcall;

// IcmpSendEcho:
// Sends an ICMP Echo request and returns one or more replies. The
// call returns when the timeout has expired or the reply buffer
// is filled.
// Arguments:
// IcmpHandle - An open handle returned by ICMPCreateFile.
// DestinationAddress - The destination of the echo request.
// RequestData - A buffer containing the data to send in the
// request.
// RequestSize - The number of bytes in the request data buffer.
// RequestOptions - Pointer to the IP header options for the request.
// May be NULL.
// ReplyBuffer - A buffer to hold any replies to the request.
// On return, the buffer will contain an array of
// ICMP_ECHO_REPLY structures followed by options
// and data. The buffer should be large enough to
// hold at least one ICMP_ECHO_REPLY structure
// and 8 bytes of data - this is the size of
// an ICMP error message.
// ReplySize - The size in bytes of the reply buffer.
// Timeout - The time in milliseconds to wait for replies.
// Return Value:
// Returns the number of replies received and stored in ReplyBuffer. If
// the return value is zero, extended error information is available
// via GetLastError().
TIcmpSendEcho = function(IcmpHandle: THandle;
DestinationAddress: TIPAddr;
RequestData: Pointer;
RequestSize: Word;
RequestOptions: PIPOptionInformation;
ReplyBuffer: Pointer;
ReplySize: DWord;
Timeout: DWord
): DWord; stdcall;

// Event handler type declaration for TICMP.OnDisplay event.
TICMPDisplay = procedure(Sender: TObject; Msg : String) of object;
TICMPReply = procedure(Sender: TObject; Error : Integer) of object;

// The object wich encapsulate the ICMP.DLL
TICMP = class(TObject)
private
hICMPdll : HModule; // Handle for ICMP.DLL
IcmpCreateFile : TIcmpCreateFile;
IcmpCloseHandle : TIcmpCloseHandle;
IcmpSendEcho : TIcmpSendEcho;
hICMP : THandle; // Handle for the ICMP Calls
FReply : TIcmpEchoReply; // ICMP Echo reply buffer
FAddress : String; // Address given
FHostName : String; // Dotted IP of host (output)
FHostIP : String; // Name of host (Output)
FIPAddress : TIPAddr; // Address of host to contact
FSize : Integer; // Packet size (default to 56)
FTimeOut : Integer; // Timeout (default to 4000mS)
FTTL : Integer; // Time To Live (for send)
FOnDisplay : TICMPDisplay; // Event handler to display
FOnEchoRequest : TNotifyEvent;
FOnEchoReply : TICMPReply;
FLastError : DWORD; // After sending ICMP packet
FAddrResolved : Boolean;
procedure ResolveAddr;
public
constructor Create; virtual;
destructor Destroy; override;
function Ping : Integer;
procedure SetAddress(Value : String);
function GetErrorString : String;

property Address : String read FAddress write SetAddress;
property Size : Integer read FSize write FSize;
property Timeout : Integer read FTimeout write FTimeout;
property Reply : TIcmpEchoReply read FReply;
property TTL : Integer read FTTL write FTTL;
property ErrorCode : Integer read FLastError;
property ErrorString : String read GetErrorString;
property HostName : String read FHostName;
property HostIP : String read FHostIP;
property OnDisplay : TICMPDisplay read FOnDisplay write FOnDisplay;
property OnEchoRequest : TNotifyEvent read FOnEchoRequest
write FOnEchoRequest;
property OnEchoReply : TICMPReply read FOnEchoReply
write FOnEchoReply;
end;

TICMPException = class(Exception);

implementation

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
constructor TICMP.Create;
var
WSAData: TWSAData;
begin
hICMP := INVALID_HANDLE_VALUE;
FSize := 56;
FTTL := 64;
FTimeOut := 4000;

// initialise winsock
if WSAStartup($101, WSAData) <> 0 then
raise TICMPException.Create('Error initialising Winsock');

// register the icmp.dll stuff
hICMPdll := LoadLibrary(icmpDLL);
if hICMPdll = 0 then
raise TICMPException.Create('Unable to register ' + icmpDLL);

@ICMPCreateFile := GetProcAddress(hICMPdll, 'IcmpCreateFile');
@IcmpCloseHandle := GetProcAddress(hICMPdll, 'IcmpCloseHandle');
@IcmpSendEcho := GetProcAddress(hICMPdll, 'IcmpSendEcho');

if (@ICMPCreateFile = Nil) or
(@IcmpCloseHandle = Nil) or
(@IcmpSendEcho = Nil) then
raise TICMPException.Create('Error loading dll functions');

hICMP := IcmpCreateFile;
if hICMP = INVALID_HANDLE_VALUE then
raise TICMPException.Create('Unable to get ping handle');
end;

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
destructor TICMP.Destroy;
begin
if hICMP <> INVALID_HANDLE_VALUE then
IcmpCloseHandle(hICMP);
if hICMPdll <> 0 then
FreeLibrary(hICMPdll);
WSACleanup;
inherited Destroy;
end;

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function MinInteger(X, Y: Integer): Integer;
begin
if X >= Y then
Result := Y
else
Result := X;
end;

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TICMP.ResolveAddr;
var
Phe : PHostEnt; // HostEntry buffer for name lookup
begin
// Convert host address to IP address
FIPAddress := inet_addr(PChar(FAddress));
if FIPAddress <> INADDR_NONE then
// Was a numeric dotted address let it in this format
FHostName := FAddress
else begin
// Not a numeric dotted address, try to resolve by name
Phe := GetHostByName(PChar(FAddress));
if Phe = nil then begin
FLastError := GetLastError;
if Assigned(FOnDisplay) then
FOnDisplay(Self, 'Unable to resolve ' + FAddress);
Exit;
end;

FIPAddress := longint(plongint(Phe^.h_addr_list^)^);
FHostName := Phe^.h_name;
end;

FHostIP := StrPas(inet_ntoa(TInAddr(FIPAddress)));
FAddrResolved := TRUE;
end;

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TICMP.SetAddress(Value : String);
begin
// Only change if needed (could take a long time)
if FAddress = Value then
Exit;
FAddress := Value;
FAddrResolved := FALSE;
// ResolveAddr;
end;

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TICMP.GetErrorString : String;
begin
case FLastError of
IP_SUCCESS: Result := 'No error';
IP_BUF_TOO_SMALL: Result := 'Buffer too small';
IP_DEST_NET_UNREACHABLE: Result := 'Destination network unreachable';
IP_DEST_HOST_UNREACHABLE: Result := 'Destination host unreachable';
IP_DEST_PROT_UNREACHABLE: Result := 'Destination protocol unreachable';
IP_DEST_PORT_UNREACHABLE: Result := 'Destination port unreachable';
IP_NO_RESOURCES: Result := 'No resources';
IP_BAD_OPTION: Result := 'Bad option';
IP_HW_ERROR: Result := 'Hardware error';
IP_PACKET_TOO_BIG: Result := 'Packet too big';
IP_REQ_TIMED_OUT: Result := 'Request timed out';
IP_BAD_REQ: Result := 'Bad request';
IP_BAD_ROUTE: Result := 'Bad route';
IP_TTL_EXPIRED_TRANSIT: Result := 'TTL expired in transit';
IP_TTL_EXPIRED_REASSEM: Result := 'TTL expired in reassembly';
IP_PARAM_PROBLEM: Result := 'Parameter problem';
IP_SOURCE_QUENCH: Result := 'Source quench';
IP_OPTION_TOO_BIG: Result := 'Option too big';
IP_BAD_DESTINATION: Result := 'Bad Destination';
IP_ADDR_DELETED: Result := 'Address deleted';
IP_SPEC_MTU_CHANGE: Result := 'Spec MTU change';
IP_MTU_CHANGE: Result := 'MTU change';
IP_GENERAL_FAILURE: Result := 'General failure';
IP_PENDING: Result := 'Pending';
else
Result := 'ICMP error #' + IntToStr(FLastError);
end;
end;

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TICMP.Ping : Integer;
var
BufferSize: Integer;
pReqData, pData: Pointer;
pIPE: PIcmpEchoReply; // ICMP Echo reply buffer
IPOpt: TIPOptionInformation; // IP Options for packet to send
Msg: String;
begin
Result := 0;
FLastError := 0;

if not FAddrResolved then
ResolveAddr;

if FIPAddress = INADDR_NONE then begin
FLastError := IP_BAD_DESTINATION;
if Assigned(FOnDisplay) then
FOnDisplay(Self, 'Invalid host address');
Exit;
end;

// Allocate space for data buffer space
BufferSize := SizeOf(TICMPEchoReply) + FSize;
GetMem(pReqData, FSize);
GetMem(pData, FSize);
GetMem(pIPE, BufferSize);

try
// Fill data buffer with some data bytes
FillChar(pReqData^, FSize, $20);
Msg := 'Pinging from Delphi code written by F. Piette';
Move(Msg[1], pReqData^, MinInteger(FSize, Length(Msg)));

pIPE^.Data := pData;
FillChar(pIPE^, SizeOf(pIPE^), 0);

if Assigned(FOnEchoRequest) then
FOnEchoRequest(Self);

FillChar(IPOpt, SizeOf(IPOpt), 0);
IPOpt.TTL := FTTL;
Result := IcmpSendEcho(hICMP, FIPAddress, pReqData, FSize,
@IPOpt, pIPE, BufferSize, FTimeOut);
FLastError := GetLastError;
FReply := pIPE^;

if Assigned(FOnEchoReply) then
FOnEchoReply(Self, Result);
finally
// Free those buffers
FreeMem(pIPE);
FreeMem(pData);
FreeMem(pReqData);
end;
end;

 
看一个网页是否有效,就是看能否正确ping通这个域名,所以还是建议你下一个Ping构件,来试一下。
这里有个地址http://www.vclxx.org/DELPHIGB/AAAT1028.HTM,说是能根据下载的这个东西能够制作出Ping构件来,我试了能下!
 
迷糊兄,
能不能详细点.
 
uses wininet;
忘了这个了,另外我觉得能ping通域名并不能说明一个页面有效
 
转载
网上搜集来的文章:

检测计算机是否联网比较简单的做法可以通过一个 Win32 Internet(WinInet) 函数 InternetCheckConnection来实现;
这个函数的功能是检查是否能够建立 Internet 连接。
它的实现是在 %SystemRoot%/System32/wininet.dll 中,Delphi 调用声明在 WinInet.pas 中,
其 API 声明如下:

BOOL InternetCheckConnection(
IN LPCSTR lpszUrl,
IN DWORD dwFlags,
IN DWORD dwReserved
);

参数的意义是:

lpszUrl: 需要测试能否建立连接的 URL 地址,可以为空;
dwFlags: 目前只能是 FLAG_ICC_FORCE_CONNECTION(这个常量 Delphi 中没有声明,其值为 $00000001);
dwReserved: 目前只能为 0。

调用的说明:

如果 lpszUrl 是非空的,Windows 从中解析出 Host 名然后 Ping 这个指定的 Host。
如果 lpszUrl 是空的,并且 WinInet 内部服务器的 database 中有一个关于最近的 Server 的纪录,Windows 就从这条纪录中解析出 Host 名然后 Ping 它。

如果能够成功的连接返回 True,否则返回 False;

以下是一个判断当前计算机是否联网的例子:

procedure TForm1.Button1Click(Sender: TObject);
begin
if InternetCheckConnection('http://www.yahoo.com/', 1, 0) then
edit1.text:= 'Connected'
else
edit1.text:= 'Disconnected';
end;

通过上述的方法只能检测出当前计算机是否物理联网,即网线是否接好,网卡是否能顺利工作,不能确定是否能够实现获得 Internet 服务,即是否能和 ISP 进行 Internet 连接。
这时可以通过另一个 Win32 Internet(WinInet) 函数 InternetQueryOption 来检测;
这个函数的功能是查询指定 Internet 句柄的状态、选项。
其 API 声明如下:

BOOL InternetQueryOption(
IN HINTERNET hInternet,
IN DWORD dwOption,
OUT LPVOID lpBuffer,
IN OUT LPDWORD lpdwBufferLength
);

参数的意义是:

hInternet:查询对象的 Internet 句柄(全局查询时为 nil),
dwOption:查询的项目;
lpBuffer:返回的查询结果;
lpdwBufferLength:查询结果的字节长度(包括 IN 和 OUT);

查询成功返回 True,否则返回 False;

我们要查询当前计算机的 Internet 连接状态时可以使用查询项目 INTERNET_OPTION_CONNECTED_STATE,

得到的 ConnectState 返回值可能是以下值的一个或几个值之和:

INTERNET_STATE_CONNECTED :$00000001 连接状态;
INTERNET_STATE_DISCONNECTED :$00000002 非连接状态(和 INTERNET_STATE_CONNECTED 对应);
INTERNET_STATE_DISCONNECTED_BY_USER :$00000010 用户请求的非连接状态
INTERNET_STATE_IDLE :$00000100 连接状态,并且空闲
INTERNET_STATE_BUSY :$00000200 连接状态,正在响应连接请求

以下是一个判断当前计算机是否可以获得 Internet 服务的例子:

function TForm1.CheckOffline: boolean;
var
ConnectState: DWORD;
StateSize: DWORD;
begin
ConnectState:= 0;
StateSize:= SizeOf(ConnectState);
result:= false;
if InternetQueryOption(nil, INTERNET_OPTION_CONNECTED_STATE, @ConnectState, StateSize) then
if (ConnectState and INTERNET_STATE_DISCONNECTED) <> 2 then result:= true;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
if CheckOffline then
edit1.text:= 'Connect To ISP'
else
edit1.text:= 'Disconnect To ISP';
end;

需要说明的是 InternetQueryOption 函数的检测结果只能表明当前的 Internet 设置是可用的,
并不能表示计算机一定能访问 Internet,例如网线掉了,网卡突然坏了之类的错误就没法检测出来,
要想检测当前计算机是否能够获得 Internet 服务了必须两个函数结合起来使用。

以上程序在 Win2000, Delphi5.0 下调试通过。


最后要提醒大家注意的是在 uses 中要加上 WinInet。
 
解决了.一给就是两个方案.
 
后退
顶部