如何编程实现在内部网上检测是否连上互联网？

[jwchc]

[kxy]

我提过这个问题,
比较好的办法是ping一个地址,如microsoft等.

[tiger]

tcp/ip port 7 可以满足你的要求

[jwchc]

to: OLO
什么意思？

[algo]

用socket编程吧，

[tiger]

给你一个例子, 这个例子是模拟在dos窗口执行netstat并得到显示的结果
你可以改造一下, 改为ping某个internet上的ip.
unit conform;

interface

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

type
TConsoleForm = class(TForm)
Static: TStaticText;
Memo1: TMemo;
RunButton: TButton;
procedure RunButtonClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
ConsoleForm : TConsoleForm;
var currentbuf: pchar;
function ExecConsoleApp(CommandLine: String;
OutputWindow: hWnd): Int64;

implementation
const
homedir = 'c:\windows\'; {Must be set to the Netstat Directory}
commandline = '';{Any Additional Command Line Paramaters}
consoleapp = 'c:\windows\netstat.exe'; {Full Path to app}

{$R *.DFM}

function ExecConsoleApp(CommandLine: String;
OutputWindow: hWnd): Int64;
const
BufSize = $65332;
{for this simple example, the pipe should be able to
hold the entire output of the console app.
Predictably, this call hangs if CommandLine points to a
Win32 GUI app. Tested with Win32 and MS-DOS console apps}
var
StartupInfo:TStartupInfo;
ProcessInfo:TProcessInformation;
WriteHandle, ReadHandle: THandle;
ReadBuf: array[0..BufSize] of Char;
BytesRead: Longword;
temp : Longword;
begin
FillChar(StartupInfo,SizeOf(StartupInfo), 0);
FillChar(ReadBuf, SizeOf(ReadBuf), 0);
CreatePipe(ReadHandle, WriteHandle, nil, BufSize);
with StartupInfo do
begin
cb:= SizeOf(StartupInfo);
dwFlags:= STARTF_USESHOWWINDOW or
STARTF_USESTDHANDLES;
hStdOutput:= WriteHandle;
hStdError:= WriteHandle;
wShowWindow:= SW_HIDE;
end;
if not CreateProcess(nil, PChar(CommandLine), nil, nil,
false, DETACHED_PROCESS or NORMAL_PRIORITY_CLASS,
nil, pchar(homedir), StartupInfo, ProcessInfo) then
begin
Result:= -1
end else
begin
WaitForSingleObject(ProcessInfo.hProcess, INFINITE);
{if you want to do a running update of the output of
the console app, you would not block here. Instead you
could loop while GetExitCodeProcess returned STILL_ACTIVE
all the while calling ReadFile on the pipe. Overlapped IO
would be nice, but I am not sure it would work on an
anonymous pipe. I have tried polling the pipe (works OK)
but not overlapped IO.}


ReadFile( ReadHandle, ReadBuf, BufSize, BytesRead, nil);

// file://
SetWindowText(OutputWindow, ReadBuf);
currentbuf:=readbuf;
GetExitCodeProcess(ProcessInfo.hProcess, temp);
result := temp;
CloseHandle(ProcessInfo.hProcess);
CloseHandle(ProcessInfo.hThread)
end;
CloseHandle(WriteHandle)
end;

procedure TConsoleForm.RunButtonClick(Sender: TObject);
var
s: String;
CAExitCode: Integer;
begin
memo1.lines.clear;
s:= consoleapp + ' '+ commandline;

Static.Caption:= 'Executing ' + s;
CAExitCode:= ExecConsoleApp(s, Static.Handle);
if CAExitCode <> 0 then
begin
if CAExitCode = -1 then
MessageDlg(Format('could not execute ''%s''', [s]),
mtError, [mbOK], 0)
else
MessageDlg(Format('%s returned exitcode of %d',
[s, CAExitCode]), mtError, [mbOK], 0)
end;

memo1.Lines.add(strpas(currentbuf));
end;
end.

[supershan]

你可试一试下面的程序，进行检测：
procedure TForm1.Button1Click(Sender: TObject);
begin
winexec('ping www.263.net',SW_SHOW);
end;

[caili]

ping的时候别忘了把时间设长一点.用IP地址可以排除DNS造成的问题.

[shlp]

对于那些必须和internet链结才能工作的程序来说，知道当前计算机是否处于链结状态是非常有意义的。当Windows系统处于链结状态时，它会在注册表里改动一个键值，下面的例子告诉你如何读取这个键值，并得知系统是否与internet相连。

声明以下函数变量常量：

Public Const ERROR_SUCCESS = 0&

Public Const APINULL = 0&

Public Const HKEY_LOCAL_MACHINE = &H80000002

Public ReturnCode As Long

Declare Function RegCloseKey Lib "advapi32.dll" (ByVal _hKey As Long) As LongDeclare Function RegOpenKey Lib "advapi32.dll" Alias _"RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As _

String, phkResult As Long) As Long

Declare Function RegQueryValueEx Lib "advapi32.dll" Alias _

"RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName _

As String, ByVal lpReserved As Long, lpType As Long, _

lpData As Any, lpcbData As Long) As Long

代码：

Public Function ActiveConnection() As Boolean

Dim hKey As Long

Dim lpSubKey As String

Dim phkResult As Long

Dim lpValueName As String

Dim lpReserved As Long

Dim lpType As Long

Dim lpData As Long

Dim lpcbData As Long

ActiveConnection = False

lpSubKey = "System\CurrentControlSet\Services\RemoteAccess"

ReturnCode = RegOpenKey(HKEY_LOCAL_MACHINE, lpSubKey, _

phkResult)

If ReturnCode = ERROR_SUCCESS Then

hKey = phkResult

lpValueName = "Remote Connection"

lpReserved = APINULL

lpType = APINULL

lpData = APINULL

lpcbData = APINULL

ReturnCode = RegQueryValueEx(hKey, lpValueName, _

lpReserved, lpType, ByVal lpData, lpcbData)

lpcbData = Len(lpData)

ReturnCode = RegQueryValueEx(hKey, lpValueName, _

lpReserved, lpType, lpData, lpcbData)

If ReturnCode = ERROR_SUCCESS Then

If lpData = 0 Then

ActiveConnection = False

Else

ActiveConnection = True

End If

End If

RegCloseKey (hKey)

End If

End Function

下面是使用以上代码的例子：

If ActiveConnection = True then

Call MsgBox("现在处于链结状态。",vbInformation)

Else

Call MsgBox("现在处于断开状态。", vbInformation)

End If

[jwchc]

to shlp:
如果是局域网内的上网机器，就没有这一项了。谢谢！

[JGTM2000]

InetIsOffline

Determines whether or not the system is connected to the Internet.

BOOL InetIsOffline(
DWORD dwFlags,
);

Parameters

dwFlags
Input flags for the function. This must be set to zero.

Return Value
Returns TRUE if the local system in not currently connected to the Internet. Returns FALSE if the local system is connected to the Internet or if no attempt has yet been made to connect to the Internet.

Requirements
Version 4.00 and later of Shell32.dll

Windows NT/2000: Requires Windows NT 4.0 or later.
Windows 95/98: Requires Windows 95 or later.
Header: Declared in intshcut.h.