拨号、断网、枚举连接名称,判断是否在线、连接方式。 http://blog.csdn.net/Modest/archive/2006/10/20/1342633.aspxOption Explicit '拨号/断网 Private Declare Function InternetDial Lib "wininet.dll" (ByVal hwndParent As Long, ByVal lpszConnectoid As String, ByVal dwFlags As Long, lpdwConnection As Long, ByVal dwReserved As Long) As Long Private Declare Function InternetHangUp Lib "wininet.dll" (ByVal dwConnection As Long, ByVal dwReserved As Long) As Long Private Declare Function InternetAutodial Lib "wininet.dll" (ByVal dwFlags As Long, ByVal dwReserved As Long) As Long Private Declare Function InternetAutodialHangup Lib "wininet.dll" (ByVal dwReserved As Long) As Long Private Const INTERNET_DIALSTATE_DISCONNECTED = 1 Private Const INTERNET_AUTODIAL_FORCE_ONLINE = 1 Private Const INTERNET_AUTODIAL_FORCE_UNATTENDED = 2 Private Const INTERNET_DIAL_UNATTENDED = &H8000 Private Handle As Long'网络状态 Private Declare Function InternetGetConnectedStateEx Lib "wininet.dll" Alias "InternetGetConnectedStateExA" (ByRef lpdwFlags As Long, ByVal lpszConnectionName As String, ByVal dwNameLen As Long, ByVal dwReserved As Long) As Long Private Declare Function InternetGetConnectedState Lib "wininet.dll" (ByRef dwFlags As Long, ByVal dwReserved As Long) As Long Private Const INTERNET_CONNECTION_MODEM As Long = &H1 '本系统使用调制解调器与因特网相连 Private Const INTERNET_CONNECTION_LAN As Long = &H2 '本系统通过LAN与因特网相连 Private Const INTERNET_CONNECTION_PROXY As Long = &H4 '本系统使用proxy代理服务器与因特网相连 Private Const INTERNET_CONNECTION_MODEM_BUSY As Long = &H8 '未使用 Private Const INTERNET_RAS_INSTALLED As Long = &H10 Private Const INTERNET_CONNECTION_OFFLINE As Long = &H20 Private Const INTERNET_CONNECTION_CONFIGURED As Long = &H40'枚举网络连接 Private Const RAS_MaxDeviceType = 16 Private Const RAS95_MaxDeviceName = 128 Private Const RAS95_MaxEntryName = 256 Private Type RASCONN95 dwSize As Long hRasConn As Long szEntryName(RAS95_MaxEntryName) As Byte szDeviceType(RAS_MaxDeviceType) As Byte szDeviceName(RAS95_MaxDeviceName) As Byte End Type Private Type RASENTRYNAME95 dwSize As Long szEntryName(RAS95_MaxEntryName) As Byte End Type Private Declare Function RasEnumConnections Lib "rasapi32.dll" Alias "RasEnumConnectionsA" (lprasconn As Any, lpcb As Long, lpcConnections As Long) As Long Private Declare Function RasEnumEntries Lib "rasapi32.dll" Alias "RasEnumEntriesA" (ByVal reserved As String, ByVal lpszPhonebook As String, lprasentryname As Any, lpcb As Long, lpcEntries As Long) As Long Private Declare Function RasHangUp Lib "rasapi32.dll" Alias "RasHangUpA" (ByVal hRasConn As Long) As Long'拨号 Public Function DialUp(LinkName As String) As Boolean InternetDial 0, LinkName, INTERNET_AUTODIAL_FORCE_UNATTENDED, Handle, 0 DialUp = (Handle <> 0) End Function '断网 Public Sub HangUp() If Handle <> 0 Then InternetHangUp Handle, 0 Handle = 0 End If End Sub '枚举网络连接 Public Sub EnumConnectName(Value() As String) Dim s As Long, l As Long, ln As Long, a As String ReDim r(255) As RASENTRYNAME95 r(0).dwSize = 264 s = 256 * r(0).dwSize l = RasEnumEntries(vbNullString, vbNullString, r(0), s, ln) ReDim Value(ln - 1) For l = 0 To ln - 1 a = StrConv(r(l).szEntryName(), vbUnicode) Value(l) = Left$(a$, InStr(a$, Chr$(0)) - 1) Next End Sub'判断是否在线 Public Function Online() As Boolean Online = InternetGetConnectedState(0&, 0&) End Function '判断是否在线并返回连接方式 Public Property Get OnlineOfLinkName(LinkName As String) As Boolean LinkName = Space$(128) OnlineOfLinkName = InternetGetConnectedStateEx(0, LinkName, 128, 0&) End Property'如果是通过LAN的连接,则返回True Public Function IsNetConnectViaLAN() As Boolean Dim dwFlags As Long Call InternetGetConnectedState(dwFlags, 0&) IsNetConnectViaLAN = dwFlags And INTERNET_CONNECTION_LAN End Function '如果是通过调制解调器的连接,则返回True Public Function IsNetConnectViaModem() As Boolean Dim dwFlags As Long Call InternetGetConnectedState(dwFlags, 0&) IsNetConnectViaModem = dwFlags And INTERNET_CONNECTION_MODEM End Function '如果是通过Proxy代理服务器的连接,则返回True Public Function IsNetConnectViaProxy() As Boolean Dim dwFlags As Long Call InternetGetConnectedState(dwFlags, 0&) IsNetConnectViaProxy = dwFlags And INTERNET_CONNECTION_PROXY End Function '如果已安装了RAS,则返回True Public Function IsNetRASInstalled() As Boolean Dim dwFlags As Long Call InternetGetConnectedState(dwFlags, 0&) IsNetRASInstalled = dwFlags And INTERNET_RAS_INSTALLED End Function '返回当前网络状态信息字符串 Public Function GetNetConnectString() As String Dim dwFlags As Long Dim msg As String If InternetGetConnectedState(dwFlags, 0&) Then If dwFlags And INTERNET_CONNECTION_CONFIGURED Then msg = msg & "系统配置了网络连接" & vbCrLf End If If dwFlags And INTERNET_CONNECTION_LAN Then msg = msg & "系统通过局域网与因特网相连接" End If If dwFlags And INTERNET_CONNECTION_PROXY Then msg = msg & "并使用了Proxy代理服务" Else: msg = msg & "." End If If dwFlags And INTERNET_CONNECTION_MODEM Then msg = msg & "系统使用调制解调器与因特网相连接" End If If dwFlags And INTERNET_CONNECTION_OFFLINE Then msg = msg & "系统当前处于离线状态" End If If dwFlags And INTERNET_CONNECTION_MODEM_BUSY Then msg = msg & "系统的调制解调器未连接到因特网" End If If dwFlags And INTERNET_RAS_INSTALLED Then msg = msg & "本系统安装了远程访问服务" End If Else msg = "当前未与因特网相连" End If GetNetConnectString = msg End Function
To : Modest(塞北雪貂)·(偶最欣赏楼主的分) 您给出的是可以拨号了,前提是系统已经建立了这样一个连接。 如何用代码去创建这样的连接呢?
建立 VPN搞定,全部代码如下:Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)Private Type GUID Data1 As Long Data2 As Integer Data3 As Integer Data4(7) As Byte End TypePrivate Type RASIPADDR a As Byte b As Byte c As Byte d As Byte End TypePrivate Type RASENTRY dwSize As Long dwfOptions As Long dwCountryID As Long dwCountryCode As Long szAreaCode(10) As Byte szLocalPhoneNumber(128) As Byte dwAlternateOffset As Long ipaddr As RASIPADDR ipaddrDns As RASIPADDR ipaddrDnsAlt As RASIPADDR ipaddrWins As RASIPADDR ipaddrWinsAlt As RASIPADDR dwFrameSize As Long dwfNetProtocols As Long dwFramingProtocol As Long szScript(259) As Byte szAutodialDll(259) As Byte szAutodialFunc(259) As Byte szDeviceType(16) As Byte szDeviceName(128) As Byte szX25PadType(32) As Byte szX25Address(200) As Byte szX25Facilities(200) As Byte szX25UserData(200) As Byte dwChannels As Long dwReserved1 As Long dwReserved2 As Long dwSubEntries As Long dwDialMode As Long dwDialExtraPercent As Long dwDialExtraSampleSeconds As Long dwHangUpExtraPercent As Long dwHangUpExtraSampleSeconds As Long dwIdleDisconnectSeconds As Long dwType As Long dwEncryptionType As Long dwCustomAuthKey As Long guidId As GUID szCustomDialDll(259) As Byte dwVpnStrategy As Long dwfOptions2 As Long dwfOptions3 As Long szDnsSuffix(255) As Byte dwTcpWindowSize As Long szPrerequisitePbk(259) As Byte szPrerequisiteEntry(256) As Byte dwRedialCount As Long dwRedialPause As Long End TypePrivate Type RASCREDENTIALS dwSize As Long dwMask As Long szUserName(256) As Byte szPassword(256) As Byte szDomain(15) As Byte End TypePrivate Declare Function RasSetEntryProperties Lib "rasapi32" Alias "RasSetEntryPropertiesA" (ByVal lpszPhonebook As String, ByVal lpszEntry As String, lpRasEntry As RASENTRY, ByVal dwEntryInfoSize As Long, ByVal lpbDeviceInfo As Long, ByVal dwDeviceInfoSize As Long) As Long Private Declare Function RasSetCredentials Lib "rasapi32" Alias "RasSetCredentialsA" (ByVal lpszPhonebook As String, ByVal lpszEntry As String, lpCredentials As RASCREDENTIALS, ByVal fClearCredentials As Long) As LongPrivate Sub Command1_Click() Dim sEntryName As String, sUsername As String, sPassword As String sEntryName = "VPN" sUsername = "super" sPassword = "greenbean" If Create_PPPoE_Connection("VPN", sEntryName, sUsername, sPassword) Then MsgBox "连接建立成功!" Else MsgBox "连接建立失败!" End If End SubFunction Create_PPPoE_Connection(ByVal sDeviceType As String, ByVal sEntryName As String, ByVal sUsername As String, ByVal sPassword As String) As Boolean Create_PPPoE_Connection = False Dim re As RASENTRY Dim sDeviceName As String ', sDeviceType As String sDeviceName = "WAN 微型端口 (PPTP)"
CopyMemory .szDeviceName(0), ByVal sDeviceName, Len(sDeviceName) CopyMemory .szDeviceType(0), ByVal sDeviceType, Len(sDeviceType) End With Dim rc As RASCREDENTIALS With rc .dwSize = LenB(rc) .dwMask = 11 CopyMemory .szUserName(0), ByVal sUsername, Len(sUsername) CopyMemory .szPassword(0), ByVal sPassword, Len(sPassword) End With Dim rtn As Long If RasSetEntryProperties(vbNullString, sEntryName, re, LenB(re), 0, 0) = 0 Then If RasSetCredentials(vbNullString, sEntryName, rc, 0) = 0 Then Create_PPPoE_Connection = True End If End If End Function
拨号代码: Option Explicit '拨号/断网 Private Declare Function InternetDial Lib "wininet.dll" (ByVal hwndParent As Long, ByVal lpszConnectoid As String, ByVal dwFlags As Long, lpdwConnection As Long, ByVal dwReserved As Long) As Long Private Declare Function InternetHangUp Lib "wininet.dll" (ByVal dwConnection As Long, ByVal dwReserved As Long) As Long Private Declare Function InternetAutodial Lib "wininet.dll" (ByVal dwFlags As Long, ByVal dwReserved As Long) As Long Private Declare Function InternetAutodialHangup Lib "wininet.dll" (ByVal dwReserved As Long) As Long Private Const INTERNET_DIALSTATE_DISCONNECTED = 1 Private Const INTERNET_AUTODIAL_FORCE_ONLINE = 1 Private Const INTERNET_AUTODIAL_FORCE_UNATTENDED = 2 Private Const INTERNET_DIAL_UNATTENDED = &H8000 Private Handle As Long'网络状态 Private Declare Function InternetGetConnectedStateEx Lib "wininet.dll" Alias "InternetGetConnectedStateExA" (ByRef lpdwFlags As Long, ByVal lpszConnectionName As String, ByVal dwNameLen As Long, ByVal dwReserved As Long) As Long Private Declare Function InternetGetConnectedState Lib "wininet.dll" (ByRef dwFlags As Long, ByVal dwReserved As Long) As Long Private Const INTERNET_CONNECTION_MODEM As Long = &H1 '本系统使用调制解调器与因特网相连 Private Const INTERNET_CONNECTION_LAN As Long = &H2 '本系统通过LAN与因特网相连 Private Const INTERNET_CONNECTION_PROXY As Long = &H4 '本系统使用proxy代理服务器与因特网相连 Private Const INTERNET_CONNECTION_MODEM_BUSY As Long = &H8 '未使用 Private Const INTERNET_RAS_INSTALLED As Long = &H10 Private Const INTERNET_CONNECTION_OFFLINE As Long = &H20 Private Const INTERNET_CONNECTION_CONFIGURED As Long = &H40'枚举网络连接 Private Const RAS_MaxDeviceType = 16 Private Const RAS95_MaxDeviceName = 128 Private Const RAS95_MaxEntryName = 256 Private Type RASCONN95 dwSize As Long hRasConn As Long szEntryName(RAS95_MaxEntryName) As Byte szDeviceType(RAS_MaxDeviceType) As Byte szDeviceName(RAS95_MaxDeviceName) As Byte End Type Private Type RASENTRYNAME95 dwSize As Long szEntryName(RAS95_MaxEntryName) As Byte End Type Private Declare Function RasEnumConnections Lib "rasapi32.dll" Alias "RasEnumConnectionsA" (lprasconn As Any, lpcb As Long, lpcConnections As Long) As Long Private Declare Function RasEnumEntries Lib "rasapi32.dll" Alias "RasEnumEntriesA" (ByVal reserved As String, ByVal lpszPhonebook As String, lprasentryname As Any, lpcb As Long, lpcEntries As Long) As Long Private Declare Function RasHangUp Lib "rasapi32.dll" Alias "RasHangUpA" (ByVal hRasConn As Long) As Long'拨号 Public Function DialUp(LinkName As String) As Boolean InternetDial 0, LinkName, INTERNET_AUTODIAL_FORCE_UNATTENDED, Handle, 0 DialUp = (Handle <> 0) End Function '断网 Public Sub HangUp() If Handle <> 0 Then InternetHangUp Handle, 0 Handle = 0 End If End Sub '枚举网络连接 Public Sub EnumConnectName(Value() As String) Dim s As Long, l As Long, ln As Long, a As String ReDim r(255) As RASENTRYNAME95 r(0).dwSize = 264 s = 256 * r(0).dwSize l = RasEnumEntries(vbNullString, vbNullString, r(0), s, ln) ReDim Value(ln - 1) For l = 0 To ln - 1 a = StrConv(r(l).szEntryName(), vbUnicode) Value(l) = Left$(a$, InStr(a$, Chr$(0)) - 1) Next End Sub'判断是否在线 Public Function Online() As Boolean Online = InternetGetConnectedState(0&, 0&) End Function '判断是否在线并返回连接方式 Public Property Get OnlineOfLinkName(LinkName As String) As Boolean LinkName = Space$(128) OnlineOfLinkName = InternetGetConnectedStateEx(0, LinkName, 128, 0&) End Property'如果是通过LAN的连接,则返回True Public Function IsNetConnectViaLAN() As Boolean Dim dwFlags As Long Call InternetGetConnectedState(dwFlags, 0&) IsNetConnectViaLAN = dwFlags And INTERNET_CONNECTION_LAN End Function '如果是通过调制解调器的连接,则返回True Public Function IsNetConnectViaModem() As Boolean Dim dwFlags As Long Call InternetGetConnectedState(dwFlags, 0&) IsNetConnectViaModem = dwFlags And INTERNET_CONNECTION_MODEM End Function '如果是通过Proxy代理服务器的连接,则返回True Public Function IsNetConnectViaProxy() As Boolean Dim dwFlags As Long Call InternetGetConnectedState(dwFlags, 0&) IsNetConnectViaProxy = dwFlags And INTERNET_CONNECTION_PROXY End Function '如果已安装了RAS,则返回True Public Function IsNetRASInstalled() As Boolean Dim dwFlags As Long Call InternetGetConnectedState(dwFlags, 0&) IsNetRASInstalled = dwFlags And INTERNET_RAS_INSTALLED End Function '返回当前网络状态信息字符串 Public Function GetNetConnectString() As String Dim dwFlags As Long Dim msg As String If InternetGetConnectedState(dwFlags, 0&) Then If dwFlags And INTERNET_CONNECTION_CONFIGURED Then msg = msg & "系统配置了网络连接" & vbCrLf End If If dwFlags And INTERNET_CONNECTION_LAN Then msg = msg & "系统通过局域网与因特网相连接" End If If dwFlags And INTERNET_CONNECTION_PROXY Then msg = msg & "并使用了Proxy代理服务" Else: msg = msg & "." End If If dwFlags And INTERNET_CONNECTION_MODEM Then msg = msg & "系统使用调制解调器与因特网相连接" End If If dwFlags And INTERNET_CONNECTION_OFFLINE Then msg = msg & "系统当前处于离线状态" End If If dwFlags And INTERNET_CONNECTION_MODEM_BUSY Then msg = msg & "系统的调制解调器未连接到因特网" End If If dwFlags And INTERNET_RAS_INSTALLED Then msg = msg & "本系统安装了远程访问服务" End If Else msg = "当前未与因特网相连" End If GetNetConnectString = msg End Function Private Sub Command1_Click() DialUp "vpn" End Sub
当然你可以图简单, 调用
cmd.exe /k "rasdial.exe entryname", 我见过很多双线网关程序都是这么调用的.当然, 所有的前提, 是你必须建立一个entry, API:RasCreatePhonebookEntry
http://blog.csdn.net/Modest/archive/2006/10/20/1342633.aspxOption Explicit
'拨号/断网
Private Declare Function InternetDial Lib "wininet.dll" (ByVal hwndParent As Long, ByVal lpszConnectoid As String, ByVal dwFlags As Long, lpdwConnection As Long, ByVal dwReserved As Long) As Long
Private Declare Function InternetHangUp Lib "wininet.dll" (ByVal dwConnection As Long, ByVal dwReserved As Long) As Long
Private Declare Function InternetAutodial Lib "wininet.dll" (ByVal dwFlags As Long, ByVal dwReserved As Long) As Long
Private Declare Function InternetAutodialHangup Lib "wininet.dll" (ByVal dwReserved As Long) As Long
Private Const INTERNET_DIALSTATE_DISCONNECTED = 1
Private Const INTERNET_AUTODIAL_FORCE_ONLINE = 1
Private Const INTERNET_AUTODIAL_FORCE_UNATTENDED = 2
Private Const INTERNET_DIAL_UNATTENDED = &H8000
Private Handle As Long'网络状态
Private Declare Function InternetGetConnectedStateEx Lib "wininet.dll" Alias "InternetGetConnectedStateExA" (ByRef lpdwFlags As Long, ByVal lpszConnectionName As String, ByVal dwNameLen As Long, ByVal dwReserved As Long) As Long
Private Declare Function InternetGetConnectedState Lib "wininet.dll" (ByRef dwFlags As Long, ByVal dwReserved As Long) As Long
Private Const INTERNET_CONNECTION_MODEM As Long = &H1 '本系统使用调制解调器与因特网相连
Private Const INTERNET_CONNECTION_LAN As Long = &H2 '本系统通过LAN与因特网相连
Private Const INTERNET_CONNECTION_PROXY As Long = &H4 '本系统使用proxy代理服务器与因特网相连
Private Const INTERNET_CONNECTION_MODEM_BUSY As Long = &H8 '未使用
Private Const INTERNET_RAS_INSTALLED As Long = &H10
Private Const INTERNET_CONNECTION_OFFLINE As Long = &H20
Private Const INTERNET_CONNECTION_CONFIGURED As Long = &H40'枚举网络连接
Private Const RAS_MaxDeviceType = 16
Private Const RAS95_MaxDeviceName = 128
Private Const RAS95_MaxEntryName = 256
Private Type RASCONN95
dwSize As Long
hRasConn As Long
szEntryName(RAS95_MaxEntryName) As Byte
szDeviceType(RAS_MaxDeviceType) As Byte
szDeviceName(RAS95_MaxDeviceName) As Byte
End Type
Private Type RASENTRYNAME95
dwSize As Long
szEntryName(RAS95_MaxEntryName) As Byte
End Type
Private Declare Function RasEnumConnections Lib "rasapi32.dll" Alias "RasEnumConnectionsA" (lprasconn As Any, lpcb As Long, lpcConnections As Long) As Long
Private Declare Function RasEnumEntries Lib "rasapi32.dll" Alias "RasEnumEntriesA" (ByVal reserved As String, ByVal lpszPhonebook As String, lprasentryname As Any, lpcb As Long, lpcEntries As Long) As Long
Private Declare Function RasHangUp Lib "rasapi32.dll" Alias "RasHangUpA" (ByVal hRasConn As Long) As Long'拨号
Public Function DialUp(LinkName As String) As Boolean
InternetDial 0, LinkName, INTERNET_AUTODIAL_FORCE_UNATTENDED, Handle, 0
DialUp = (Handle <> 0)
End Function
'断网
Public Sub HangUp()
If Handle <> 0 Then
InternetHangUp Handle, 0
Handle = 0
End If
End Sub
'枚举网络连接
Public Sub EnumConnectName(Value() As String)
Dim s As Long, l As Long, ln As Long, a As String
ReDim r(255) As RASENTRYNAME95 r(0).dwSize = 264
s = 256 * r(0).dwSize
l = RasEnumEntries(vbNullString, vbNullString, r(0), s, ln)
ReDim Value(ln - 1)
For l = 0 To ln - 1
a = StrConv(r(l).szEntryName(), vbUnicode)
Value(l) = Left$(a$, InStr(a$, Chr$(0)) - 1)
Next
End Sub'判断是否在线
Public Function Online() As Boolean
Online = InternetGetConnectedState(0&, 0&)
End Function
'判断是否在线并返回连接方式
Public Property Get OnlineOfLinkName(LinkName As String) As Boolean
LinkName = Space$(128)
OnlineOfLinkName = InternetGetConnectedStateEx(0, LinkName, 128, 0&)
End Property'如果是通过LAN的连接,则返回True
Public Function IsNetConnectViaLAN() As Boolean
Dim dwFlags As Long
Call InternetGetConnectedState(dwFlags, 0&)
IsNetConnectViaLAN = dwFlags And INTERNET_CONNECTION_LAN
End Function
'如果是通过调制解调器的连接,则返回True
Public Function IsNetConnectViaModem() As Boolean
Dim dwFlags As Long
Call InternetGetConnectedState(dwFlags, 0&)
IsNetConnectViaModem = dwFlags And INTERNET_CONNECTION_MODEM
End Function
'如果是通过Proxy代理服务器的连接,则返回True
Public Function IsNetConnectViaProxy() As Boolean
Dim dwFlags As Long
Call InternetGetConnectedState(dwFlags, 0&)
IsNetConnectViaProxy = dwFlags And INTERNET_CONNECTION_PROXY
End Function
'如果已安装了RAS,则返回True
Public Function IsNetRASInstalled() As Boolean
Dim dwFlags As Long
Call InternetGetConnectedState(dwFlags, 0&)
IsNetRASInstalled = dwFlags And INTERNET_RAS_INSTALLED
End Function
'返回当前网络状态信息字符串
Public Function GetNetConnectString() As String
Dim dwFlags As Long
Dim msg As String
If InternetGetConnectedState(dwFlags, 0&) Then
If dwFlags And INTERNET_CONNECTION_CONFIGURED Then
msg = msg & "系统配置了网络连接" & vbCrLf
End If
If dwFlags And INTERNET_CONNECTION_LAN Then
msg = msg & "系统通过局域网与因特网相连接"
End If
If dwFlags And INTERNET_CONNECTION_PROXY Then
msg = msg & "并使用了Proxy代理服务"
Else: msg = msg & "."
End If
If dwFlags And INTERNET_CONNECTION_MODEM Then
msg = msg & "系统使用调制解调器与因特网相连接"
End If
If dwFlags And INTERNET_CONNECTION_OFFLINE Then
msg = msg & "系统当前处于离线状态"
End If
If dwFlags And INTERNET_CONNECTION_MODEM_BUSY Then
msg = msg & "系统的调制解调器未连接到因特网"
End If
If dwFlags And INTERNET_RAS_INSTALLED Then
msg = msg & "本系统安装了远程访问服务"
End If
Else
msg = "当前未与因特网相连"
End If
GetNetConnectString = msg
End Function
您给出的是可以拨号了,前提是系统已经建立了这样一个连接。
如何用代码去创建这样的连接呢?
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(7) As Byte
End TypePrivate Type RASIPADDR
a As Byte
b As Byte
c As Byte
d As Byte
End TypePrivate Type RASENTRY
dwSize As Long
dwfOptions As Long
dwCountryID As Long
dwCountryCode As Long
szAreaCode(10) As Byte
szLocalPhoneNumber(128) As Byte
dwAlternateOffset As Long
ipaddr As RASIPADDR
ipaddrDns As RASIPADDR
ipaddrDnsAlt As RASIPADDR
ipaddrWins As RASIPADDR
ipaddrWinsAlt As RASIPADDR
dwFrameSize As Long
dwfNetProtocols As Long
dwFramingProtocol As Long
szScript(259) As Byte
szAutodialDll(259) As Byte
szAutodialFunc(259) As Byte
szDeviceType(16) As Byte
szDeviceName(128) As Byte
szX25PadType(32) As Byte
szX25Address(200) As Byte
szX25Facilities(200) As Byte
szX25UserData(200) As Byte
dwChannels As Long
dwReserved1 As Long
dwReserved2 As Long
dwSubEntries As Long
dwDialMode As Long
dwDialExtraPercent As Long
dwDialExtraSampleSeconds As Long
dwHangUpExtraPercent As Long
dwHangUpExtraSampleSeconds As Long
dwIdleDisconnectSeconds As Long
dwType As Long
dwEncryptionType As Long
dwCustomAuthKey As Long
guidId As GUID
szCustomDialDll(259) As Byte
dwVpnStrategy As Long
dwfOptions2 As Long
dwfOptions3 As Long
szDnsSuffix(255) As Byte
dwTcpWindowSize As Long
szPrerequisitePbk(259) As Byte
szPrerequisiteEntry(256) As Byte
dwRedialCount As Long
dwRedialPause As Long
End TypePrivate Type RASCREDENTIALS
dwSize As Long
dwMask As Long
szUserName(256) As Byte
szPassword(256) As Byte
szDomain(15) As Byte
End TypePrivate Declare Function RasSetEntryProperties Lib "rasapi32" Alias "RasSetEntryPropertiesA" (ByVal lpszPhonebook As String, ByVal lpszEntry As String, lpRasEntry As RASENTRY, ByVal dwEntryInfoSize As Long, ByVal lpbDeviceInfo As Long, ByVal dwDeviceInfoSize As Long) As Long
Private Declare Function RasSetCredentials Lib "rasapi32" Alias "RasSetCredentialsA" (ByVal lpszPhonebook As String, ByVal lpszEntry As String, lpCredentials As RASCREDENTIALS, ByVal fClearCredentials As Long) As LongPrivate Sub Command1_Click()
Dim sEntryName As String, sUsername As String, sPassword As String sEntryName = "VPN"
sUsername = "super"
sPassword = "greenbean" If Create_PPPoE_Connection("VPN", sEntryName, sUsername, sPassword) Then
MsgBox "连接建立成功!"
Else
MsgBox "连接建立失败!"
End If
End SubFunction Create_PPPoE_Connection(ByVal sDeviceType As String, ByVal sEntryName As String, ByVal sUsername As String, ByVal sPassword As String) As Boolean
Create_PPPoE_Connection = False Dim re As RASENTRY
Dim sDeviceName As String ', sDeviceType As String
sDeviceName = "WAN 微型端口 (PPTP)"
With re
.dwSize = LenB(re)
.dwCountryCode = 86
.dwCountryID = 86
.dwDialExtraPercent = 75
.dwDialExtraSampleSeconds = 120
.dwDialMode = 1
.dwEncryptionType = 3
.dwfNetProtocols = 4
.dwfOptions = 1024262928
.dwfOptions2 = 367
.dwFramingProtocol = 1
.dwHangUpExtraPercent = 10
.dwHangUpExtraSampleSeconds = 120
.dwRedialCount = 3
.dwRedialPause = 60
.dwType = 5 '3 直连4 管理5 宽带7 普通
CopyMemory .szDeviceName(0), ByVal sDeviceName, Len(sDeviceName)
CopyMemory .szDeviceType(0), ByVal sDeviceType, Len(sDeviceType)
End With Dim rc As RASCREDENTIALS
With rc
.dwSize = LenB(rc)
.dwMask = 11
CopyMemory .szUserName(0), ByVal sUsername, Len(sUsername)
CopyMemory .szPassword(0), ByVal sPassword, Len(sPassword)
End With Dim rtn As Long
If RasSetEntryProperties(vbNullString, sEntryName, re, LenB(re), 0, 0) = 0 Then
If RasSetCredentials(vbNullString, sEntryName, rc, 0) = 0 Then
Create_PPPoE_Connection = True
End If
End If
End Function
Option Explicit
'拨号/断网
Private Declare Function InternetDial Lib "wininet.dll" (ByVal hwndParent As Long, ByVal lpszConnectoid As String, ByVal dwFlags As Long, lpdwConnection As Long, ByVal dwReserved As Long) As Long
Private Declare Function InternetHangUp Lib "wininet.dll" (ByVal dwConnection As Long, ByVal dwReserved As Long) As Long
Private Declare Function InternetAutodial Lib "wininet.dll" (ByVal dwFlags As Long, ByVal dwReserved As Long) As Long
Private Declare Function InternetAutodialHangup Lib "wininet.dll" (ByVal dwReserved As Long) As Long
Private Const INTERNET_DIALSTATE_DISCONNECTED = 1
Private Const INTERNET_AUTODIAL_FORCE_ONLINE = 1
Private Const INTERNET_AUTODIAL_FORCE_UNATTENDED = 2
Private Const INTERNET_DIAL_UNATTENDED = &H8000
Private Handle As Long'网络状态
Private Declare Function InternetGetConnectedStateEx Lib "wininet.dll" Alias "InternetGetConnectedStateExA" (ByRef lpdwFlags As Long, ByVal lpszConnectionName As String, ByVal dwNameLen As Long, ByVal dwReserved As Long) As Long
Private Declare Function InternetGetConnectedState Lib "wininet.dll" (ByRef dwFlags As Long, ByVal dwReserved As Long) As Long
Private Const INTERNET_CONNECTION_MODEM As Long = &H1 '本系统使用调制解调器与因特网相连
Private Const INTERNET_CONNECTION_LAN As Long = &H2 '本系统通过LAN与因特网相连
Private Const INTERNET_CONNECTION_PROXY As Long = &H4 '本系统使用proxy代理服务器与因特网相连
Private Const INTERNET_CONNECTION_MODEM_BUSY As Long = &H8 '未使用
Private Const INTERNET_RAS_INSTALLED As Long = &H10
Private Const INTERNET_CONNECTION_OFFLINE As Long = &H20
Private Const INTERNET_CONNECTION_CONFIGURED As Long = &H40'枚举网络连接
Private Const RAS_MaxDeviceType = 16
Private Const RAS95_MaxDeviceName = 128
Private Const RAS95_MaxEntryName = 256
Private Type RASCONN95
dwSize As Long
hRasConn As Long
szEntryName(RAS95_MaxEntryName) As Byte
szDeviceType(RAS_MaxDeviceType) As Byte
szDeviceName(RAS95_MaxDeviceName) As Byte
End Type
Private Type RASENTRYNAME95
dwSize As Long
szEntryName(RAS95_MaxEntryName) As Byte
End Type
Private Declare Function RasEnumConnections Lib "rasapi32.dll" Alias "RasEnumConnectionsA" (lprasconn As Any, lpcb As Long, lpcConnections As Long) As Long
Private Declare Function RasEnumEntries Lib "rasapi32.dll" Alias "RasEnumEntriesA" (ByVal reserved As String, ByVal lpszPhonebook As String, lprasentryname As Any, lpcb As Long, lpcEntries As Long) As Long
Private Declare Function RasHangUp Lib "rasapi32.dll" Alias "RasHangUpA" (ByVal hRasConn As Long) As Long'拨号
Public Function DialUp(LinkName As String) As Boolean
InternetDial 0, LinkName, INTERNET_AUTODIAL_FORCE_UNATTENDED, Handle, 0
DialUp = (Handle <> 0)
End Function
'断网
Public Sub HangUp()
If Handle <> 0 Then
InternetHangUp Handle, 0
Handle = 0
End If
End Sub
'枚举网络连接
Public Sub EnumConnectName(Value() As String)
Dim s As Long, l As Long, ln As Long, a As String
ReDim r(255) As RASENTRYNAME95 r(0).dwSize = 264
s = 256 * r(0).dwSize
l = RasEnumEntries(vbNullString, vbNullString, r(0), s, ln)
ReDim Value(ln - 1)
For l = 0 To ln - 1
a = StrConv(r(l).szEntryName(), vbUnicode)
Value(l) = Left$(a$, InStr(a$, Chr$(0)) - 1)
Next
End Sub'判断是否在线
Public Function Online() As Boolean
Online = InternetGetConnectedState(0&, 0&)
End Function
'判断是否在线并返回连接方式
Public Property Get OnlineOfLinkName(LinkName As String) As Boolean
LinkName = Space$(128)
OnlineOfLinkName = InternetGetConnectedStateEx(0, LinkName, 128, 0&)
End Property'如果是通过LAN的连接,则返回True
Public Function IsNetConnectViaLAN() As Boolean
Dim dwFlags As Long
Call InternetGetConnectedState(dwFlags, 0&)
IsNetConnectViaLAN = dwFlags And INTERNET_CONNECTION_LAN
End Function
'如果是通过调制解调器的连接,则返回True
Public Function IsNetConnectViaModem() As Boolean
Dim dwFlags As Long
Call InternetGetConnectedState(dwFlags, 0&)
IsNetConnectViaModem = dwFlags And INTERNET_CONNECTION_MODEM
End Function
'如果是通过Proxy代理服务器的连接,则返回True
Public Function IsNetConnectViaProxy() As Boolean
Dim dwFlags As Long
Call InternetGetConnectedState(dwFlags, 0&)
IsNetConnectViaProxy = dwFlags And INTERNET_CONNECTION_PROXY
End Function
'如果已安装了RAS,则返回True
Public Function IsNetRASInstalled() As Boolean
Dim dwFlags As Long
Call InternetGetConnectedState(dwFlags, 0&)
IsNetRASInstalled = dwFlags And INTERNET_RAS_INSTALLED
End Function
'返回当前网络状态信息字符串
Public Function GetNetConnectString() As String
Dim dwFlags As Long
Dim msg As String
If InternetGetConnectedState(dwFlags, 0&) Then
If dwFlags And INTERNET_CONNECTION_CONFIGURED Then
msg = msg & "系统配置了网络连接" & vbCrLf
End If
If dwFlags And INTERNET_CONNECTION_LAN Then
msg = msg & "系统通过局域网与因特网相连接"
End If
If dwFlags And INTERNET_CONNECTION_PROXY Then
msg = msg & "并使用了Proxy代理服务"
Else: msg = msg & "."
End If
If dwFlags And INTERNET_CONNECTION_MODEM Then
msg = msg & "系统使用调制解调器与因特网相连接"
End If
If dwFlags And INTERNET_CONNECTION_OFFLINE Then
msg = msg & "系统当前处于离线状态"
End If
If dwFlags And INTERNET_CONNECTION_MODEM_BUSY Then
msg = msg & "系统的调制解调器未连接到因特网"
End If
If dwFlags And INTERNET_RAS_INSTALLED Then
msg = msg & "本系统安装了远程访问服务"
End If
Else
msg = "当前未与因特网相连"
End If
GetNetConnectString = msg
End Function
Private Sub Command1_Click()
DialUp "vpn"
End Sub