首页 诗词 字典 板报 句子 名言 友答 励志 学校 网站地图
当前位置: 首页 > 教程频道 > 开发语言 > VB >

关于创建VPN时参数的有关问题

2012-02-29 
关于创建VPN时参数的问题我在网上找到了这个 vb 6.0 写的 创建 VPN 连接的代码,我现在用这个代码可以成功

关于创建VPN时参数的问题
我在网上找到了这个 vb 6.0 写的 创建 VPN 连接的代码,我现在用这个代码可以成功创建 VPN连接,但是里面的参数不会设置。
我想取消 在远程连接上使用默认网关 ,但每次创建默认都是选中的,请问各位高手应该怎么做啊?
 下面是我在网上找到的代码,代码是可以用的,请高手帮我看一下:
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 RASNP_NetBEUI As Long = &H1
Private Const RASNP_Ip As Long = &H4
Private Const RASNP_Ipx As Long = &H2

Private Const RASFP_Ppp As Long = &H1
Private Const RASFP_Slip As Long = &H2
Private Const RASFP_Ras As Long = &H4


Private Const RASET_Phone As Long = 1
Private Const RASET_Vpn As Long = 2
Private Const RASET_Direct As Long = 3
Private Const RASET_Internet As Long = 4

Private Const RASEDM_DialAll As Long = 1
Private Const RASEDM_DialAsNeeded As Long = 2

Private Const RASEO_Custom As Long = &H100000
Private Const RASEO_CustomScript As Long = &H80000000
Private Const RASEO_DisableLcpExtensions As Long = &H20 '是否决定在PPP里不使用LCP,一般不使用这个选项
Private Const RASEO_IpHeaderCompression As Long = &H8 '是否选用IP头指针压缩
Private Const RASEO_ModemLights As Long = &H100 '此选项只对WIN2K有效,选用后在任务栏出现一个状态监测器
Private Const RASEO_NetworkLogon As Long = &H2000 '此选项对NT/2K没有影响,是否选用登陆网络
Private Const RASEO_PreviewDomain As Long = &H2000000
Private Const RASEO_PreviewPhoneNumber As Long = &H200000
Private Const RASEO_PreviewUserPw As Long = &H1000000


Private Const RASEO_PromoteAlternates As Long = &H8000 '是否选用交替号码
Private Const RASEO_RemoteDefaultGateway As Long = &H10 '是否选用远程网上默认网关
Private Const RASEO_RequireCHAP As Long = &H8000000
Private Const RASEO_RequireDataEncryption As Long = &H1000 '是否选用需要数据加密
Private Const RASEO_RequireEAP As Long = &H20000
Private Const RASEO_RequireEncryptedPw As Long = &H400 '是否选用需要加密的密码<作用是PPP使用PAP明文>
Private Const RASEO_RequireMsCHAP As Long = &H10000000
Private Const RASEO_RequireMsCHAP2 As Long = &H20000000
Private Const RASEO_RequireMsEncryptedPw As Long = &H800 '是否选用需要微软加密的密码
Private Const RASEO_RequirePAP As Long = &H40000
Private Const RASEO_RequireSPAP As Long = &H80000
Private Const RASEO_RequireW95MSCHAP As Long = &H40000000
Private Const RASEO_SecureLocalFiles As Long = &H10000
Private Const RASEO_SharedPhoneNumbers As Long = &H800000
Private Const RASEO_ShowDialingProgress As Long = &H4000000
Private Const RASEO_SpecificIpAddr As Long = &H2 '服务类型->TCP/IP设置->是否指定IP地址项
Private Const RASEO_SpecificNameServers As Long = &H4 '设置DNS是否选用
Private Const RASEO_SwCompression As Long = &H200 '是否选用软件压缩<服务器类型->高级选项
Private Const RASEO_TerminalAfterDial As Long = &H80 '是否拨号后出现终端窗口<常规->连接方式->设置->选项->连接控制
Private Const RASEO_TerminalBeforeDial As Long = &H40
Private Const RASEO_UseCountryAndAreaCodes As Long = &H1 '是否使用区号与拨号属性
Private Const RASEO_UseLogonCredentials As Long = &H4000 '是否当前用户采用用户名、密码、域等信息进行拨号连接


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

Function Create_PPPoE_Connection(ByVal sDeviceType As String, ByVal sEntryName As String, ByVal sUsername As String, ByVal sPassword As String, ByVal IP As String) As Boolean
  Create_PPPoE_Connection = False

  Dim re As RASENTRY
  Dim sDeviceName As String ', sDeviceType As String
  sDeviceName = "WAN 微型端口 (PPTP)"
 
  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 '3 直连4 管理5 宽带7 普通
  CopyMemory .szLocalPhoneNumber(0), ByVal IP, Len(IP)
  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


[解决办法]
楼主找到的代码不完整,缺少了下面这段。
一看就知道作者是那个喜欢YY的家伙。

VB code
Private Sub Command1_Click()    Dim sEntryName As String, sUsername As String, sPassword As String    sEntryName = "VPN"    sUsername = "super"    sPassword = "greenbean"    If Create_PPPoE_Connection("VPN", sEntryName, sUsername, sPassword) Then        MsgBox "连接建立成功!"    Else        MsgBox "连接建立失败!"    End IfEnd Sub 

热点排行