怎样在VFP6中获取连接internet成功或断开连接的信息?

Question

如果VFP能够调用API的话，就可以实现

Answer 1

怎样用VB得知系统当前是否处于internet链结状态 声明以下函数变量常量： 
Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey 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 Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long Public Const ERROR_SUCCESS = 0& Public Const APINULL = 0& Public Const HKEY_LOCAL_MACHINE = &H80000002 Public ReturnCode 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 = "SystemCurrentControlSetServicesRemoteAccess" 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, lpData, lpcbData) lpcbData = Len(lpData) ReturnCode = 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 

Answer 2

请问progame(呵呵呵(傻笑中)　:拨号和断线用何API函数？

Answer 3

如何中断【拨号网络连接】？ 
版本：VB6 / VB5 / VB4-32 要在 VB 程序中中断【拨号网络连接】，可以使用 Remote Access Services Hangup 函数： '在模块的声明区中加入以下声明及模块： Public Const RAS_MAXENTRYNAME As Integer = 256 
Public Const RAS_MAXDEVICETYPE As Integer = 16 
Public Const RAS_MAXDEVICENAME As Integer = 128 
Public Const RAS_RASCONNSIZE As Integer = 412 
Public Const ERROR_SUCCESS = 0& Public Type RasEntryName 
dwSize As Long 
szEntryName(RAS_MAXENTRYNAME) As Byte 
End Type Public Type RasConn 
dwSize As Long 
hRasConn As Long 
szEntryName(RAS_MAXENTRYNAME) As Byte 
szDeviceType(RAS_MAXDEVICETYPE) As Byte 
szDeviceName(RAS_MAXDEVICENAME) As Byte 
End Type Public Declare Function RasEnumConnections Lib _ 
"rasapi32.dll" Alias "RasEnumConnectionsA" (lpRasConn As _ 
Any, lpcb As Long, lpcConnections As Long) As Long Public Declare Function RasHangUp Lib "rasapi32.dll" Alias _ 
"RasHangUpA" (ByVal hRasConn As Long) As Long Public gstrISPName As String 
Public ReturnCode As Long 
Public Sub HangUp() 
Dim i As Long 
Dim lpRasConn(255) As RasConn 
Dim lpcb As Long 
Dim lpcConnections As Long 
Dim hRasConn As Long lpRasConn(0).dwSize = RAS_RASCONNSIZE 
lpcb = RAS_MAXENTRYNAME * lpRasConn(0).dwSize 
lpcConnections = 0 
ReturnCode = RasEnumConnections(lpRasConn(0), lpcb, lpcConnections) 
If ReturnCode = ERROR_SUCCESS Then 
For i = 0 To lpcConnections - 1 
If Trim(ByteToString(lpRasConn(i).szEntryName)) = Trim(gstrISPName) Then 
hRasConn = lpRasConn(i).hRasConn 
ReturnCode = RasHangUp(ByVal hRasConn) 
End If 
Next i 
End If 
End Sub 
Public Function ByteToString(bytString() As Byte) As String 
Dim i As Integer 
ByteToString = "" 
i = 0 
While bytString(i) = 0& 
ByteToString = ByteToString & Chr(bytString(i)) 
i = i + 1 
Wend 
End Function 
'在程序中使用实例为 
Call HangUp 

Answer 4

建立拨号联接 Public Const RAS_MaxEntryName = 256 Private Type RASENTRYNAME 
dwSize As Long 
szEntryName(RAS_MaxEntryName) As Byte 
End Type c 中 Char aa[16] 代表长度是16，可放 15个byte所以对应於vb便是 aa(15) as Byte 
如此才是长度16 ( 0--15)。故VB的宣告中不能再用szEntryName(RAS_MaxEntryName+1) 但是Lenb(RASENTRYNAME)的长度却是 261 (4+257)，的确，这是vb的问题，而c 的SizeOf 
传回的是4的倍数(32位元嘛)故值为264，所以我们计算某个Structure的长度时，要再多一 
些运算。 以下的Fuction只适用於32位元的win95/ NT， '以下在Form中 Private hConn as Long 
Private Sub Command1_Click() 
hConn = Dialup("我的连线", "user", "passwd") 
if hConn = 0 Then 
Debug.Print "连线失败" 
end if 
End Sub Private Sub Command2_Click() 
Call HangUp(hConn) 
End Sub '以下在.bas中 
Option Explicit 
Public Const RAS_MaxEntryName = 256 
Public Const RAS_MaxDeviceName = 128 
Public Const RAS_MaxDeviceType = 16 
Public Const RAS_MaxPhoneNumber = 128 
Public Const RAS_MaxCallbackNumber = 128 
Public Const UNLEN = 256 
Public Const PWLEN = 256 
Public Const DNLEN = 15 
Public Const ERROR_INVALID_HANDLE = 6 
Type RASDIALPARAMS 
dwSize As Long '1052 
szEntryName(RAS_MaxEntryName) As Byte 
szPhoneNumber(RAS_MaxPhoneNumber) As Byte 
szCallbackNumber(RAS_MaxCallbackNumber) As Byte 
szUserName(UNLEN) As Byte 
szPassword(PWLEN) As Byte 
szDomain(DNLEN) As Byte 
End Type Type RASCONNSTATUS 
dwSize As Long '144 
RasConnState As Long 
dwError As Long 
szDeviceType(RAS_MaxDeviceType) As Byte 
szDeviceName(RAS_MaxDeviceName) As Byte 
End Type Declare Function RasGetErrorString Lib "rasapi32" _ 
Alias "RasGetErrorStringA" (ByVal ErrValue As Long, ByVal lpErrStr As String, _ 
ByVal cSize As Long) As Long 
Declare Function RasDial Lib "rasapi32" _ 
Alias "RasDialA" (DialExt As Long, ByVal lpPhoneBook As String, _ 
RasDialParam As RASDIALPARAMS, ByVal NotifyType As Long, _ 
ByVal Notifter As Long, hRasConn As Long) As Long 
Declare Function RasHangUp Lib "rasapi32" Alias _ 
"RasHangUpA" (ByVal hRasConn As Long) As Long 
Declare Function RasGetConnectStatus Lib "rasapi32" Alias _ 
"RasGetConnectStatusA" (ByVal hRasConn As Long, _ 
lprasconnstatus As RASCONNSTATUS) As Long 
Declare Function RasGetEntryDialParams Lib "rasapi32" _ 
Alias "RasGetEntryDialParamsA" (ByVal lpszPhonebook As String, _ 
lpRasDialParams As RASDIALPARAMS, _ 
lpfPassword As Byte) As Long 
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) '自动拨接(Win95 4, 5 个参数不传，或为vbNullString) 
Public Function DialUp(ByVal EntryName As String, ByVal UserN As String, _ 
ByVal Pwd As String, Optional ByVal PhoneBook As String, Optional sDomain As String) As Long 
Dim RasDialPara As RASDIALPARAMS 
Dim bya() As Byte, di As Long 
Dim len5 As Long, i As Long 
Dim hRasConn As Long len5 = LenB(RasDialPara) 
i = (4 - (len5 Mod 4)) Mod 4 
RasDialPara.dwSize = len5 + i '1052 
bya = StrConv(EntryName, vbFromUnicode) + ChrB(0) 
Call CopyByte(RasDialPara.szEntryName, bya) bya = StrConv(UserN, vbFromUnicode) + ChrB(0) 
Call CopyByte(RasDialPara.szUserName, bya) bya = StrConv(Pwd, vbFromUnicode) + ChrB(0) 
Call CopyByte(RasDialPara.szPassword, bya) bya = StrConv(sDomain, vbFromUnicode) + ChrB(0) 
Call CopyByte(RasDialPara.szDomain, bya) 
'若使用以下CallBack function的方式，则RasDial()不等连线成功或失败便结束。 
di = RasDial(0, PhoneBook, RasDialPara, 0, AddressOf RasDialFunc, hRasConn) '若第二、叁个参数都是0则，RasDial会等连线成功或失败後才执行下一行指令 
'di = RasDial(0, PhoneBook, RasDialPara, 0, 0, hRasConn) If di = 0 Then 
DialUp = hRasConn 
Else 
DialUp = 0 
Dim str5 As String 
str5 = String(255, Chr(0)) 
Call RasGetErrorString(di, str5, 256) 
MsgBox Left(str5, InStr(1, str5, Chr(0)) - 1), vbCritical 
Call HangUp(hRasConn) 
End If 
End Function Public Sub RasDialFunc(ByVal unMsg As Long, _ 
ByVal ConnState As Long, _ 
ByVal dwError As Long) 
If ConnState = &H2000 Then 
' Connect Complete 
End If '取消拨接 
Public Function HangUp(ByVal hconn As Long) As Boolean 
Dim st As Long, len5 As Long 
Dim i As Long, ConStatus As RASCONNSTATUS 
st = RasHangUp(hconn) 
len5 = LenB(ConStatus) 
i = (4 - (len5 Mod 4)) Mod 4 
ConStatus.dwSize = len5 + i 
Do While True 
Call Sleep(0) 
i = RasGetConnectStatus(hconn, ConStatus) 
If i = ERROR_INVALID_HANDLE Then 
Exit Do 
End If 
Loop 
If st = 0 Then 
HangUp = True 
Else 
HangUp = False 
End If 
End Function Private Sub CopyByte(dest() As Byte, sour() As Byte) 
Dim sourL As Long, sourU As Long 
Dim destL As Long, destU As Long, i As Long, j As Long 
sourL = LBound(sour) 
sourU = UBound(sour) 
destL = LBound(dest) 
destU = UBound(dest) 
j = 0 
For i = sourL To sourU 
dest(destL + j) = sour(i) 
j = j + 1 
If j >= (destU - destL) + 1 Then 
Exit For 
End If 
Next i 
End Sub 

Answer 5

判断当前是否已经连接到Internet:
DECL INTEGER InetIsOffline IN URL AS _InetIsOffline_ INTEGER  dwFlags
LOCAL RES
RES = _InetIsOffline_(0)
? = RES
return如果RES为0, 是在线. 不是0则应该是断线. (不知道是不是, 因为我用的是专线, 不好试.)
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.
--------------------------------------------
拨号和断线用何API函数？ 
应该是RasDial吧.RasDial 
This function establishes a RAS connection between a RAS client and a RAS server. The connection data includes callback and user authentication information.DWORD RasDial(
LPRASDIALEXTENSIONS dialExtensions, 
LPTSTR phoneBookPath , 
LPRASDIALPARAMS rasDialParam , 
DWORD NotifierType, 
LPVOID notifier, 
LPHRASCONN pRasConn );

Answer 6

nononono(null,null)，谢谢你和progame(呵呵呵(傻笑中)等各位，VB不太会用，但我用了你的下列代码怎么都是返回 0 呢？
   判断当前是否已经连接到Internet:
DECL INTEGER InetIsOffline IN URL AS _InetIsOffline_ INTEGER  dwFlags
LOCAL RES
RES = _InetIsOffline_(0)
? = RES
return如果RES为0, 是在线. 不是0则应该是断线. (不知道是不是, 因为我用的是专线, 不好试.)
 

Answer 7

to nononono(null,null),换哪个API函数嘛.麻烦说清楚一点!   

Answer 8

我还不知道用哪个API更合适.或许可以换个思路:执行Ping来测试当前的机器是否能连接一个特定的地址(你的应用程序需要访问的一个服务器)也许更合理.run ping XXX.XXX.XXX.XXX > c:\windows\temp\A.txt然后把A.TXT读进来(用fopen()/fread()等函数)进行判断.

Answer 9

nononono(null,null),谢谢你,但对不起,暂时还不能给分啦!

Answer 10

问题还没解决吗？这样看看行不行：Declare integer InternetGetConnectedStateEx  in wininet as _Internetisonline_ INTEGER,string,INTEGER,INTEGERif _Internetisonline_(0,' ',255,0)=1
   ?'在线'
else
   ?'不在线'   
endif

Answer 11

这样好一点：Declare integer InternetGetConnectedStateEx  in wininet as _InetIsOffline_ INTEGER,string,INTEGER,INTEGERif _InetIsOffline_(0,' ',255,0)=0
  ?'不在线'
else
  ?'在线'  
endif

Answer 12

我测试了一下，字符串长度设短了应该这样：( Windows Me/windows2000接本地Model可以通过,局域网连接和专线可能不行）Declare integer InternetGetConnectedStateEx  in wininet as _InetIsOffline_ INTEGER,string,INTEGER,INTEGERif _InetIsOffline_(0,'        ',255,0)=0
  ?'不在线'
else
  ?'在线'  
endif

Answer 13

LUJUN(陆天),您好,在我的电脑上能测出结果了,谢谢!!