|
|
- 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 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 Form_Load()
- Dim sEntryName As String, sUsername As String, sPassword As String
- sEntryName = "紫水晶编程论坛"
- sUsername = "用户名"
- 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
- Create_PPPoE_Connection = False
- Dim re As RASENTRY
- Dim sDeviceName As String, sDeviceType As String
- 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 = 5
- CopyMemory .szDeviceName(0), ByVal sDeviceName, Len(sDeviceName)
- CopyMemory .szDeviceType(0), ByVal sDeviceType, Len(sDeviceType)
- End With
- Dim rc As RASCREDENTIALS
- With rc
- .dwSize = LenB(rc)
- .dwMask = 11
- CopyMemory .szUserName(0), ByVal sUsername, Len(sUsername)
- CopyMemory .szPassword(0), ByVal sPassword, Len(sPassword)
- End With
- Dim rtn As Long
- 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
|
|
发表于 2007-7-21 14:19:39
发表于 2009-6-29 21:26:17
