# 先提供如何断线

Posted by Honey on March 26, 1999 at 22:09:03:

In Reply to: 自动连线怎么做? posted by 世上美谆 on March 26, 1999 at 11:23:20:

先提供如何断线及是否连线 在Form上摆两个command
按command1确认有否取得连线
按command2中断连线
而自动上线你可以用开启拨号网路的方式让使用者
选择用什么连接 如
Shell"explorer ::{20D04FE0-3AEA-1069-A2D8-08002B30309D}\::{992CFFA0-F557-101A-88EC-00DD010CCC48}"
而自动连接我再找找看
我是建议最好不要用元件啦
一方面散布不容易(必须用安装程式)
一方面问题并没有真正解决 根本不知道元件是用如何的
方式达成目的 只能受人摆布

Option Explicit
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal _
hKey As Long) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias _
"RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As _
String, phkResult As Long) As Long
Private 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

Private Declare Function RasEnumConnections Lib _
"rasapi32.dll" Alias "RasEnumConnectionsA" (lpRasConn As _
Any, lpcb As Long, lpcConnections As Long) As Long
Private Declare Function RasHangUp Lib "rasapi32.dll" Alias _
"RasHangUpA" (ByVal hRasConn As Long) As Long
Const ERROR_SUCCESS = 0&
Const RAS_MAXENTRYNAME As Integer = 256
Const RAS_MAXDEVICETYPE As Integer = 16
Const RAS_MAXDEVICENAME As Integer = 128
Const RAS_RASCONNSIZE As Integer = 412
Const APINULL = 0&
Const HKEY_LOCAL_MACHINE = &H80000002
Private Type RasEntryName
dwSize As Long
szEntryName(RAS_MAXENTRYNAME) As Byte
End Type

Private 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
Dim gstrISPName As String
Dim 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 = "System\CurrentControlSet\Services\RemoteAccess"
ReturnCode = RegOpenKey(HKEY_LOCAL_MACHINE, lpSubKey, _
phkResult)
'/*取得HKEY_LOCAL_MACHINE底下 _
System\CurrentControlSet\Services\RemoteAccess _
phkResult是传回SubKey的hKey*/

If ReturnCode = ERROR_SUCCESS Then
'/*RegOpenKey若执行成功会传回0*/
hKey = phkResult '/*hKey*/
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)
'/*lpValueName:名称 _
lpReserved:保留参数 _
lpType:资料类别 _
lpData:传回资料 _
lpcbData:资料长度*/
If ReturnCode = ERROR_SUCCESS Then
'/*RegQueryValueEx执行成功会传回零*/
If lpData = 0 Then
ActiveConnection = False
'/*未取得连线*/
Else
ActiveConnection = True
'/*取得连线*/
End If
End If
RegCloseKey (hKey)
'/*关闭*/
End If
End Function

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

Private Sub Command1_Click()
Call ActiveConnection
If ActiveConnection = True Then
MsgBox "有连线", vbInformation
Else
MsgBox "没有连线", vbInformation
End If
End Sub

Private Sub Command2_Click()
Call HangUp
End Sub

Follow Ups: