请教各位富翁高手:如何判断网络是否畅通,就是一定要ping通或能够上网。急!在线等!(20分)

  • 主题发起人 主题发起人 tianguozhi
  • 开始时间 开始时间
T

tianguozhi

Unregistered / Unconfirmed
GUEST, unregistred user!
请教各位富翁高手:如何判断网络是否畅通,就是一定要ping通或能够上网。
急!在线等!一定是程序实现最好是Delphi。
如果知道如何用程序调用Ping指令并取得返回值。也可以。
 
用以下两个函数即可实现
const
INTERNET_CONNECTION_MODEM = 1;
INTERNET_CONNECTION_LAN = 2;
INTERNET_CONNECTION_PROXY = 4;
INTERNET_CONNECTION_MODEM_BUSY = 8;

function InternetGetConnectedState(lpdwFlags: LPDWORD;
dwReserved: DWORD): BOOL; stdcall; external 'WININET.DLL';

function _IsConnectedToInternet: Boolean;
var
dwConnectionTypes: Integer;
begin
try
dwConnectionTypes := INTERNET_CONNECTION_MODEM +
INTERNET_CONNECTION_LAN +
INTERNET_CONNECTION_PROXY;
if InternetGetConnectedState(@dwConnectionTypes, 0) then
Result := true
else
Result := false;
except
Result := false;
end;
end;
 
谢谢!fjyhs。不过以上程序只能判断本地连接是否启用。我需要知道能不能连到其他计算机。就像我们平时判断时用的Ping指令一样。还望不吝赐教。谢谢!
 
Function CheckNet(IpAddr: string): Boolean;
type
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: DWord; // replying address
Status: DWord; // IP status value (see below)
RTT: DWord; // Round Trip Time in milliseconds
DataSize: Word; // reply data size
Reserved: Word;
Data: Pointer; // pointer to reply data buffer
Options: TIPOptionInformation; // reply options
end;
TIcmpCreateFile = function: THandle; stdcall;
TIcmpCloseHandle = function(IcmpHandle: THandle): Boolean; stdcall;
TIcmpSendEcho = function(
IcmpHandle: THandle;
DestinationAddress: DWord;
RequestData: Pointer;
RequestSize: Word;
RequestOptions: PIPOptionInformation;
ReplyBuffer: Pointer;
ReplySize: DWord;
Timeout: DWord): DWord; stdcall;
const
Size = 32;
TimeOut = 10;
var
wsadata: TWSAData;
Address: DWord; // Address of host to contact
HostName, HostIP: String; // Name and dotted IP of host to contact
Phe: PHostEnt; // HostEntry buffer for name lookup
BufferSize, nPkts: Integer;
pReqData, pData: Pointer;
pIPE: PIcmpEchoReply; // ICMP Echo reply buffer
IPOpt: TIPOptionInformation; // IP Options for packet to send
const
IcmpDLL = 'icmp.dll';
var
hICMPlib: HModule;
IcmpCreateFile : TIcmpCreateFile;
IcmpCloseHandle: TIcmpCloseHandle;
IcmpSendEcho: TIcmpSendEcho;
hICMP: THandle; // Handle for the ICMP Calls
begin
// initialise winsock
Result:=True;
if WSAStartup(2,wsadata) <> 0 then
begin
Result:=False;
halt;
end;
// register the icmp.dll stuff
hICMPlib := loadlibrary(icmpDLL);
if hICMPlib <> null then
begin
@ICMPCreateFile := GetProcAddress(hICMPlib, 'IcmpCreateFile');
@IcmpCloseHandle:= GetProcAddress(hICMPlib, 'IcmpCloseHandle');
@IcmpSendEcho:= GetProcAddress(hICMPlib, 'IcmpSendEcho');
if (@ICMPCreateFile = Nil) or (@IcmpCloseHandle = Nil) or (@IcmpSendEcho = Nil) then
begin
Result:=False;
halt;
end;
hICMP := IcmpCreateFile;
if hICMP = INVALID_HANDLE_VALUE then
begin
Result:=False;
halt;
end;
end
else
begin
Result:=False;
halt;
end;
// ------------------------------------------------------------
Address := inet_addr(PChar(IpAddr));
if (Address = INADDR_NONE) then
begin
Phe := GetHostByName(PChar(IpAddr));
if Phe = Nil then Result:=False
else
begin
Address := longint(plongint(Phe^.h_addr_list^)^);
HostName := Phe^.h_name;
HostIP := StrPas(inet_ntoa(TInAddr(Address)));
end;
end
else
begin
Phe := GetHostByAddr(@Address, 4, PF_INET);
if Phe = Nil then Result:=False;
end;
if Address = INADDR_NONE then
begin
Result:=False;
end;
// Get some data buffer space and put something in the packet to send
BufferSize := SizeOf(TICMPEchoReply) + Size;
GetMem(pReqData, Size);
GetMem(pData, Size);
GetMem(pIPE, BufferSize);
FillChar(pReqData^, Size, $AA);
pIPE^.Data := pData;
// Finally Send the packet
FillChar(IPOpt, SizeOf(IPOpt), 0);
IPOpt.TTL := 64;
NPkts := IcmpSendEcho(hICMP, Address, pReqData, Size,
@IPOpt, pIPE, BufferSize, TimeOut);
if NPkts = 0 then Result:=False;
// Free those buffers
FreeMem(pIPE); FreeMem(pData); FreeMem(pReqData);
// --------------------------------------------------------------
IcmpCloseHandle(hICMP);
FreeLibrary(hICMPlib);
// free winsock
if WSACleanup <> 0 then Result:=False;
end;
 
先谢谢nomit!我试一下。
 
非常感谢nomit!不过我怎么不能运行。是不是我的delphi版本不对。我的是delphi6
 
错误信息贴出来呵
 
好东西 阿
 
可能是我调用时出错,请告诉我如何调用。谢谢!
 
怎么没人理我啊?还望各位富翁不吝赐教。谢谢!
 
你是D6的话,用indy client组件页下的
IDICMPclient控件吧,
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdRawBase, IdRawClient,
IdIcmpClient;

type
TForm1 = class(TForm)
IdIcmpClient1: TIdIcmpClient;
Button1: TButton;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
procedure IdIcmpClient1Reply(ASender: TComponent;
const AReplyStatus: TReplyStatus);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
form1.IdIcmpClient1.ReceiveTimeout:=100;//设置最大响应时间
form1.IdIcmpClient1.Host:='18.0.0.139'; //此处可用对方机器名
form1.IdIcmpClient1.Ping;
end;

procedure TForm1.IdIcmpClient1Reply(ASender: TComponent;
const AReplyStatus: TReplyStatus);
begin
if AReplyStatus.FromIpAddress<>'0.0.0.0' then //如果ping通,则AReplyStatus.FromIpAddress为ping时的IP返回。
begin
memo1.lines.add('ping'+AReplyStatus.FromIpAddress+'是成功的');
end
else
begin
memo1.lines.add('ping'+AReplyStatus.FromIpAddress+'没有成功');

end;

end;

end.
 

Similar threads

S
回复
0
查看
3K
SUNSTONE的Delphi笔记
S
S
回复
0
查看
2K
SUNSTONE的Delphi笔记
S
D
回复
0
查看
2K
DelphiTeacher的专栏
D
D
回复
0
查看
2K
DelphiTeacher的专栏
D
D
回复
0
查看
1K
DelphiTeacher的专栏
D
后退
顶部