ras, dotnet, vb Here is a RAS wrapper for VB, along with some examples

  • Thread starter Thread starter Black Ninja
  • Start date Start date
B

Black Ninja

''''''''''''''The class needs to be called clsRAS, paste the following
Imports System.Runtime.InteropServices
Public Class ras
Private Const RAS_MaxEntryName As Integer = 256
Private Const RAS_MaxPhoneNumber As Integer = 128
Private Const UNLEN As Integer = 256
Private Const PWLEN As Integer = 256
Private Const DNLEN As Integer = 15
Private Const MAX_PATH As Integer = 260
Private Const RAS_MaxDeviceType As Integer = 16
Private Const RAS_MaxDeviceName As Integer = 128
Private Const RAS_MaxCallbackNumber As Integer =
RAS_MaxPhoneNumber
Private Const ERROR_BUFFER_TOO_SMALL = 603
Private Const RDEOPT_IgnoreModemSpeaker = 4&
Private Const RDEOPT_SetModemSpeaker = &H8S

Private mvarprevioushandle As IntPtr

Public Declare Auto Function RasGetErrorString Lib "rasapi32.dll"
(ByVal uErrorValue As Integer, ByVal lpszErrorString As String, ByVal
cBufSize As Integer) As Integer

<StructLayout(LayoutKind.Sequential, Pack:=1,
CharSet:=CharSet.Auto)> _
Private Structure RASDIALEXTENSIONS
Public dwSize As Integer
Public dwfOptions As Integer
Public hwndParent As Integer
Public Reserved As Integer
End Structure

<StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Auto)> _
Public Structure RASDIALPARAMS
Public dwSize As Integer
<MarshalAs(UnmanagedType.ByValTStr,
SizeConst:=RAS_MaxEntryName + 1)> Public szEntryName As String
<MarshalAs(UnmanagedType.ByValTStr,
SizeConst:=RAS_MaxPhoneNumber + 1)> Public szPhoneNumber As String
<MarshalAs(UnmanagedType.ByValTStr,
SizeConst:=RAS_MaxCallbackNumber + 1)> Public szCallbackNumber As
String
<MarshalAs(UnmanagedType.ByValTStr, SizeConst:=UNLEN + 1)>
Public szUserName As String
<MarshalAs(UnmanagedType.ByValTStr, SizeConst:=PWLEN + 1)>
Public szPassword As String
<MarshalAs(UnmanagedType.ByValTStr, SizeConst:=DNLEN + 1)>
Public szDomain As String
End Structure

Public Delegate Function myrasdialfunc(ByVal hrasconn As IntPtr,
ByVal unMsg As Integer, ByVal rasconnstate As Integer, ByVal dwError
As Integer, ByVal dwexterror As Integer) As Integer

Private Declare Auto Function RasDial Lib "rasapi32.dll" (ByRef
lpRasDialExtensions As RASDIALEXTENSIONS, ByVal lpszPhonebook As
String, ByRef lpRasDialParams As RASDIALPARAMS, ByVal dwNotifierType
As Integer, ByVal lpvNotifier As myrasdialfunc, ByRef lphRasConn As
IntPtr) As Integer
Public Declare Auto Function RasHangUp Lib "rasapi32.dll" (ByVal
hRasConn As IntPtr) As Integer

<StructLayout(LayoutKind.Sequential, Pack:=4,
CharSet:=CharSet.Auto)> _
Public Structure RASCONN
Public dwSize As Integer
Public hRasCon As IntPtr
<MarshalAs(UnmanagedType.ByValTStr,
sizeconst:=RAS_MaxEntryName + 1)> Public szEntryname As String
<MarshalAs(UnmanagedType.ByValTStr,
sizeconst:=RAS_MaxDeviceType + 1)> Public szDeviceType As String
<MarshalAs(UnmanagedType.ByValTStr,
sizeconst:=RAS_MaxDeviceName + 1)> Public szDeviceName As String
End Structure

Private Declare Auto Function RasEnumConnections Lib
"rasapi32.dll" (ByVal lpRasCon As IntPtr, ByRef lpcb As Integer, ByRef
lpcConnections As Integer) As Integer

<StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Auto)> _
Public Structure RASENTRYNAME
Public dwSize As Integer
<MarshalAs(UnmanagedType.ByValTStr,
SizeConst:=RAS_MaxEntryName + 1)> Public szEntryName As String
Public dwFlags As Integer
<MarshalAs(UnmanagedType.ByValTStr, SizeConst:=MAX_PATH + 1)>
Public szPhonebookPath As String
End Structure

Private Declare Auto Function RasEnumEntries Lib "rasapi32.dll"
(ByVal lpStrNull As String, ByVal lpszPhonebook As String, ByVal
lpRasEntryName As IntPtr, ByRef lpCb As Integer, ByRef lpCEntries As
Integer) As Integer

Public Property PreviousHandle() As IntPtr
Get
Return mvarprevioushandle
End Get
Set(ByVal Value As IntPtr)
mvarprevioushandle = Value
End Set
End Property
Public Sub EnumEntries(ByRef mincoming() As RASENTRYNAME)
Dim entries() As RASENTRYNAME
Dim rasentrynamelen As Integer =
Marshal.SizeOf(GetType(RASENTRYNAME))
Dim lpcb As Integer = rasentrynamelen
Dim lpcentries As Integer

Dim parray As IntPtr = Marshal.AllocHGlobal(rasentrynamelen)
Marshal.WriteInt32(parray, rasentrynamelen)

Dim ret As Integer = RasEnumEntries(Nothing, Nothing, parray,
lpcb, lpcentries)

If ret = ERROR_BUFFER_TOO_SMALL Then
parray = Marshal.ReAllocHGlobal(parray, New IntPtr(lpcb))
Marshal.WriteInt32(parray, rasentrynamelen)
ret = RasEnumEntries(Nothing, Nothing, parray, lpcb,
lpcentries)
ElseIf ret <> 0 Then
Throw New Exception(GetRasError(ret))
End If


If ret = 0 And lpcentries > 0 Then
ReDim entries(lpcentries - 1)
Dim pentry As IntPtr = parray
Dim i As Integer
For i = 0 To lpcentries - 1
entries(i) = Marshal.PtrToStructure(pentry,
GetType(RASENTRYNAME))
pentry = New IntPtr(pentry.ToInt32 + rasentrynamelen)
Next
pentry = Nothing
End If

Marshal.FreeHGlobal(parray)

mincoming = entries

entries = Nothing
End Sub
Public Sub EnumConnections(ByRef mincoming() As RASCONN)


Dim structtype As Type = GetType(RASCONN)
Dim structsize As Integer = Marshal.SizeOf(GetType(RASCONN))
Dim bufsize As Integer = structsize
Dim realcount As Integer
Dim TRasCon() As RASCONN

Dim bufptr As IntPtr = Marshal.AllocHGlobal(structsize)
Marshal.WriteInt32(bufptr, structsize)

Dim retcode As Integer = RasEnumConnections(bufptr, bufsize,
realcount)

If retcode = ERROR_BUFFER_TOO_SMALL Then
bufptr = Marshal.ReAllocHGlobal(bufptr, New
IntPtr(bufsize))
Marshal.WriteInt32(bufptr, structsize)
retcode = RasEnumConnections(bufptr, bufsize, realcount)
ElseIf retcode <> 0 Then
Throw New Exception(GetRasError(retcode))
End If

If (retcode = 0) And (realcount > 0) Then
ReDim TRasCon(realcount - 1)
Dim i As Integer
Dim runptr As IntPtr = bufptr

For i = 0 To (realcount - 1)
TRasCon(i) = Marshal.PtrToStructure(runptr,
structtype)
runptr = New IntPtr(runptr.ToInt32 + structsize)
Next
runptr = Nothing
End If

Marshal.FreeHGlobal(bufptr)

mincoming = TRasCon

TRasCon = Nothing

End Sub
Public Function DialEntry(ByVal mentryname As String, ByVal
musername As String, ByVal mpassword As String, ByVal mcallback As
myrasdialfunc) As IntPtr

Dim objRASParams As New RASDIALPARAMS()
Dim mvarRasExtension As New RASDIALEXTENSIONS()
Dim hRASConn As New IntPtr()

With mvarRasExtension
.hwndParent = 0&
.Reserved = 0
.dwfOptions = RDEOPT_IgnoreModemSpeaker
.dwSize = Marshal.SizeOf(GetType(RASDIALEXTENSIONS))
End With

With objRASParams
.szEntryName = mentryname
.szPhoneNumber = ""
.szCallbackNumber = ""
.szUserName = musername
.szPassword = mpassword
.szDomain = "*"
.dwSize = Marshal.SizeOf(GetType(RASDIALPARAMS))
End With

Dim intRet As Integer = RasDial(mvarRasExtension, Nothing,
objRASParams, 1, mcallback, hRASConn)
If intRet <> 0 Then
Dim errorstring As String = GetRasError(intRet)
If errorstring.IndexOf("already being dialed") Then
If hRASConn.Equals(IntPtr.Zero) = False Then
RasHangUp(hRASConn)
If mvarprevioushandle.Equals(IntPtr.Zero) = False Then
RasHangUp(mvarprevioushandle)
End If
Throw New Exception(errorstring)
End If

DialEntry = hRASConn

objRASParams = Nothing
hRASConn = Nothing
mvarRasExtension = Nothing

End Function
Public Sub HangEntry(ByVal mentryname As String)

Dim structtype As Type = GetType(RASCONN)
Dim structsize As Integer = Marshal.SizeOf(GetType(RASCONN))
Dim bufsize As Integer = structsize
Dim realcount As Integer
Dim TRasCon() As RASCONN

Dim bufptr As IntPtr = Marshal.AllocHGlobal(structsize)
Marshal.WriteInt32(bufptr, structsize)

Dim retcode As Integer = RasEnumConnections(bufptr, bufsize,
realcount)

If retcode = ERROR_BUFFER_TOO_SMALL Then
bufptr = Marshal.ReAllocHGlobal(bufptr, New
IntPtr(bufsize))
Marshal.WriteInt2(bufptr, structsize)
retcode = RasEnumConnections(bufptr, bufsize, realcount)
ElseIf retcode <> 0 Then
Throw New Exception(GetRasError(retcode))
End If

If (retcode = 0) And (realcount > 0) Then
ReDim TRasCon(realcount - 1)
Dim i As Integer
Dim runptr As IntPtr = bufptr

For i = 0 To (realcount - 1)
TRasCon(i) = Marshal.PtrToStructure(runptr,
structtype)
runptr = New IntPtr(runptr.ToInt32 + structsize)
Next

Dim m As RASCONN
For Each m In TRasCon
If m.szEntryname = mentryname Then
RasHangUp(m.hRasCon)
End If
Next

runptr = Nothing
End If

Marshal.FreeHGlobal(bufptr)

bufptr = Nothing
End Sub
Public Function IsConnected(ByVal mentryname As String) As Boolean

Dim structtype As Type = GetType(RASCONN)
Dim structsize As Integer = Marshal.SizeOf(GetType(RASCONN))
Dim bufsize As Integer = structsize
Dim entrycount As Integer
Dim entries() As RASCONN

Dim bufptr As IntPtr = Marshal.AllocHGlobal(structsize)
Marshal.WriteInt32(bufptr, structsize)

Dim retcode As Integer = RasEnumConnections(bufptr, bufsize,
entrycount)

If retcode = ERROR_BUFFER_TOO_SMALL Then
bufptr = Marshal.ReAllocHGlobal(bufptr, New
IntPtr(bufsize))
Marshal.WriteInt32(bufptr, structsize)
retcode = RasEnumConnections(bufptr, bufsize, entrycount)
ElseIf retcode <> 0 Then
Throw New Exception(GetRasError(retcode))
End If

If (retcode = 0) And (entrycount > 0) Then
ReDim entries(entrycount - 1)
Dim i As Integer
Dim runptr As IntPtr = bufptr

For i = 0 To (entrycount - 1)
entries(i) = Marshal.PtrToStructure(runptr,
structtype)
runptr = New IntPtr(runptr.ToInt32 + structsize)
Next

runptr = Nothing

Dim mEntry As RASCONN
For Each mEntry In entries
If mEntry.szEntryname = mentryname Then
IsConnected = True
End If
Next

End If

Marshal.FreeHGlobal(bufptr)

bufptr = Nothing
End Function
Private Function GetRasError(ByVal dwerror As Integer) As String

Dim sErrMsg As New String(Space(512))
Dim lret As Integer

lret = ras.RasGetErrorString(dwerror, sErrMsg, Len(sErrMsg))


If lret = 0 Then
sErrMsg = sErrMsg.Remove(sErrMsg.IndexOf(Chr(0)),
Len(sErrMsg) - sErrMsg.IndexOf(Chr(0)))
GetRasError = "Error # " & dwerror & "; Error Description:
" & sErrMsg
Else
GetRasError = "Unknown RAS Error"
End If

End Function
End Class



'''''''''''''''''The form can be called anything, paste the following
Imports System.IO
Imports System.Net
Public Class frmRAS
Inherits System.Windows.Forms.Form


Private mvarvpncallback As ras.myrasdialfunc = AddressOf
VPNRasDialFunc
Private mvarispcallback As ras.myrasdialfunc = AddressOf
ISPRasDialFunc
Private mvarProgramName As String
Private mvarvpnconnectionname As String
Private mvarvpnusername As String
Private mvarvpnpassword As String
Private mvarvpnretryinterval As Integer
Private mvarispconnectionname As String
Private mvarispusername As String
Private mvarisppassword As String
Private mvarispretryinterval As Integer
Private mvarvpnprevhandle As IntPtr
Private mvarispprevhandle As IntPtr

Private Function VPNRasDialFunc(ByVal hrasconn As IntPtr, ByVal
unMsg As Integer, ByVal rasconnstate As Integer, ByVal dwError As
Integer, ByVal dwexterror As Integer) As Integer
'Debug.WriteLine("DF: " & unMsg.ToString & " - " &
rasconnstate.ToString & " - " & dwError.ToString)
'If dwError <> 0 Then Debug.WriteLine(GetRasError(dwError))
Try
If dwError <> 0 Then
ras.RasHangUp(hrasconn)
Throw New System.Exception(GetRasError(dwError))
End If
Catch exp As Exception
ErrorToXML(exp)
End Try

End Function
Private Function ISPRasDialFunc(ByVal hrasconn As IntPtr, ByVal
unMsg As Integer, ByVal rasconnstate As Integer, ByVal dwError As
Integer, ByVal dwexterror As Integer) As Integer
'Debug.WriteLine("DF: " & unMsg.ToString & " - " &
rasconnstate.ToString & " - " & dwError.ToString)
'If dwError <> 0 Then Debug.WriteLine(GetRasError(dwError))
Try
If dwError <> 0 Then
ras.RasHangUp(hrasconn)
Throw New System.Exception(GetRasError(dwError))
End If
Catch exp As Exception
ErrorToXML(exp)
End Try

End Function
''''''''''''''Fill in all the usernames and passwords as appropriate
Private Sub GetRegistrySettings()

Try
mvarvpnusername = "VPNUserName"
mvarvpnconnectionname = "VPNConnectionName"
mvarvpnpassword = "VPNPassword"
mvarvpnretryinterval = "VPNRetryInterval"
mvarispusername = "ISPUserName"
mvarispconnectionname = "ISPConnectionName"
mvarisppassword = "ISPPassowrd"
Catch exp As Exception
ErrorToXML(exp)
Finally
mvarcregistry = Nothing
End Try
End Sub
Private Sub ErrorToXML(ByVal exp As Exception)
Try
MessageBox.Show(exp.ToString)
Catch expprivate As Exception
MessageBox.Show(exp.ToString)
Finally
'nothing
End Try
End Sub

Private Sub frmRAS_Load(ByVal sender As System.Object, ByVal e As
System.EventArgs) Handles MyBase.Load
If (UBound(Diagnostics.Process.GetProcessesByName(Diagnostics.Process.GetCurrentProcess.ProcessName))
0) = True Then
Click to expand...
Me.Close()
End If
mvarProgramName = System.Windows.Forms.Application.ProductName
& " " & System.Windows.Forms.Application.ProductVersion
Try
GetRegistrySettings()
Catch exp As Exception
ErrorToXML(exp)
End Try

End Sub

''''''''''''This is the main function that calls the RAS class. The
previous handle, if it failed, must be hung, before trying to redial.
This program was designed to keep the computer on the internet and vpn
indefinately.

Private Sub tmrDialer_Tick(ByVal sender As System.Object, ByVal e
As System.EventArgs) Handles tmrDialer.Tick
Dim mvarVPNRas As New ras(), mvarISPRAS As New ras(),
mvartemphandle As New IntPtr()

Try
If mvarispretryinterval > 0 Then
If Now.Minute Mod mvarispretryinterval = 0 Then
If mvarISPRAS.IsConnected(mvarispconnectionname) =
False Then
If mvarispprevhandle.Equals(IntPtr.Zero) =
False Then mvarISPRAS.PreviousHandle = mvarispprevhandle
mvartemphandle =
mvarISPRAS.DialEntry(mvarispconnectionname, mvarispusername,
mvarisppassword, mvarispcallback)
If mvartemphandle.Equals(IntPtr.Zero) = False
Then mvarispprevhandle = mvartemphandle
End If
End If
End If
Catch exp As Exception
ErrorToXML(exp)
End Try

Try
If mvarvpnretryinterval > 0 Then
If Now.Minute Mod mvarvpnretryinterval = 0 Then
If mvarVPNRas.IsConnected(mvarvpnconnectionname) =
False Then
If mvarvpnprevhandle.Equals(IntPtr.Zero) =
False Then mvarVPNRas.PreviousHandle = mvarvpnprevhandle
mvartemphandle =
mvarVPNRas.DialEntry(mvarvpnconnectionname, mvarvpnusername,
mvarvpnpassword, mvarvpncallback)
If mvartemphandle.Equals(IntPtr.Zero) = False
Then mvarvpnprevhandle = mvartemphandle
End If
End If
End If
Catch exp As Exception
ErrorToXML(exp)
End Try

mvarVPNRas = Nothing
mvarISPRAS = Nothing
mvartemphandle = Nothing

End Sub


Private Function GetRasError(ByVal dwerror As Integer) As String

Dim sErrMsg As New String(Space(512))
Dim lret As Integer

lret = ras.RasGetErrorString(dwerror, sErrMsg, Len(sErrMsg))


If lret = 0 Then
sErrMsg = sErrMsg.Remove(sErrMsg.IndexOf(Chr(0)),
Len(sErrMsg) - sErrMsg.IndexOf(Chr(0)))
GetRasError = "Error # " & dwerror & "; Error Description:
" & sErrMsg
Else
GetRasError = "Unknown RAS Error"
End If

End Function

End Class
 
That's exacly what I was looking for...
But I still have problems with running your code...
Would you be so kind and send me running wersion of it?
mailto: (e-mail address removed)
I need only working RasEnumConnections function - I still have some problems
with this...
Please help,
zurg
 
Back
Top