如何知道当前用户是否和Intelnet相连结？

[Linux2001]

[Crob]

function TForm1.isOnline: boolean;
var ConTypes : Integer;
begin
ConTypes := INTERNET_CONNECTION_MODEM + INTERNET_CONNECTION_LAN + INTERNET_CONNECTION_PROXY;
if (InternetGetConnectedState(@ConTypes, 0) = False)
then Result := False
else Result := True;
end;

[copy_paste]

{InternetCheckConnection在98下会raise,2000下此函数能正常工作}
uses WinInet;

function IsConnectedInternet: Boolean;
var
ConnectState: DWORD;
StateSize: DWORD;
begin
Result := False;
ConnectState:= 0;
StateSize := SizeOf(ConnectState);
Result := InternetQueryOption(nil, INTERNET_OPTION_CONNECTED_STATE, @ConnectState, StateSize) and
((ConnectState and INTERNET_STATE_DISCONNECTED) <> 2) and InternetCheckConnection('http://www.163.net', 1, 0)
end;

{ping 可以，但是有限制}

{InetisOffline 不行}
function InetIsOffline(Flag: Integer): Boolean; stdcall; external 'URL.DLL';

begin
if InetIsOffline(0) then
ShowMessage('This computer is not connected to Internet!')
else
ShowMessage('You are connected to Internet!');
end;

///////////////////////////////////////////////////////////
我最后用ClientSocket.connect to a URL,if sucessed then connect to internet else failure
type
TForm1 = class(TForm);
private
IsConnect: Boolean;
function IsInInternet: Boolean;
procedure MySocketErrorProc(ErrorCode: Integer);
end;

procedure TForm1.MySocketErrorProc(ErrorCode: Integer);
begin
Isconnect := False;
end;

function TForm1.IsInInternet: Boolean;
var
ClientSocket: TClientSocket;
begin
ClientSocket := TClientSocket.Create(nil);
ClientSocket.Address := 'POP.163.net';
ClientSocket.Port := 25;
ScktComp.SetErrorProc(MySocketErrorProc);
try
IsConnect := True;
ClientSocket.Active := True; //if raise then IsConnect := False;
finally
Result := IsConnect;
ScktComp.SetErrorProc(nil);
ClientSocket.Free;
end;
end;

[copy_paste]

Crob(我干嘛这么帅)　的方法我试试

少写了一句，这句比较重要。
function TForm1.IsInInternet: Boolean;
var
ClientSocket: TClientSocket;
begin
ClientSocket := TClientSocket.Create(nil);
ClientSocket.ClientType := ctBlocking; //一定要阻塞模式
ClientSocket.Address := 'POP.163.net';
ClientSocket.Port := 25;
ScktComp.SetErrorProc(MySocketErrorProc);
try
IsConnect := True;
ClientSocket.Active := True; //if raise then IsConnect := False;
finally
Result := IsConnect;
ScktComp.SetErrorProc(nil);
ClientSocket.Free;
end;
end;

[Linux2001]

有没有完整的源代码，最好是在98/2000下都可以运行通过的，我在98下试了一下你们的代码，不行，谢谢了

[copy_paste]

怎么会不行，用ClientSocket，我现在就是用它来检测是否连接Internet.或者你换一个Address试试

[InsideDelphi]

Try ping:
function IcmpCreateFile:Integer;stdcall;external 'ICMP.DLL';
function IcmpCloseHandle(ICMPHandle:Integer):boolean;stdcall;external 'ICMP.DLL';
function IcmpSendEcho( IcmpHandle:integer; DestinationAddress:Integer;RequestData:PChar; RequestSize: WORD;RequestOptions:Pointer;ReplyBuffer:PChar;ReplySize:DWORD;Timeout:DWORD):DWORD;stdcall external 'ICMP.DLL';

function Ping(var sDestAddr:String):boolean;{ you can use something like 'www.163.net' to be a param of sDestAddr}
var
echoHandle:Integer;
echoReplyBuffer:array [0..255] of Char;
destAddr:Integer;
echoRequestData:String;
begin
Result:=false;
echoRequestData:='AAAAAAAAAA';
echoHandle:=IcmpCreateFile;
destAddr:=inet_addr(PChar(SDestAddr));
if IcmpSendEcho(echoHandle,destAddr,PChar(echoRequestData),Length(echoRequestData),nil,echoReplyBuffer,255,200)=0 then
Result:=true else Result:=false;
IcmpCloseHandle(echoHandle);
end;

[copy_paste]

ping 的限制比较多，如ping 的地址down了，DNS坏了,那ping 也就over 了。
我这段写收发E_Mail就是要检测，最后还是用ClientSocket

[zjqyb]

ping当地所有dns端口
应该没有几个

[Linux2001]

能详细的讲一下么?

[Apollo47]

if GetSystemMetrics(SM_NetWork)<>0 then
ShowMessage('Connection Internet');

[Linux2001]

各位高手,你们的方法是不是要加什么控件啊,为什么我用了这些方法,结果只有一个,无论用户是否在网上程序一律判断为在网上!

[copy_paste]

天,还没搞定啊？

[Linux2001]

是啊,对不起啊,我非常非常的笨呀

[copy_paste]

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
function IsInInternet: Boolean;
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
IsConnect: Boolean;
implementation

uses ScktComp;

{$R *.DFM}

procedure MySocketErrorProc(ErrorCode: Integer);
begin
IsConnect := False;
ShowMessage(SysErrorMessage(ErrorCode))
end;

function TForm1.IsInInternet: Boolean;
var
ClientSocket: TClientSocket;
begin
IsConnect := True;
ClientSocket := TClientSocket.Create(nil);
ClientSocket.ClientType := ctBlocking; //一定要阻塞模式
ClientSocket.Host := 'smtp.163.net';
ClientSocket.Port := 110;
ScktComp.SetErrorProc(MySocketErrorProc);
try
ClientSocket.Active := True;
finally
Result := IsConnect;
ScktComp.SetErrorProc(nil);
ClientSocket.Free;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
if IsInInternet then
ShowMessage('Yes') else
ShowMessage('No')
end;

end.

[dingsg111]

到http://www.powerba.com/上去看看

[zjqyb]

unit myIcmp;

interface

uses
Windows,WinSock,classes;

const
IcmpVersion = 102;
IcmpDLL = 'icmp.dll';
IP_SUCCESS = 0;
IP_STATUS_BASE = 11000;
init_WSA_fail=(IP_STATUS_BASE -1);
init_icmpdll=(IP_STATUS_BASE -2);
init_icmpdllmodule=(IP_STATUS_BASE -3);
init_createfile=(IP_STATUS_BASE-4);
init_other=(IP_STATUS_BASE -5);

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);

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_FLAG_DF = $02; // Don't fragment this packet.

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
IpByte=Array[1..4] of byte;
// 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;

ICMPrec =record
hICMPdll : HModule; // Handle for ICMP.DLL
hICMP : THandle; // Handle for the ICMP Calls
Reply : TIcmpEchoReply; // ICMP Echo reply buffer
Address : String; // Address given
HostName : String; // Dotted IP of host (output)
HostIP : array[0..80] of char; // Name of host (Output)
IPAddress : TIPAddr; // Address of host to contact
Size : Integer; // Packet size (default to 56)
TimeOut : Integer; // Timeout (default to 4000mS)
TTL : Integer; // Time To Live (for send)
LastError : DWORD; // After sending ICMP packet
AddrResolved : Boolean;
end;
function ResolveAddr:boolean;
function Initicmp:integer;
function closeicmp:boolean;
function Ping(const Aip:string):integer;
procedure SetAddress(Value : String);
function GetErrorString : String;
Function GetComputerRes( const ComputerName:string ;List:TStringList):Boolean;

var
IcmpCreateFile : TIcmpCreateFile;
IcmpCloseHandle : TIcmpCloseHandle;
IcmpSendEcho : TIcmpSendEcho;
curicmp:IcmpRec;
WSAData: TWSAData;

implementation

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function Initicmp:integer;
begin
try
if WSAStartup($101, WSAData) <> 0 then
begin
result:=-1;
exit;
end;
with curicmp do
begin
hICMP := INVALID_HANDLE_VALUE;
Size := 56;
TTL := 127;
TimeOut := 1000;
hicmpdll:=0;
hICMPdll := LoadLibrary(icmpDLL);
if curicmp.hICMPdll = 0 then
begin
result:=-2;
exit;
end;
@ICMPCreateFile := GetProcAddress(hICMPdll, 'IcmpCreateFile');
@IcmpCloseHandle := GetProcAddress(hICMPdll, 'IcmpCloseHandle');
@IcmpSendEcho := GetProcAddress(hICMPdll, 'IcmpSendEcho');
if (@ICMPCreateFile = Nil) or
(@IcmpCloseHandle = Nil) or
(@IcmpSendEcho = Nil) then
begin
result:=-3;
exit;
end;
hICMP := IcmpCreateFile;
if hICMP = INVALID_HANDLE_VALUE then
begin
result:=-4;
exit;
end;
end;
result:=0;
except
result:=-5;
end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function closeicmp:boolean;
begin
try
with curicmp do
begin
if hICMP <> INVALID_HANDLE_VALUE then
IcmpCloseHandle(hICMP);
if hICMPdll <> 0 then
FreeLibrary(hICMPdll);
WSACleanup;
end;
result:=true;
except
result:=false;
end;
end;


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


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function ResolveAddr:boolean;
var
Phe : PHostEnt;
begin
result:=false;
with curicmp do
begin
IPAddress := inet_addr(PChar(Address));
if IPAddress <> INADDR_NONE then
HostName := Address
else
begin
Phe := GetHostByName(PChar(Address));
if Phe = nil then
begin
LastError := GetLastError;
exit;
end;
IPAddress := longint(plongint(Phe^.h_addr_list^)^);
HostName := Phe.h_name;
end;
lstrcpy(HostIP,inet_ntoa(TInAddr(IPAddress)));
AddrResolved := TRUE;
end;
result:=true;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure SetAddress(Value : String);
begin
with curicmp do
begin
if Address = Value then
Exit;
Address := Value;
AddrResolved := FALSE;
end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function GetErrorString : String;
begin
case curicmp.LastError of
init_WSA_fail:result:='INIT_WSA_FAILED';
init_icmpdll:result:='INIT_ICMPDLL_FAILED';
init_icmpdllmodule:result:='INIT_ICMPDLL_MODULE_FAILED';
init_createfile:result:='INIT_CREATEFILE_FAILED';
init_other:result:='INIT_OTHER_ERROR';
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 #';
end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function Ping(const Aip:string) : 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;
SetAddress(Aip);
with curicmp do
begin
LastError := 0;
if not AddrResolved then
if not ResolveAddr then
exit;
if IPAddress = INADDR_NONE then
LastError := IP_BAD_DESTINATION;
BufferSize := SizeOf(TICMPEchoReply) + Size;
GetMem(pReqData, Size);
GetMem(pData, Size);
GetMem(pIPE, BufferSize);

try
// Fill data buffer with some data bytes
FillChar(pReqData^, Size, $20);
Msg := 'Pinging from zj';
Move(Msg[1], pReqData^, MinInteger(Size, Length(Msg)));

pIPE^.Data := pData;
FillChar(pIPE^, SizeOf(pIPE^), 0);
FillChar(IPOpt, SizeOf(IPOpt), 0);
IPOpt.TTL := TTL;
Result := IcmpSendEcho(hICMP, IPAddress, pReqData, Size,
@IPOpt, pIPE, BufferSize, TimeOut);
LastError := GetLastError;
Reply := pIPE^;
if reply.Address<>Ipaddress then
result:=-1;
finally
// Free those buffers
FreeMem(pIPE);
FreeMem(pData);
FreeMem(pReqData);
end;
end;
end;
Function GetComputerRes( const ComputerName:string ;List:TStringList):Boolean;
type
TnetResourceArray=array[0..0] of TnetResource;
Var
NetResource : TNetResource;
Buf : ^TnetResourceArray;
count,BufSize,Res : DWord;
i: Integer;
lphEnum: THandle;
Begin
Result := False;
List.Clear;
FillChar(NetResource, SizeOf(NetResource), 0);
NetResource.lpRemoteName := pchar(ComputerName);
Res:=WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY,RESOURCEUSAGE_CONNECTABLE, @NetResource,lphEnum);
BufSize := 8192;
GetMem(Buf, BufSize);
If Res <> NO_ERROR Then
begin
Freemem(buf);
exit;
end;
While True Do
Begin
Count := $FFFFFFFF;
Res := WNetEnumResource(lphEnum, Count, Buf, BufSize);
If Res = ERROR_NO_MORE_ITEMS Then
break;
If (Res <> NO_ERROR) then
begin
FreeMem(Buf);
Exit;
end;
For I:= 0 to Count - 1 do
List.Add(buf^[i].lpRemoteName);
end;
Res := WNetCloseEnum(lphEnum);
Result :=(Res=NO_ERROR);
FreeMem(Buf);
End;

end.

example:
if initicmp<0 then
showmessage('TCP/IP网络协议不能初始化!');
else
if ping(yourISp.Ipaddress)>0 then
showmessage(connect internet!');
closeicmp;

[Linux2001]

搞不定,对不起了,我太笨了!