ras.vb

清华大学出版社出版的 移动应用开发宝典 张大威（2008）的附书源代码

Imports System.Runtime.InteropServices
Imports System.ComponentModel

Public Class RasConnection

    Private handle As IntPtr
    Private m_name As String

    Friend Sub New(ByVal handle As IntPtr, ByVal name As String)
        Me.handle = handle
        Me.m_name = name
    End Sub

    Public Sub HangUp()
        If (Me.handle <> IntPtr.Zero) Then
            Dim result As Integer = RasConnection.RasHangUp(Me.handle)
            Me.handle = IntPtr.Zero
        End If
    End Sub

    <DllImport("coredll", SetLastError:=True)> _
    Private Shared Function RasHangUp(ByVal Session As IntPtr) As Integer
    End Function

    Public Overrides Function ToString() As String
        If Not String.IsNullOrEmpty(Me.m_name) Then
            Return Me.m_name
        End If
        Return Me.handle.ToInt32.ToString("X")
    End Function

    Public ReadOnly Property Name() As String
        Get
            Return Me.m_name
        End Get
    End Property

End Class


Public Class Ras

    Public Shared Sub DeleteEntry(ByVal entry As String)
        Dim result As Integer = Ras.RasDeleteEntry(Nothing, entry)
    End Sub

    Public Shared Function Dial(ByVal name As String, ByVal username As String, ByVal password As String, ByVal domain As String) As RasConnection
        Dim handle As IntPtr
        Dim rdp As New RASDIALPARAMS
        rdp.dwSize = Marshal.SizeOf(rdp)
        rdp.szEntryName = name
        rdp.szDomain = "*"
        rdp.szUserName = username
        rdp.szPassword = password
        rdp.szDomain = domain
        Dim result As Integer = Ras.RasDial(IntPtr.Zero, Nothing, (rdp), 0, IntPtr.Zero, handle)
        If (result <> 0) Then
            Throw New Win32Exception(result, "Error establishing connection")
        End If
        Return New RasConnection(handle, name)
    End Function

    <DllImport("coredll", SetLastError:=True)> _
    Friend Shared Function RasDeleteEntry(ByVal lpszPhonebook As String, ByVal lpszEntry As String) As Integer
    End Function

    <DllImport("coredll", SetLastError:=True)> _
    Private Shared Function RasDial(ByVal dialExtensions As IntPtr, ByVal phoneBookPath As String, ByRef rasDialParam As RASDIALPARAMS, ByVal NotifierType As Integer, ByVal notifier As IntPtr, <Out()> ByRef pRasConn As IntPtr) As Integer
    End Function

    <DllImport("coredll", SetLastError:=True)> _
    Friend Shared Function RasEnumConnections(ByVal lprasconn As IntPtr, ByRef lpcb As Integer, <Out()> ByRef lpcConnections As Integer) As Integer
    End Function

    <DllImport("coredll", SetLastError:=True)> _
    Friend Shared Function RasEnumDevices(ByVal lpRasDevinfo As IntPtr, ByRef lpcb As Integer, <Out()> ByRef lpcDevices As Integer) As Integer
    End Function

    <DllImport("coredll", SetLastError:=True)> _
    Friend Shared Function RasEnumEntries(ByVal Reserved As String, ByVal lpszPhoneBookPath As String, ByVal lprasentryname As IntPtr, ByRef lpcb As Integer, <Out()> ByRef lpcEntries As Integer) As Integer
    End Function


    Public Shared ReadOnly Property Connections() As RasConnection()
        Get
            Dim cConnections As Integer
            Dim len As Integer = (20 * Marshal.SizeOf(GetType(RASCONN)))
            Dim ptr As IntPtr = Marshal.AllocHGlobal(len)
            Marshal.WriteInt32(ptr, Marshal.SizeOf(GetType(RASCONN)))
            Dim result As Integer = Ras.RasEnumConnections(ptr, (len), cConnections)
            Dim rc As RasConnection() = New RasConnection(cConnections - 1) {}
            Dim thisConnection As Integer = 0
            Do While (thisConnection < cConnections)
                Dim c As RASCONN = DirectCast(Marshal.PtrToStructure(New IntPtr((ptr.ToInt32 + (Marshal.SizeOf(GetType(RASCONN)) * thisConnection))), GetType(RASCONN)), RASCONN)
                rc(thisConnection) = New RasConnection(c.hrasconn, c.szEntryName)
                thisConnection += 1
            Loop
            Marshal.FreeHGlobal(ptr)
            Return rc
        End Get
    End Property

    Public Shared ReadOnly Property Devices() As RasDevice()
        Get
            Dim count As Integer
            Dim len As Integer = (20 * Marshal.SizeOf(GetType(RASDEVINFO)))
            Dim ptr As IntPtr = Marshal.AllocHGlobal(len)
            Marshal.WriteInt32(ptr, Marshal.SizeOf(GetType(RASDEVINFO)))
            Dim result As Integer = Ras.RasEnumDevices(ptr, (len), count)
            Dim devs As RasDevice() = New RasDevice(count - 1) {}
            Dim i As Integer = 0
            Do While (i < count)
                Dim rdi As RASDEVINFO = DirectCast(Marshal.PtrToStructure(New IntPtr((ptr.ToInt32 + (i * Marshal.SizeOf(GetType(RASDEVINFO))))), GetType(RASDEVINFO)), RASDEVINFO)
                devs(i) = New RasDevice(rdi.szDeviceType, rdi.szDeviceName)
                i += 1
            Loop
            Marshal.FreeHGlobal(ptr)
            Return devs
        End Get
    End Property

    Public Shared ReadOnly Property Entries() As String()
        Get
            Dim cEntries As Integer = 0
            Dim len As Integer = Marshal.SizeOf(GetType(RASENTRYNAME))
            Dim ptr As IntPtr = Marshal.AllocHGlobal(len)
            Marshal.WriteInt32(ptr, len)
            Dim result As Integer = Ras.RasEnumEntries(Nothing, Nothing, ptr, len, cEntries)
            If result = &H25B Then
                ptr = Marshal.ReAllocHGlobal(ptr, New IntPtr(len))
                Marshal.WriteInt32(ptr, Marshal.SizeOf(GetType(RASENTRYNAME)))
                result = Ras.RasEnumEntries(Nothing, Nothing, ptr, len, cEntries)
            End If

            Dim names As String() = New String(cEntries - 1) {}
            Dim iEntry As Integer = 0
            Do While (iEntry < cEntries)
                Dim p As IntPtr = New IntPtr((ptr.ToInt32 + (Marshal.SizeOf(GetType(RASENTRYNAME)) * iEntry)))
                Dim ren As RASENTRYNAME = DirectCast(Marshal.PtrToStructure(p, GetType(RASENTRYNAME)), RASENTRYNAME)
                names(iEntry) = ren.szEntryName
                iEntry += 1
            Loop
            Marshal.FreeHGlobal(ptr)
            Return names
        End Get
    End Property

    <StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Unicode)> _
    Friend Structure RASCONN

        Public dwSize As Integer
        Public hrasconn As IntPtr
        <MarshalAs(UnmanagedType.ByValTStr, SizeConst:=&H15)> _
        Public szEntryName As String

    End Structure

    <StructLayout(LayoutKind.Sequential)> _
    Friend Structure RASDEVINFO

        Public dwSize As Integer
        <MarshalAs(UnmanagedType.ByValTStr, SizeConst:=&H11)> _
        Public szDeviceType As String
        <MarshalAs(UnmanagedType.ByValTStr, SizeConst:=&H81)> _
        Public szDeviceName As String

    End Structure

    <StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Unicode)> _
    Friend Structure RASDIALPARAMS

        Public dwSize As Integer
        <MarshalAs(UnmanagedType.ByValTStr, SizeConst:=&H15)> _
        Public szEntryName As String
        <MarshalAs(UnmanagedType.ByValTStr, SizeConst:=&H81)> _
        Public szPhoneNumber As String
        <MarshalAs(UnmanagedType.ByValTStr, SizeConst:=&H31)> _
        Public szCallbackNumber As String
        <MarshalAs(UnmanagedType.ByValTStr, SizeConst:=&H101)> _
        Public szUserName As String
        <MarshalAs(UnmanagedType.ByValTStr, SizeConst:=&H101)> _
        Public szPassword As String
        <MarshalAs(UnmanagedType.ByValTStr, SizeConst:=&H10)> _
        Public szDomain As String

    End Structure

    <StructLayout(LayoutKind.Sequential)> _
    Friend Structure RASENTRYNAME
        Public dwSize As Integer
        <MarshalAs(UnmanagedType.ByValTStr, SizeConst:=&H15)> _
        Public szEntryName As String
    End Structure
End Class

Public Class RasDevice

    Private name As String
    Private type As String

    Friend Sub New(ByVal deviceType As String, ByVal deviceName As String)
        Me.type = deviceType
        Me.name = deviceName
    End Sub

    Public ReadOnly Property DeviceName() As String
        Get
            Return Me.name
        End Get
    End Property

    Public ReadOnly Property DeviceType() As String
        Get
            Return Me.type
        End Get
    End Property

End Class