请高手帮忙改一下下面代码出错在哪
Imports SystemImports System.Windows.Forms
Module link
Public hRasConn As Integer '定义一个指向RAS调用的全局句柄
Public Const APINULL As Integer = 0
Public Const UNLEN As Integer = 256
Public Const DNLEN As Integer = 15
Public Const PWLEN As Integer = 256
Public Const RAS95_MaxPhoneNumber As Integer = 128
Public Const RAS95_MaxEntryName As Integer = 256
Private Const RAS_MaxDeviceType As Integer = 16
Private Const RAS95_MaxDeviceName As Integer = 128
Public Const RAS95_MaxCallbackNumber As Integer = RAS95_MaxPhoneNumber
Public Structure RASCONN95
Dim dwSize As Integer
Dim hRasConn As Integer
<Microsoft.VisualBasic.VBFixedArray(RAS95_MaxEntryName)> _
Dim szEntryName() As Byte
<Microsoft.VisualBasic.VBFixedArray(RAS_MaxDeviceType)> _
Dim szDeviceType() As Byte
<Microsoft.VisualBasic.VBFixedArray(RAS95_MaxDeviceName)> _
Dim szDeviceName() As Byte
Public Shared Function CreateInstance() As RASCONN95
Dim result As New RASCONN95()
ReDim result.szEntryName(RAS95_MaxEntryName)
ReDim result.szDeviceType(RAS_MaxDeviceType)
ReDim result.szDeviceName(RAS95_MaxDeviceName)
Return result
End Function
End Structure
Public Structure RASENTRYNAME95
Dim dwSize As Integer
<Microsoft.VisualBasic.VBFixedArray(RAS95_MaxEntryName)> _
Dim szEntryName() As Byte
Public Shared Function CreateInstance() As RASENTRYNAME95
Dim result As New RASENTRYNAME95()
ReDim result.szEntryName(RAS95_MaxEntryName)
Return result
End Function
End Structure
Public Structure RASDIALPARAMS95
Dim dwSize As Integer
<Microsoft.VisualBasic.VBFixedArray(RAS95_MaxEntryName)> _
Dim szEntryName() As Byte
<Microsoft.VisualBasic.VBFixedArray(RAS95_MaxPhoneNumber)> _
Dim szPhoneNumber() As Byte
<Microsoft.VisualBasic.VBFixedArray(RAS95_MaxCallbackNumber)> _
Dim szCallbackNumber() As Byte
<Microsoft.VisualBasic.VBFixedArray(UNLEN)> _
Dim szUserName() As Byte
<Microsoft.VisualBasic.VBFixedArray(PWLEN)> _
Dim szPassword() As Byte
<Microsoft.VisualBasic.VBFixedArray(DNLEN)> _
Dim szDomain() As Byte
Public Shared Function CreateInstance() As RASDIALPARAMS95
Dim result As New RASDIALPARAMS95()
ReDim result.szEntryName(RAS95_MaxEntryName)
ReDim result.szPhoneNumber(RAS95_MaxPhoneNumber)
ReDim result.szCallbackNumber(RAS95_MaxCallbackNumber)
ReDim result.szUserName(UNLEN)
ReDim result.szPassword(PWLEN)
ReDim result.szDomain(DNLEN)
Return result
End Function
End Structure
'**********************************
'* RAS调用错误代号 *
'**********************************
Public Const NOT_SUPPORTED As Integer = 120
Public Const RASBASEERROR As Integer = 600
Public Const SUCCESS As Integer = 0
Public Const ERROR_PORT_ALREADY_OPEN As Integer = (RASBASEERROR + 2)
Public Const ERROR_UNKNOWN As Integer = (RASBASEERROR + 35)
Public Const ERROR_REQUEST_TIMEOUT As Integer = (RASBASEERROR + 38)
Public Const ERROR_PASSWD_EXPIRED As Integer = (RASBASEERROR + 48)
Public Const ERROR_NO_DIALIN_PERMISSION As Integer = (RASBASEERROR + 49)
Public Const ERROR_SERVER_NOT_RESPONDING As Integer = (RASBASEERROR + 50)
Public Const ERROR_UNRECOGNIZED_RESPONSE As Integer = (RASBASEERROR + 52)
Public Const ERROR_NO_RESPONSES As Integer = (RASBASEERROR + 60)
Public Const ERROR_DEVICE_NOT_READY As Integer = (RASBASEERROR + 66)
Public Const ERROR_LINE_BUSY As Integer = (RASBASEERROR + 76)
Public Const ERROR_NO_ANSWER As Integer = (RASBASEERROR + 78)
Public Const ERROR_NO_CARRIER As Integer = (RASBASEERROR + 79)
Public Const ERROR_NO_DIALTONE As Integer = (RASBASEERROR + 80)
Public Const ERROR_AUTHENTICATION_FAILURE As Integer = (RASBASEERROR + 91)
Public Const ERROR_PPP_TIMEOUT As Integer = (RASBASEERROR + 118)
'**********************************
'* RAS连接状态声明 *
'**********************************
Public Enum RasConnState
RASCS_OpenPort = 0
RASCS_PortOpened '1
RASCS_ConnectDevice '2
RASCS_DeviceConnected '3
RASCS_AllDevicesConnected '4
RASCS_Authenticate '5
RASCS_AuthNotify '6
RASCS_AuthRetry '7
RASCS_AuthCallback '8
RASCS_AuthChangePassword '9
RASCS_AuthProject '10
RASCS_AuthLinkSpeed '11
RASCS_AuthAck '12
RASCS_ReAuthenticate '13
RASCS_Authenticated '14
RASCS_PrepareForCallback '15
RASCS_WaitForModemReset '16
RASCS_WaitForCallback '17
RASCS_Projected '18
RASCS_StartAuthentication '19
RASCS_CallbackComplete '20
RASCS_LogonNetwork '21
RASCS_Interactive = &H1000 '4096
RASCS_RetryAuthentication '4097
RASCS_CallbackSetByCaller '4098
RASCS_PasswordExpired '4099
RASCS_Connected = &H2000 '8192
RASCS_Disconnected '8193
End Enum
'**********************************
'* RAS API 声明 *
'**********************************
Public Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (ByVal lpString1 As Integer, ByVal lpString2 As String) As Integer
Public Declare Function RasDial Lib "rasapi32.dll" Alias "RasDialA" (ByRef lpRasDialExtensions As Integer, ByVal lpszPhonebook As String, ByRef lprasdialparams As RASDIALPARAMS95, ByVal dwNotifierType As Integer, ByVal lpvNotifier As Integer, ByRef lphRasConn As Integer) As Integer
Public Declare Function RasEnumConnections Lib "rasapi32.dll" Alias "RasEnumConnectionsA" (ByVal lprasconn As Integer, ByRef lpcb As Integer, ByRef lpcConnections As Integer) As Integer
Public Declare Function RasEnumEntries Lib "rasapi32.dll" Alias "RasEnumEntriesA" (ByVal reserved As String, ByVal lpszPhonebook As String, ByVal lprasentryname As Integer, ByRef lpcb As Integer, ByRef lpcEntries As Integer) As Integer
Public Declare Function RasHangUp Lib "rasapi32.dll" Alias "RasHangUpA" (ByVal hRasConn As Integer) As Integer
'Sleep
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Integer)
Public Function AddConnection(ByVal strNewEntryName As String, ByVal strNewPhoneNumber As String, ByVal strNewCallbackNumber As String, ByVal strNewUsername As String, ByVal strNewPassword As String, ByVal strNewDomain As String) As Integer
Dim lngRetCode, lngRetHangUp As Integer
Dim lprasdialparams As RASDIALPARAMS95 = RASDIALPARAMS95.CreateInstance()
lprasdialparams.dwSize = 1052
Dim lngRetLstrcpy As Integer
lngRetLstrcpy = lstrcpy(lprasdialparams.szEntryName(0), strNewEntryName)
lngRetLstrcpy = lstrcpy(lprasdialparams.szPhoneNumber(0), strNewPhoneNumber)
lngRetLstrcpy = lstrcpy(lprasdialparams.szCallbackNumber(0), strNewCallbackNumber)
lngRetLstrcpy = lstrcpy(lprasdialparams.szUserName(0), strNewUsername)
lngRetLstrcpy = lstrcpy(lprasdialparams.szPassword(0), strNewPassword)
lngRetLstrcpy = lstrcpy(lprasdialparams.szDomain(0), strNewDomain)
Cursor.Current = Cursors.WaitCursor '改变鼠标样式
hRasConn = 0
Application.DoEvents()
'若使用以下CallBack function的方式，则RasDial()不等连线成功或失败便结束。
lngRetCode = RasDial(APINULL, Nothing, lprasdialparams, 0, AddressOf RasDialFunc(), hRasConn) '异步通信
'若第二、三个叁数都是0则，RasDial会等连线成功或失败後才执行下一行指令
' lngRetCode = RasDial(APINULL, vbNullString, lprasdialparams, APINULL, APINULL, hRasConn)
Application.DoEvents()
Cursor.Current = Cursors.Default '改变鼠标样式
'测试有没有错误
If lngRetCode Then
lngRetHangUp = RasHangUp(hRasConn)
End If
Return lngRetCode
End Function
Public Sub RemoveConnection()
Dim RasConn, ln, Ret As Integer
Dim a As String = ""
Dim R(255) As RASCONN95
R(0).dwSize = 412
Dim s As Integer = 256 * R(0).dwSize
Dim L As Integer = RasEnumConnections(Convert.ToInt32(R(0)), s, ln)
For L = 0 To ln - 1
a$ = BitConverter.ToString(R(L).szEntryName)
a$ = Strings.Left(a, a.IndexOf(Strings.Chr(0).ToString()))
RasConn = R(L).hRasConn
'这里将挂断连接
Ret = RasHangUp(RasConn)
Sleep(2000)
Next
End Sub
Public Function IsConnectionByName(ByVal strEntryName As String) As Boolean
'判断某名称的连接是否已经存在
Dim result As Boolean = False
Dim lpcConnections As Integer
Dim intArraySize As Integer
Dim bFind As Boolean
Dim bszEntryName(RAS95_MaxEntryName) As Byte
Dim lprasconn95(intArraySize) As RASCONN95
lprasconn95(0).dwSize = 412
Dim lpcb As Integer = 256 * lprasconn95(0).dwSize
Dim lngRetCode As Integer = RasEnumConnections(Convert.ToInt32(lprasconn95(0)), lpcb, lpcConnections)
lstrcpy(bszEntryName(0), strEntryName)
If lngRetCode = 0 Then
If lpcConnections > 0 Then
For intLooper As Integer = 0 To lpcConnections - 1
bFind = True
For i As Integer = 0 To RAS95_MaxEntryName
If lprasconn95(intLooper).szEntryName(i) <> bszEntryName(i) Then
bFind = False
Exit For
End If
Next
If bFind Then
result = True
Exit For
End If
Next
End If
End If
Return result
End Function
Public Sub RasDialFunc(ByRef unMsg As Integer, ByRef ConnState As Integer, ByRef dwError As Integer)
Select Case ConnState
Case RasConnState.RASCS_OpenPort
Form1.Label8.Text = "正在打开端口......"
Case RasConnState.RASCS_PortOpened
Form1.Label8.Text = "端口已打开。"
Case RasConnState.RASCS_ConnectDevice
Form1.Label8.Text = "正在连接设备......"
Case RasConnState.RASCS_DeviceConnected
Form1.Label8.Text = "设备已连接。"
Case RasConnState.RASCS_AllDevicesConnected
Form1.Label8.Text = "所有设备均已连接。"
Case RasConnState.RASCS_Authenticate
Form1.Label8.Text = "验证用户名及密码......"
Case RasConnState.RASCS_AuthNotify
Form1.Label8.Text = "验证通告......"
Case RasConnState.RASCS_AuthRetry
Form1.Label8.Text = "验证重试......"
Case RasConnState.RASCS_AuthCallback
Form1.Label8.Text = "验证回叫......"
Case RasConnState.RASCS_AuthChangePassword
Form1.Label8.Text = "RASCS_AuthChangePassword"
Case RasConnState.RASCS_AuthProject
Form1.Label8.Text = "验证项目......"
Case RasConnState.RASCS_AuthLinkSpeed
Form1.Label8.Text = "验证连接速度......"
Case RasConnState.RASCS_AuthAck
Form1.Label8.Text = "验证请求......"
Case RasConnState.RASCS_ReAuthenticate
Form1.Label8.Text = "重新验证......"
Case RasConnState.RASCS_Authenticated
Form1.Label8.Text = "验证完成！"
Case RasConnState.RASCS_PrepareForCallback
Form1.Label8.Text = "准备回叫"
Case RasConnState.RASCS_WaitForModemReset
Form1.Label8.Text = "等待调制解调器复位......"
Case RasConnState.RASCS_WaitForCallback
Form1.Label8.Text = "等待回叫......"
Case RasConnState.RASCS_Projected
Form1.Label8.Text = "RASCS_Projected"
Case RasConnState.RASCS_StartAuthentication
Form1.Label8.Text = "开始鉴定......"
Case RasConnState.RASCS_CallbackComplete
Form1.Label8.Text = "回叫完成！"
Case RasConnState.RASCS_LogonNetwork
Form1.Label8.Text = "正在登录网络......"
Case RasConnState.RASCS_Interactive
Form1.Label8.Text = "连接已经成功！"
Case RasConnState.RASCS_RetryAuthentication
Form1.Label8.Text = "重新鉴定......"
Case RasConnState.RASCS_CallbackSetByCaller
Form1.Label8.Text = "设置回叫......"
Case RasConnState.RASCS_PasswordExpired
Form1.Label8.Text = "口令错误！"
Case RasConnState.RASCS_Connected
Form1.Label8.Text = "连接成功！"
Form1.Button1.Enabled = False
Form1.Button2.Enabled = True
Case RasConnState.RASCS_Disconnected
Form1.Label8.Text = "连接已断开！"
End Select
Select Case dwError
Case 605
Form1.Label8.Text = CStr(dwError) & "错误:无法设置端口信息。"
Case 606
Form1.Label8.Text = CStr(dwError) & "错误:无法连接端口。"
Case 617
Form1.Label8.Text = CStr(dwError) & "错误:端口或设备已断开连接。"
Case 618
Form1.Label8.Text = CStr(dwError) & "错误:端口尚未打开。"
Case 619, 628
Form1.Label8.Text = CStr(dwError) & "错误:端口已断开连接。"
Case 621, 622, 623, 624, 625
Form1.Label8.Text = CStr(dwError) & "错误:不存在的连接！"
Case 629
Form1.Label8.Text = CStr(dwError) & "错误:端口已由远程机器断开连接。"
Case 633, 651, 734
Form1.Label8.Text = CStr(dwError) & "错误:调制解调器（其他设备）已在使用。"
Case 634
Form1.Label8.Text = CStr(dwError) & "错误:无法在远程网络上注册您的计算机。"
Case 642
Form1.Label8.Text = CStr(dwError) & "错误:您的一个 NetBIOS 名称已在远程网络上注册。"
Case 646
Form1.Label8.Text = CStr(dwError) & "错误:不允许本帐户在此时间登录。"
Case 647
Form1.Label8.Text = CStr(dwError) & "错误:帐户已禁用。"
Case 648
Form1.Label8.Text = CStr(dwError) & "错误:该帐户的密码已过期。"
Case 649
Form1.Label8.Text = CStr(dwError) & "错误:帐户没有远程访问权限。"
Case 676
Form1.Label8.Text = CStr(dwError) & "错误:线路忙。"
Case 678, 809
Form1.Label8.Text = CStr(dwError) & "错误:远程计算机没有响应或者连接被远程计算机终止。"
Case 691
Form1.Label8.Text = CStr(dwError) & "错误:用户名和/或密码无效而拒绝访问或电信VPDN到期,请续费!"
Case 708
Form1.Label8.Text = CStr(dwError) & "错误:帐户已过期。"
Case 709
Form1.Label8.Text = CStr(dwError) & "错误:在域上更改密码时出错。"
Case 734
Form1.Label8.Text = CStr(dwError) & "错误:PPP协议控制终止。"
Case 741
Form1.Label8.Text = CStr(dwError) & "错误:核对属性设置是否正确。"
Case 720
Form1.Label8.Text = CStr(dwError) & "错误:不能建立到远程计算机的连接。您可能需要更改些连接的网络设置。"
Case 768
Form1.Label8.Text = CStr(dwError) & "错误:因为错误的加密数据造成连接请求失败。"
Case 769
Form1.Label8.Text = CStr(dwError) & "错误:服务器IP出错。"
Case 770
Form1.Label8.Text = CStr(dwError) & "错误:远程设备拒绝连接请求。"
Case 771
Form1.Label8.Text = CStr(dwError) & "错误:因为网络忙造成连接请求失败。"
Case 756
Form1.Label8.Text = CStr(dwError) & "错误:拔号连接正在进行。"
Case 774
Form1.Label8.Text = CStr(dwError) & "错误:因为临时性错误导致连接请求失败。请再试着连接。"
Case 775
Form1.Label8.Text = CStr(dwError) & "错误:连接被远程服务器阻止。"
Case 781, 789
Form1.Label8.Text = CStr(dwError) & "错误:L2TP连接尝试失败,请运行基本设置下的注册表修改,然后重启电脑!"
Case Else
If dwError <> 0 Then Form1.Label8.Text = CStr(dwError) & "没有更详细的错误信息,拨号失败,重拨!"
End Select
End Sub
End Module
