l2tp的相关资料

With re . dwSize = LenB ( re ) . dwCountryCode = 86 . dwCountryID = 86 . dwDialExtraPercent = 75 . dwDialExtraSampleSeconds = 120 . dwDialMode = 1 . dwfNetProtocols = 4 . dwfOptions = 1024262928 . dwfOptions2 = 367 - 256 ' PPTP为此 .dwFram

With re
  .dwSize =LenB(re).dwCountryCode =86.dwCountryID =86.dwDialExtraPercent =75.dwDialExtraSampleSeconds =120.dwDialMode =1.dwfNetProtocols =4.dwfOptions =1024262928.dwfOptions2 =367-256' PPTP为此值
  .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 =1'vpn类型 0 默认 1仅pptp 2先pptp 3仅l2tp 4先l2tp
  .dwEncryptionType = 1 '数据加密类型如果是pptp方式的话这句可以直接留空EndWithDim rc As RASCREDENTIALS
  With rc
     Mid(.szPassword,1,Len("xxxxxx"))="xxxxxx"'xxxxxx为密码
   .dwSize = 540
   .dwMask = 11 'PPTP此处设置值为11EndWith

上面是基本的PPTP连接方式的写法, 因为L2TP模式涉及到密钥方面, 所以一直很困惑

主要是在想RAS里面是否有一个特定的变量来存放密钥, 然后搜遍了谷歌百度CSDN, 始终不得其果

似乎没有人公开过L2TP的写法

最终看到某篇文章后顿时醒悟, 原来这个密钥并不是存放在一个单独的"变量"里!

其实写法很简单 下面贴出L2TP的写法核心代码:

With re
  .dwSize =LenB(re).dwCountryCode =86.dwCountryID =86.dwDialExtraPercent =75.dwDialExtraSampleSeconds =120.dwDialMode =1.dwfNetProtocols =4.dwfOptions =1024262928.dwfOptions2 =16' 查阅资料得出L2TP这里应该设置为16 具体原理不得而知
  .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 =3'vpn类型 首先这里设置为3 也就是默认L2TP方式连接
  .dwEncryptionType = 3 '数据加密类型设置为3也就是密钥加密EndWithDim rc As RASCREDENTIALS
  With rc
     Mid(.szPassword,1,Len("xxxxxx"))="xxxxxx"'xxxxxx为预共享密钥, 而在PPTP方式里本应设置密码处直接设置成L2TP的密钥
   .dwSize = 540
   .dwMask = 16 'L2TP此处设置值为16EndWith

以上写法创建出的L2TP方式的VPN可以完美连接, 注意在连接的时候用户密码就直接是密码了 而不是密钥了!!!

最后说一下怎么在win7中隐藏VPN链接, 其实只需要为VPN指定一个电话薄位置就行了~

RasDial函数第二个参数lpszPhonebook的值直接指定成电话薄的位置即可~ 如:"c:\1.xxx"

以上方法研究了很久, 网上关于RAS相关的信息也很少, MSDN介绍的也比较简单, 所以查询起来很模糊~ 此文就当是为准备写相关程序的黑客们提供一个方便拉 o(∩_∩)o ~

其他代码部分L2TP和PPTP写法都是一样的 网上都有源码 我只贴最核心的代码 完整代码可以参考下这个:

VB 创建VPN拨号连接(自动勾选且填充预共享密钥)

Dim I As Integer
Dim N As Long
Option Explicit
'拨号/断网
Private Declare Function InternetDial Lib "wininet.dll" (ByVal hwndParent As Long, ByVal lpszConnectoid As String, ByVal dwFlags As Long, lpdwConnection As Long, ByVal dwReserved As Long) As Long
Private Declare Function InternetHangUp Lib "wininet.dll" (ByVal dwConnection As Long, ByVal dwReserved As Long) As Long
Private Declare Function InternetAutodial Lib "wininet.dll" (ByVal dwFlags As Long, ByVal dwReserved As Long) As Long
Private Declare Function InternetAutodialHangup Lib "wininet.dll" (ByVal dwReserved As Long) As Long
Private Const INTERNET_DIALSTATE_DISCONNECTED = 1
Private Const INTERNET_AUTODIAL_FORCE_ONLINE = 1
Private Const INTERNET_AUTODIAL_FORCE_UNATTENDED = 2
Private Const INTERNET_DIAL_UNATTENDED = &H8000
Private Handle 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 As String * 257 'UNLEN+1
szPassword As String * 257 'PWLEN+1
szDomain As String * 16 'DNLEN+1
End Type

Public Enum RASCredMask
RASCM_UserName = &H1&
RASCM_password = &H2& '预共享密钥密码
RASCM_Domain = &H4&
RASCM_DefaultCreds = &H8&
RASCM_PreSharedKey = &H10& '预共享密钥属性
RASCM_ServerPreSharedKey = &H20&
RASCM_DDMPreSharedKey = &H40&
End Enum

Public Enum RasEntryOptions2
RASEO2_SecureFileAndPrint = &H1
RASEO2_SecureClientForMSNet = &H2
RASEO2_DontNegotiateMultilink = &H4
RASEO2_DontUseRasCredentials = &H8
RASEO2_UsePreSharedKey = &H10 '使用预共享的密钥作身份验证
RASEO2_Internet = &H20
RASEO2_DisableNbtOverIP = &H40
RASEO2_UseGlobalDeviceSettings = &H80
RASEO2_ReconnectIfDropped = &H100
RASEO2_SharePhoneNumbers = &H200
RASEO2_SecureRoutingCompartment = &H400
RASEO2_IPv6SpecificNameServer = &H800
RASEO2_IPv6RemoteDefaultGateway = &H1000
RASEO2_RegisterIpWithDNS = &H2000
RASEO2_UseDNSSuffixForRegistration = &H4000
RASEO2_IPv4ExplicitMetric = &H8000
RASEO2_IPv6ExplicitMetric = &H10000
RASEO2_DisableIKENameEkuCheck = &H20000
End Enum

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 Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
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 Command1_Click()
Dim sEntryName As String, sUsername As String, sPassword As String

Dim sServer As String
sEntryName = Text1.Text
sServer = Text2.Text
sUsername = Text3.Text
sPassword = Text4.Text
If Create_VPN_Connection(sEntryName, sServer, sUsername, sPassword) Then
MsgBox "VPN连接建立成功！"
Else
MsgBox "VPN连接建立失败！"
End If
End Sub

Function Create_VPN_Connection(ByVal sEntryName As String, ByVal sServer As String, ByVal sUsername As String, ByVal sPassword As String) As Boolean
Create_VPN_Connection = False
Dim re As RASENTRY
Dim sDeviceName As String, sDeviceType As String
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
.dwfOptions2 = RasEntryOptions2.RASEO2_UsePreSharedKey '将dwfOptions2的属性设置为RASEO2_UsePreSharedKey

.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_L2tpOnly 'vpn类型
.dwEncryptionType = ET_Require '数据加密类型
End With
Dim rc As RASCREDENTIALS
With rc
Mid(.szPassword, 1, Len("xxxxxx")) = "xxxxxx" 'xxxxxx为预共享密钥
.dwSize = 540
.dwMask = RASCredMask.RASCM_PreSharedKey
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_VPN_Connection = True
End If
End If

End Function




'拨号
Function DialUp(LinkName As String) As Boolean
InternetDial 0, LinkName, INTERNET_AUTODIAL_FORCE_UNATTENDED, Handle, 0
DialUp = (Handle <> 0)
End Function


Private Sub Command3_Click()
Unload Me
End Sub

Private Sub Form_Load()
Me.Timer1.Enabled = False
Text1.Text = "VPN连接"
Text2.Text = "111.111.111.111" '服务器地址
Text3.Text = "xxxxxx"
Text4.Text = "xxxxxx"
End Sub

参考文档：

http://www.vbmonster.com/Uwe/Forum.aspx/vb-networks/564/RasSetCredentials-VB6-Help

http://www.vbforums.com/archive/index.php/t-451832.html

Thanks Randy,Johno,RobDog888,Logophobic