请教如何实现PPPe拨号

请教高手如何编一个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

这是创建连接的我要的是拨号的
要如何判断拨号状态我记得用vc写了一个API接口程序，包含你说的功能，你可以下来用用看
http://download.csdn.net/detail/SupermanKing/3168818

补充：VB ,  网络编程