请教如何实现PPPe拨号

Option Explicit

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 Type

Private Type RASIPADDR
    a As Byte
    b As Byte
    c As Byte
    d As Byte
End Type

Private 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 Type

Private Type RASCREDENTIALS
    dwSize As Long
    dwMask As Long
    szUserName(256) As Byte
    szPassword(256) As Byte
    szDomain(15) As Byte
End Type

Private Const ET_None As Long = 0 ' No encryption
Private Const ET_Require As Long = 1 ' Require Encryption
Private Const ET_RequireMax As Long = 2 ' Require max encryption
Private Const ET_Optional As Long = 3 ' Do encryption if possible. None Ok.
Private Const VS_Default As Long = 0 ' default (PPTP for now)
Private Const VS_PptpOnly As Long = 1 ' Only PPTP is attempted.
Private Const VS_PptpFirst As Long = 2 ' PPTP is tried first.
Private Const VS_L2tpOnly As Long = 3 ' Only L2TP is attempted.
Private Const VS_L2tpFirst As Long = 4 ' L2TP is tried first.
Private Const RASET_Phone As Long = 1 ' Phone lines: modem, ISDN, X.25, etc
Private Const RASET_Vpn As Long = 2 ' Virtual private network
Private Const RASET_Direct As Long = 3 ' Direct connect: serial, parallel
Private Const RASET_Internet As Long = 4 ' BaseCamp internet
Private Const RASET_Broadband As Long = 5 ' Broadband
Private 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 Long


Private Sub Command2_Click()
    Dim sEntryName As String, sUsername As String, sPassword As String
    '创建PPPoE
    sEntryName = "宽带连接 "
    sUsername = "wza.******"
    sPassword = "*******"
    If Create_PPPoE_Connection(sEntryName, sUsername, sPassword) Then
        MsgBox "连接建立成功！ "
    Else
        MsgBox "连接建立失败！ "
    End If
End Sub

Function Create_PPPoE_Connection(ByVal sEntryName As String, ByVal sUsername As String, ByVal sPassword As String) As Boolean
    Dim rtn As Long
    Dim re As RASENTRY
    Dim sDeviceName As String, sDeviceType As String
    Dim rc As RASCREDENTIALS
    Create_PPPoE_Connection = False
    sDeviceName = "WAN 微型端口 (PPPOE) "
    sDeviceType = "PPPoE"
    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 = RASET_Broadband
        CopyMemory .szDeviceName(0), ByVal sDeviceName, Len(sDeviceName)
        CopyMemory .szDeviceType(0), ByVal sDeviceType, Len(sDeviceType)
    End With
    
    With rc
        .dwSize = LenB(rc)
        .dwMask = 11
        CopyMemory .szUserName(0), ByVal sUsername, Len(sUsername)
        CopyMemory .szPassword(0), ByVal sPassword, Len(sPassword)
    End With
    
    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

              
Function Create_VPN_Connection(ByVal sEntryName As String, ByVal sServer As String, ByVal sUsername As String, ByVal sPassword As String) As Boolean
    Dim re As RASENTRY
    Dim rc As RASCREDENTIALS
    Dim rtn As Long
    Dim sDeviceName As String, sDeviceType As String
    Create_VPN_Connection = False
    
    sDeviceName = "WAN 微型端口 (L2TP) "
    sDeviceType = "vpn"
    With re
        .dwSize = LenB(re)
        .dwCountryCode = 86
        .dwCountryID = 86
        .dwDialExtraPercent = 75
        .dwDialExtraSampleSeconds = 120
        .dwDialMode = 1
        .dwfNetProtocols = 4
        .dwfOptions = 1024262928
        .dwfOptions2 = 367
        .dwFramingProtocol = 1
        .dwHangUpExtraPercent = 10
        .dwHangUpExtraSampleSeconds = 120
        .dwRedialCount = 3
        .dwRedialPause = 60
        .dwType = RASET_Vpn
        CopyMemory .szDeviceName(0), ByVal sDeviceName, Len(sDeviceName)
        CopyMemory .szDeviceType(0), ByVal sDeviceType, Len(sDeviceType)
        CopyMemory .szLocalPhoneNumber(0), ByVal sServer, Len(sServer) '服务器地址
        .dwVpnStrategy = VS_Default 'vpn类型
        .dwEncryptionType = ET_Optional '数据加密类型
    End With
    
    With rc
        .dwSize = LenB(rc)
        .dwMask = 11
        CopyMemory .szUserName(0), ByVal sUsername, Len(sUsername)
        CopyMemory .szPassword(0), ByVal sPassword, Len(sPassword)
    End With
    
    If RasSetEntryProperties(vbNullString, sEntryName, re, LenB(re), 0, 0) = 0 Then
        If RasSetCredentials(vbNullString, sEntryName, rc, 0) = 0 Then
            Create_VPN_Connection = True
        End If
    End If
End Function


Private Sub Command1_Click()
    Dim sEntryName As String, sUsername As String, sPassword As String
    '创建VPN
    Dim sServer As String
    sServer = "10.130.7.250 "
    sEntryName = "VPN连接 "
    sUsername = "*******"
    sPassword = "*******"
    If Create_VPN_Connection(sEntryName, sServer, sUsername, sPassword) Then
        MsgBox "连接建立成功！ "
    Else
        MsgBox "连接建立失败！ "
    End If
End Sub