Imports System.Runtime.InteropServices
Imports System.Text

<StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Auto)> _
Public Class CRasDevInfo
    'Classe necessaria al corretto funzionamento;
    'utilizzando una struttura, la funzione GetDevices, non va abuon fine
    Public dwSize As Integer
    <MarshalAs(UnmanagedType.ByValTStr, SizeConst:=RAS.RAS_MaxDeviceType + 1)> Public szDeviceType As String
    <MarshalAs(UnmanagedType.ByValTStr, SizeConst:=RAS.RAS_MaxDeviceName + 1)> Public szDeviceName As String
End Class

Public Class RAS

#Region " Costanti "

    Public Const UNLEN As Integer = 256
    Public Const PWLEN As Integer = 256
    Public Const DNLEN As Integer = 15
    Public Const MAX_PATH As Integer = 260
    Public Const RAS_MaxEntryName As Integer = 256
    Public Const RAS_MaxPhoneNumber As Integer = 128
    Public Const RAS_MaxDeviceType As Integer = 16
    Public Const RAS_MaxDeviceName As Integer = 128
    Public Const RAS_MaxCallbackNumber As Integer = RAS_MaxPhoneNumber
    Public Const RAS_MaxAreaCode As Integer = 10
    Public Const ERROR_BUFFER_TOO_SMALL = 603
    Public Const GMEM_FIXED = &H0
    Public Const GMEM_ZEROINIT = &H40
    Public Const GPTR = (GMEM_FIXED Or GMEM_ZEROINIT)
    Public Const ApINULL = 0&

#End Region


#Region " Enumerazioni "

    Public Enum RasEntryOptions
        RASEO_UseCountryAndAreaCodes = &H1
        RASEO_SpecificIpAddr = &H2
        RASEO_SpecificNameServers = &H4
        RASEO_IpHeaderCompression = &H8
        RASEO_RemoteDefaultGateway = &H10
        RASEO_DisableLcpExtensions = &H20
        RASEO_TerminalBeforeDial = &H40
        RASEO_TerminalAfterDial = &H80
        RASEO_ModemLights = &H100
        RASEO_SwCompression = &H200
        RASEO_RequireEncryptedPw = &H400
        RASEO_RequireMsEncryptedPw = &H800
        RASEO_RequireDataEncryption = &H1000
        RASEO_NetworkLogon = &H2000
        RASEO_UseLogonCredentials = &H4000
        RASEO_PromoteAlternates = &H8000
        RASEO_SecureLocalFiles = &H10000
        RASEO_RequireEAP = &H20000
        RASEO_RequirePAP = &H40000
        RASEO_RequireSPAP = &H80000
        RASEO_Custom = &H100000
        RASEO_PreviewPhoneNumber = &H200000
        RASEO_SharedPhoneNumbers = &H800000
        RASEO_PreviewUserPw = &H1000000
        RASEO_PreviewDomain = &H2000000
        RASEO_ShowDialingProgress = &H4000000
        RASEO_RequireCHAP = &H8000000
        RASEO_RequireMsCHAP = &H10000000
        RASEO_RequireMsCHAP2 = &H20000000
        RASEO_RequireW95MSCHAP = &H40000000
        RASEO_CustomScript = &H80000000
    End Enum

    Public Enum RASNetProtocols
        RASNP_NetBEUI = &H1
        RASNP_Ipx = &H2
        RASNP_Ip = &H4
    End Enum

    Public Enum RasFramingProtocols
        RASFP_Ppp = &H1
        RASFP_Slip = &H2
        RASFP_Ras = &H4
    End Enum

    Public Enum dwTypes
        RASET_Phone = 1
        RASET_Vpn = 2
        RASET_Direct = 3
        RASET_Internet = 4
        RASET_Broadband = 5
    End Enum

#End Region


#Region " Strutture "

    'RASDEVINFO
    <StructLayout(LayoutKind.Sequential, Pack:=4, CharSet:=CharSet.Auto)> _
   Public Structure RASDEVINFO
        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

    'RASDIALPARAMS
    <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

    'RASENTRYNAME
    <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

    'RASIPADDR
    Public Structure RASIPADDR
        Public a As Byte
        Public b As Byte
        Public c As Byte
        Public d As Byte
    End Structure

    'RASENTRY
    Public Structure RASENTRY
        Public dwSize As Int32
        Public dwfOptions As RasEntryOptions
        'Location/phone number.
        Public dwCountryID As Int32
        Public dwCountryCode As Int32
        Public szAreaCode() As Byte
        Public szLocalPhoneNumber() As Byte
        Public dwAlternateOffset As Int32
        'PPP/Ip.
        Public ipaddr As RASIPADDR
        Public ipaddrDns As RASIPADDR
        Public ipaddrDnsAlt As RASIPADDR
        Public ipaddrWins As RASIPADDR
        Public ipaddrWinsAlt As RASIPADDR
        'Framing
        Public dwFrameSize As Int32
        Public dwfNetProtocols As Int32
        Public dwFramingProtocol As Int32
        'Scripting
        Public szScript() As Byte
        'Autodial
        Public szAutodialDll() As Byte
        Public szAutodialFunc() As Byte
        'Devices
        Public szDeviceType() As Byte
        Public szDeviceName() As Byte
        'X.25
        Public szX25PadType() As Byte
        Public szX25Address() As Byte
        Public szX25Facilities() As Byte
        Public szX25UserData() As Byte
        Public dwChannels As Int32
        'Reserved
        Public dwReserved1 As Int32
        Public dwReserved2 As Int32
        'Windows NT 4.0
        Public dwSubEntries As Int32
        Public dwDialMode As Int32
        Public dwDialExtraPercent As Int32
        Public dwDialExtraSampleSeconds As Int32
        Public dwHangUpExtraPercent As Int32
        Public dwHangUpExtraSampleSeconds As Int32
        Public dwIdleDisconnectSeconds As Int32
        'Windows 2000
        Public dwType As Int32
        Public dwEncryptionType As Int32
        Public dwCustomAuthKey As Int32
        Public guidId As Guid
        Public szCustomDialDll() As Byte
        Public dwVpnStrategy As Int32
        Public dwfOptions2 As Int32
        'Windows XP
        Public dwfOptions3 As Int32
        Public szDnsSuffix() As Byte
        Public dwTcpWindowSize As Int32
        Public szPrerequisitePbk() As Byte
        Public szPrerequisiteEntry() As Byte
        Public dwRedialCount As Int32
        Public dwRedialPause As Int32
        Public Sub Initialize()
            ReDim szAreaCode(10)
            ReDim szLocalPhoneNumber(128)
            ReDim szScript(259)
            ReDim szAutodialDll(259)
            ReDim szAutodialFunc(259)
            ReDim szDeviceType(16)
            ReDim szDeviceName(128)
            ReDim szX25PadType(32)
            ReDim szX25Address(200)
            ReDim szX25Facilities(200)
            ReDim szX25UserData(200)
            ReDim szPrerequisitePbk(259)
            ReDim szPrerequisiteEntry(256)
            ReDim szDnsSuffix(255)
            ReDim szCustomDialDll(259)
        End Sub
    End Structure

    'RASCREDENTIALS
    Private Structure RASCREDENTIALS
        Public dwSize As Long
        Public dwMask As Long
        Dim szUserName() As Byte
        Dim szPassword() As Byte
        Dim szDomain() As Byte
        Public Sub Initialize()
            ReDim szUserName(256)
            ReDim szPassword(256)
            ReDim szDomain(15)
        End Sub
    End Structure

    'VBRASDEVINFO
    Public Structure VBRASDEVINFO
        Public DeviceType As String
        Public DeviceName As String
    End Structure

#End Region


#Region " Funzioni API "
    Private Declare Auto Function RasDial Lib "rasapi32.dll" (ByVal lpRasDialExtensions As IntPtr, ByVal lpszPhonebook As String, ByRef lpRasDialParams As RASDIALPARAMS, ByVal dwNotifierType As Integer, ByVal lpvNotifier As myRASDialFunc, ByRef lphRasConn As IntPtr) As Integer
    Private Declare Auto Function RasHangUp Lib "rasapi32.dll" (ByVal hRasCon As IntPtr) As Integer
    Private Declare Auto Function RasEnumConnections Lib "rasapi32.dll" (ByVal lpRasCon As IntPtr, ByRef lpcb As Integer, ByRef lpcConnections As Integer) As Integer
    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
    Private Declare Auto Function RasEnumDevices Lib "rasapi32.dll" Alias "RasEnumDevicesA" (ByRef lpRasDevInfo As RASDEVINFO(), ByRef lpcb As Integer, ByRef lpcDevices As Integer) As Integer
    Private Declare Auto Function RasEnumDevices Lib "rasapi32.dll" (ByVal lpRasDevInfo As IntPtr, ByRef lpcb As Integer, ByRef lpcDevices As Integer) As Integer
    Private Declare Auto Function RasSetEntryProperties Lib "rasapi32.dll" Alias "RasSetEntryPropertiesA" (ByVal lpszPhonebook As String, ByVal lpszEntry As String, ByVal lpRasEntry As IntPtr, ByVal dwEntryInfoSize As Integer, ByVal lpbDeviceInfo As Integer, ByVal dwDeviceInfoSize As Integer) As Integer
    Private Declare Auto Function RasSetEntryProperties Lib "rasapi32" Alias "RasSetEntryPropertiesA" (ByVal lpszPhonebook As String, ByVal lpszEntry As String, ByVal lpRasEntry As RASENTRY, ByVal dwEntryInfoSize As Long, ByVal lpbDeviceInfo As Long, ByVal dwDeviceInfoSize As Long) As Long
    Private Declare Auto Function RasSetCredentials Lib "rasapi32" Alias "RasSetCredentialsA" (ByVal lpszPhonebook As String, ByVal lpszEntry As String, ByVal lpCredentials As RASCREDENTIALS, ByVal fClearCredentials As Long) As Long
    Private Declare Auto Function RasGetEntryProperties Lib "rasapi32.dll" Alias "RasGetEntryPropertiesA" (ByVal lpszPhonebook As String, ByVal lpszEntry As String, ByRef lpRasEntry As RASENTRY, ByRef lpdwEntryInfoSize As Integer, ByRef lpbDeviceInfo As Integer, ByRef lpdwDeviceInfoSize As Integer) As Integer
    Private Declare Auto Function RasGetErrorString Lib "rasapi32.dll" Alias "RasGetErrorStringA" (ByVal ErrValue As Integer, ByVal lpErrStr As String, ByVal cSize As Integer) As Integer
    Private Declare Auto Function FormatMessage Lib "kernel32" Alias "FormatMessageA" (ByVal dwFlags As Integer, ByRef lpSource As Object, ByVal dwMessageId As Integer, ByVal dwLanguageId As Integer, ByVal lpBuffer As String, ByVal nSize As Integer, ByRef Arguments As Integer) As Integer
    Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Integer, ByVal dwBytes As Integer) As Integer
    Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Integer) As Integer
    'Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef hpvDest() As Byte, ByVal hpvSource As Int32, ByVal Length As Int32)
    'Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As Object, ByVal Source As Object, ByVal Length As Long)
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal lpvDest() As Byte, ByVal lpvSource As String, ByVal cbCopy As Integer)



    'Private Declare Auto Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As Integer, ByRef Source As FileMapDataType, ByVal Length As Integer)


    'Declare Function iRasEnumDevices Lib "rasapi32.dll" Alias "RasEnumDevicesA" ( _
    'ByVal lpRasDevInfo As Any, _
    'ByVal lpcb As Long, _
    'ByVal lpcDevices As Long) As Long

    'Declare Sub iCopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
    'ByVal hpvDest As Any, ByVal hpvSource As Any, ByVal cbCopy As Long)



#End Region


#Region " Delegati "
    Public Delegate Function myRASDialFunc(ByVal unMsg As Integer, ByVal rasconnstate As Integer, ByVal dwError As Integer) As Integer
#End Region


#Region " Sub e Functions "

    'Restituisce l'elenco dei dispositivi RAS
    Public Shared Function GetDevices() As String()
        Dim intRet As Integer
        Dim lpcb As Integer
        Dim lpcDevices As Integer
        Dim devinfo As IntPtr
        Dim rdiRet As CRasDevInfo()
        Dim i As Integer
        Dim strDevList As String()

        Try
            RasEnumDevices(IntPtr.Zero, lpcb, lpcDevices)
            devinfo = Marshal.AllocHGlobal(lpcb)

            ReDim rdiRet(0)
            rdiRet(0) = New CRasDevInfo
            Marshal.WriteInt32(devinfo, Marshal.SizeOf(rdiRet(0)))
            intRet = RasEnumDevices(devinfo, lpcb, lpcDevices)

            If intRet = 0 Then
                ReDim rdiRet(lpcDevices - 1)
                ReDim strDevList(lpcDevices - 1)
                For i = 0 To lpcDevices - 1
                    rdiRet(i) = New CRasDevInfo
                    Marshal.PtrToStructure(devinfo, rdiRet(i))
                    devinfo = IntPtr.op_Explicit(devinfo.ToInt32() + Marshal.SizeOf(rdiRet(i)))
                    strDevList(i) = rdiRet(i).szDeviceName
                Next
                GlobalFree(devinfo.ToInt32)
                Return strDevList
            Else
                Return Nothing
            End If
        Catch ex As Exception
            MsgBox("Impossibile recuperare l'elenco dei dispositivi RAS" & vbCrLf & ex.Message, MsgBoxStyle.Exclamation)
        End Try

    End Function

    Public Shared Function CreateRAS(ByVal sEntryName As String, ByVal sUsername As String, ByVal sPassword As String, _
                                    ByVal sDevice As String, ByVal sTelNumber As String) As Boolean

        Dim aa() As Byte
        Dim bb() As Byte
        Dim re As New RASENTRY
        Dim rp As New RASDIALPARAMS
        Dim sDeviceType As String = "PPPoE"
        Dim instance As Encoding = Encoding.Unicode

        aa = instance.GetBytes(sDevice)
        bb = instance.GetBytes(sDeviceType)
        re.Initialize()
        rp.szEntryName = sDevice
        rp.szPhoneNumber = sTelNumber
        With re
            .dwSize = Len(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 = dwTypes.RASET_Broadband
            'CopyMemory(.szLocalPhoneNumber, sTelNumber, Marshal.SizeOf(sTelNumber))
            CopyMemory(.szDeviceName, sDevice, Len(sDevice))
            CopyMemory(.szDeviceType, sDeviceType, Len(sDeviceType))

            'CopyMemory(.szDeviceName, aa, Len(sDevice))
            'CopyMemory(.szDeviceType, bb, Len(sDeviceType))
        End With
        Dim rc As RASCREDENTIALS
        rc.Initialize()
        With rc
            .dwSize = Len(rc)
            .dwMask = 11
            CopyMemory(.szUserName, sUsername, Len(sUsername))
            CopyMemory(.szPassword, sPassword, Len(sPassword))
        End With
        Dim rtn As Long
        'If RasSetEntryProperties("", sEntryName, re, Marshal.SizeOf(re), 0, 0) = 0 Then
        If RasSetCredentials(vbNullString, sEntryName, rc, 0) = 0 Then
            Return True
        End If
        'End If



    End Function


#End Region