Вот решение, которое я нашел:
Public Class VPN
Public name As String
Public type As String
Public status As String
Public ip As String
End Class
Public Function GetWindowsVPNs() As List(Of VPN)
Dim vpn_names As String()
Dim vpns As New RAS
Dim strVpn As String
Dim active As Boolean = False
Dim conIPstr As String = ""
Dim vpnCheck As New clsVPN
Dim vpnList As New List(Of VPN)
vpn_names = vpns.GetConnectionsNames()
For Each strVpn In vpn_names
Dim vpn As New VPN
vpn.name = strVpn
vpn.type = "Windows VPN"
active = False
vpnCheck.ConName = vpn.name
active = vpnCheck.CheckConnection()
If active = True Then
vpn.status = "Active"
Try
conIPstr = GetMyIPstr()
Catch e As Exception
MessageBox.Show("Error: Function GetConnectionList: Error returning IP Address" & vbCrLf & vbCrLf & e.Message)
End Try
vpn.ip = conIPstr
Else
vpn.status = "Not Active"
vpn.ip = "No IP Address"
End If
vpnList.Add(vpn)
Next
Return vpnList
End Function
Private Function GetMyIPstr() As String
Dim client As New WebClient
Dim s As String = "No IP Address"
'// Add a user agent header in case the requested URI contains a query.
client.Headers.Add("user-agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.2; .NET CLR1.0.3705;)")
Dim baseurl As String = "http://checkip.dyndns.org/"
' with proxy server only:
Dim proxy As IWebProxy = WebRequest.GetSystemWebProxy()
proxy.Credentials = CredentialCache.DefaultNetworkCredentials
client.Proxy = proxy
Dim data As Stream
Try
data = client.OpenRead(baseurl)
Catch ex As Exception
MsgBox("open url " & ex.Message)
Exit Function
End Try
Dim reader As StreamReader = New StreamReader(data)
s = reader.ReadToEnd()
data.Close()
reader.Close()
s = s.Replace("<html><head><title>Current IP Check</title></head><body>", "").Replace("</body></html>", "").ToString()
s = s.Replace("Current IP Address: ", "")
s = s.Replace(vbCr, "").Replace(vbLf, "")
Return s
End Function
Imports System.Linq
Imports System.Net.NetworkInformation
Public Class clsVPN
Public Delegate Sub delPing()
Public Delegate Sub delConnect()
Public Delegate Sub delIdle()
Public Delegate Sub delDisconnect()
Public Delegate Sub delStatus(blnConnected As Boolean)
Public Event Ping As delPing
Public Event Con As delConnect
Public Event Discon As delDisconnect
Public Event Idle As delIdle
Public Event StatusChanged As delStatus
Public strRASPhone As String = "C:\WINDOWS\system32\rasphone.exe"
Public strIPAddress As String = ""
Public strVPNCon As String = ""
Public blnConnected As Boolean = False
Dim file As String = "C : \Users\Tom\AppData\Roaming\Microsoft\Network\Connections\Pbk\rasphone.pbk"
Protected Sub OnStatusChanged(blnConnected As Boolean)
RaiseEvent StatusChanged(blnConnected)
End Sub
Protected Sub OnDisconnect()
RaiseEvent Discon()
End Sub
Protected Sub OnPing()
RaiseEvent Ping()
End Sub
Protected Sub OnIdle()
RaiseEvent Idle()
End Sub
Protected Sub OnConnect()
RaiseEvent Con()
End Sub
Public ReadOnly Property Connected() As Boolean
Get
Return blnConnected
End Get
End Property
Public Property ConName() As String
Get
Return strVPNCon
End Get
Set(strValue As String)
strVPNCon = strValue
End Set
End Property
Public Function Test() As Boolean
Dim blnSucceed As Boolean = False
OnPing()
Dim p As New Ping()
If p.Send(strIPAddress).Status = IPStatus.Success Then
blnSucceed = True
Else
blnSucceed = False
End If
p = Nothing
If blnSucceed <> blnConnected Then
blnConnected = blnSucceed
OnStatusChanged(blnConnected)
End If
OnIdle()
Return blnSucceed
End Function
Public Function Connect() As Boolean
Dim blnSucceed As Boolean = False
Dim optionstr As String = "-f " & file & " -d "
OnConnect()
'MessageBox.Show("strVPNCon = " )
'Process.Start(strRASPhone, Convert.ToString(" -f ") & file & Convert.ToString(" -d ") _
' & strVPNCon)
optionstr = ""
Dim wait As Boolean = True
ProcessExec(strRASPhone, optionstr & strVPNCon, wait)
Application.DoEvents()
System.Threading.Thread.Sleep(5000)
Application.DoEvents()
blnSucceed = True
OnIdle()
Return blnSucceed
End Function
Public Function Disconnect() As Boolean
Dim blnSucceed As Boolean = False
Dim optionstr As String = "-h "
OnDisconnect()
optionstr = ""
Dim wait As Boolean = True
ProcessExec(strRASPhone, optionstr & strVPNCon, wait)
Application.DoEvents()
System.Threading.Thread.Sleep(8000)
Application.DoEvents()
blnSucceed = True
OnIdle()
Return blnSucceed
End Function
Public Function CheckConnection() As Boolean
Dim niVPN As NetworkInterface() =
NetworkInterface.GetAllNetworkInterfaces
Dim blnExist As Boolean =
niVPN.AsEnumerable().Any(Function(x) x.Name = ConName)
If blnExist Then
'MessageBox.Show("VPN Exists")
Else
' MessageBox.Show("VPN Does Not Exist")
End If
Return blnExist
End Function
Public Sub ProcessExec(processarg As String, param As String, wait As Boolean)
' Start the child process.
Dim p As New ProcessStartInfo
' Redirect the output stream of the child process.
p.FileName = processarg
p.Arguments = param
p.UseShellExecute = True
p.WindowStyle = ProcessWindowStyle.Normal
Dim proc As Process = Process.Start(p)
' Do Not wait for the child process to exit before
' reading to the end of its redirected stream.
If wait = True Then
proc.WaitForExit()
End If
End Sub
End Class
Imports System.Runtime.InteropServices
Public Class RAS
Private Const MAX_PATH As Integer = 260 + 1
Private Const MAX_RAS_ENTRY_NAMES As Integer = 256 + 1
<StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Unicode)>
Public Structure RASENTRYNAME
Public dwSize As Integer
<MarshalAs(UnmanagedType.ByValTStr, SizeConst:=MAX_RAS_ENTRY_NAMES)>
Public szEntryName As String
Public dwFlags As Integer
<MarshalAs(UnmanagedType.ByValTStr, SizeConst:=MAX_PATH)>
Public szPhonebook As String
End Structure
Private Declare Auto Function RasEnumEntries Lib "rasapi32.dll" (
ByVal reserved As String,
ByVal phonebook As String,
<[In](), Out()> ByVal RasEntries() As RASENTRYNAME,
ByRef BufferSize As Integer,
ByRef EntryCount As Integer
) As Integer
Public Function GetConnectionsNames() As String()
Dim res As New List(Of String)
Try
Dim bufferSize As Integer = Marshal.SizeOf(GetType(RASENTRYNAME))
Dim entryCount As Integer = 1
Dim entryNames(0) As RASENTRYNAME
Dim rc As Integer
entryNames(0).dwSize = Marshal.SizeOf(GetType(RASENTRYNAME))
rc = RasEnumEntries(Nothing, Nothing, entryNames, bufferSize, entryCount)
If rc = 0 Then
' There was only one entry and it's been filled into the "dummy"
' entry that we made before calling RasEnumEntries.
res.Add(entryNames(0).szEntryName.Trim)
ElseIf rc = 603 Then
' 603 means that there are more entries than we have allocated space for.
' So, expand the entryNames array and make sure we fill in the structure size
' for every entry in the array! This is important!! Without it, you'll get 632 errors!
ReDim entryNames(entryCount - 1)
For i As Integer = 0 To entryCount - 1
entryNames(i).dwSize = Marshal.SizeOf(GetType(RASENTRYNAME))
Next
rc = RasEnumEntries(Nothing, Nothing, entryNames, bufferSize, entryCount)
For i As Integer = 0 To entryCount - 1
res.Add(entryNames(i).szEntryName.Trim)
Next
Else
' So if we get here, the call bombed. It would be a good idea to find out why here!
MsgBox("Error reading RAS connections names, error code:" & rc.ToString(), MsgBoxStyle.SystemModal)
End If
Catch ex As Exception
MsgBox("Error reading RAS connection names: " & ex.Message.ToString(), MsgBoxStyle.SystemModal)
End Try
Return res.ToArray
End Function
End Class