| 网站首页 | 业界新闻 | 群组 | 交易 | 人才 | 下载频道 | 博客 | 代码贴 | 编程论坛
共有 3258 人关注过本帖
标题:请高手帮忙改一下下面代码出错在哪
只看楼主 加入收藏
rogersgb
Rank: 1
等 级:新手上路
帖 子:68
专家分:0
注 册:2016-2-3
结帖率:47.37%
  已结贴   问题点数:20  回复次数:8   
请高手帮忙改一下下面代码出错在哪
Imports System
Imports 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
2016-05-24 12:40
xiangyue0510
Rank: 14Rank: 14Rank: 14Rank: 14
等 级:贵宾
威 望:86
帖 子:908
专家分:5237
注 册:2015-8-10
  得分:10 
哪有你这样提问题的,代码噼里啪啦全部贴上来,也不说哪个地方报错。
别人也不清楚你窗口都什么控件,所以不可能重新用你的代码测试一遍。
给你一个建议,首先定位报错在哪个Sub或者Function中错误,然后用Catch来处理。Catch很简单,你百度一下吧
2016-05-24 12:57
rogersgb
Rank: 1
等 级:新手上路
帖 子:68
专家分:0
注 册:2016-2-3
  得分:0 
回复 2楼 xiangyue0510
        lngRetCode = RasDial(APINULL, Nothing, lprasdialparams, 0, AddressOf RasDialFunc(), hRasConn) '异步通信
 AddressOf RasDialFunc()报错
没有为    Public Sub RasDialFunc(ByRef unMsg As Integer, ByRef ConnState As Integer, ByRef dwError As Integer)
指定实参
2016-05-24 13:23
xiangyue0510
Rank: 14Rank: 14Rank: 14Rank: 14
等 级:贵宾
威 望:86
帖 子:908
专家分:5237
注 册:2015-8-10
  得分:0 
这个没有用过,但是我看了一下,好像后面不带()。
Private Function Add(ByVal a As Integer, ByVal b As Integer) As Integer
    Add = a + b
End Function

Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
    Dim f As Func(Of Integer, Integer, Integer) = AddressOf Add 'func(参数1类型,参数2类型,返回值类型),必须对应
    MessageBox.Show(f(1, 2).ToString())
End Sub
2016-05-25 08:40
rogersgb
Rank: 1
等 级:新手上路
帖 子:68
专家分:0
注 册:2016-2-3
  得分:0 
回复 4楼 xiangyue0510
具体要怎么改,请提供一下修改代码吗
2016-05-25 15:28
不说也罢
Rank: 13Rank: 13Rank: 13Rank: 13
等 级:贵宾
威 望:39
帖 子:1481
专家分:4989
注 册:2007-10-7
  得分:10 
    '**********************************
    '* RAS API 声明 *
    '**********************************
    ......
    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 MyDelegate, ByRef lphRasConn As Integer) As Integer
   ......

    Public Delegate Sub MyDelegate(ByRef unMsg As Integer, ByRef ConnState As Integer, ByRef dwError As Integer) '先声明委托MyDelegate
    'Sleep
    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Integer)

...............

        '若使用以下CallBack function的方式,则RasDial()不等连线成功或失败便结束。
        Dim MyDlg As MyDelegate
        MyDlg = AddressOf RasDialFunc
        lngRetCode = RasDial(APINULL, Nothing, lprasdialparams, 0, MyDlg, hRasConn) '异步通信

        '若第二、三个叁数都是0则,RasDial会等连线成功或失败後才执行下一行指令

...............

请对照红色代码,将红色部分复制到相应的位置。
请以后不要就同一个问题另发新贴。

===================================================
讨厌C#的行尾的小尾巴;和一对大括号{ }
===================================================
2016-05-28 10:33
rogersgb
Rank: 1
等 级:新手上路
帖 子:68
专家分:0
注 册:2016-2-3
  得分:0 
回复 6楼 不说也罢
问题是解决了,没有提示错了,生成也成功,但连接时创建成功,拨号不会自动拨
2016-05-29 15:16
rogersgb
Rank: 1
等 级:新手上路
帖 子:68
专家分:0
注 册:2016-2-3
  得分:0 
回复 7楼 rogersgb
Imports System
Imports System.Windows.Forms
Imports System.Runtime.InteropServices
Module link

    Public hRasConn As Int32 '定义一个指向RAS调用的全局句柄
    Public Const APINULL As Int32 = 0&
    Public Const UNLEN As Int32 = 256
    Public Const DNLEN As Int32 = 15
    Public Const PWLEN As Int32 = 256
    Public Const RAS95_MaxPhoneNumber As Int32 = 128
    Public Const RAS95_MaxEntryName As Int32 = 256
    Public Const RAS_MaxDeviceType As Int32 = 16
    Public Const RAS95_MaxDeviceName As Int32 = 128
    Public Const RAS95_MaxCallbackNumber As Int32 = RAS95_MaxPhoneNumber
    Public Structure RASCONN95
        Dim dwSize As Long
        Dim hRasConn As Long
        <MarshalAs(UnmanagedType.ByValTStr, SizeConst:=RAS95_MaxEntryName + 1)> _
        Dim szEntryName() As Byte
        <MarshalAs(UnmanagedType.ByValTStr, SizeConst:=RAS_MaxDeviceType + 1)> _
        Dim szDeviceType() As Byte
        <MarshalAs(UnmanagedType.ByValTStr, SizeConst:=RAS95_MaxDeviceName + 1)> _
        Dim szDeviceName() As Byte
    End Structure

    Public Structure RASENTRYNAME95
        Dim dwSize As Int32
        <MarshalAs(UnmanagedType.ByValTStr, SizeConst:=RAS95_MaxEntryName + 1)> _
        Dim szEntryName() As Byte
    End Structure
    Public Structure RASDIALPARAMS95
        Dim dwSize As Int32
        <MarshalAs(UnmanagedType.ByValTStr, SizeConst:=RAS95_MaxEntryName + 1)> _
        Dim szEntryName() As Byte
        <MarshalAs(UnmanagedType.ByValTStr, SizeConst:=RAS95_MaxPhoneNumber + 1)> _
        Dim szPhoneNumber() As Byte
        <MarshalAs(UnmanagedType.ByValTStr, SizeConst:=RAS95_MaxCallbackNumber + 1)> _
        Dim szCallbackNumber() As Byte
        <MarshalAs(UnmanagedType.ByValTStr, SizeConst:=UNLEN + 1)> _
        Dim szUserName() As Byte
        <MarshalAs(UnmanagedType.ByValTStr, SizeConst:=PWLEN + 1)> _
        Dim szPassword() As Byte
        <MarshalAs(UnmanagedType.ByValTStr, SizeConst:=DNLEN + 1)> _
        Dim szDomain() As Byte
    End Structure

    '**********************************
    '* RAS调用错误代号 *
    '**********************************
    Public Const NOT_SUPPORTED As Int32 = 120
    Public Const RASBASEERROR As Int32 = 600
    Public Const SUCCESS As Int32 = 0
    Public Const ERROR_PORT_ALREADY_OPEN As Int32 = (RASBASEERROR + 2)
    Public Const ERROR_UNKNOWN As Int32 = (RASBASEERROR + 35)
    Public Const ERROR_REQUEST_TIMEOUT As Int32 = (RASBASEERROR + 38)
    Public Const ERROR_PASSWD_EXPIRED As Int32 = (RASBASEERROR + 48)
    Public Const ERROR_NO_DIALIN_PERMISSION As Int32 = (RASBASEERROR + 49)
    Public Const ERROR_SERVER_NOT_RESPONDING As Int32 = (RASBASEERROR + 50)
    Public Const ERROR_UNRECOGNIZED_RESPONSE As Int32 = (RASBASEERROR + 52)
    Public Const ERROR_NO_RESPONSES As Int32 = (RASBASEERROR + 60)
    Public Const ERROR_DEVICE_NOT_READY As Int32 = (RASBASEERROR + 66)
    Public Const ERROR_LINE_BUSY As Int32 = (RASBASEERROR + 76)
    Public Const ERROR_NO_ANSWER As Int32 = (RASBASEERROR + 78)
    Public Const ERROR_NO_CARRIER As Int32 = (RASBASEERROR + 79)
    Public Const ERROR_NO_DIALTONE As Int32 = (RASBASEERROR + 80)
    Public Const ERROR_AUTHENTICATION_FAILURE As Int32 = (RASBASEERROR + 91)
    Public Const ERROR_PPP_TIMEOUT As Int32 = (RASBASEERROR + 118)
    '**********************************
    '* RAS连接状态声明 *
    '**********************************
    Enum RasConnState
        RASCS_OpenPort = 0
        RASCS_PortOpened '1
        RASCS_ConnectDevice '2
        RASCS_AllDevicesConnected '4
        RASCS_DeviceConnected '3
        RASCS_Authenticate '5
        RASCS_AuthNotify '6
        RASCS_AuthRetry
        RASCS_AuthCallback
        RASCS_AuthChangePassword
        RASCS_AuthProject
        RASCS_AuthLinkSpeed
        RASCS_AuthAck
        RASCS_ReAuthenticate
        RASCS_Authenticated
        RASCS_PrepareForCallback
        RASCS_WaitForModemReset
        RASCS_WaitForCallback
        RASCS_Projected
        RASCS_StartAuthentication '19
        RASCS_CallbackComplete
        RASCS_LogonNetwork '21
        RASCS_Interactive = &H1000S
        RASCS_RetryAuthentication
        RASCS_CallbackSetByCaller
        RASCS_PasswordExpired
        RASCS_Connected = &H2000S
        RASCS_Disconnected
    End Enum
    '**********************************
    '* RAS API 声明 *
    '**********************************
    Public Declare Auto Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (ByVal lpString1 As Byte, ByVal lpString2 As String) As Int32
    Public Declare Auto Function RasDial Lib "rasapi32.dll" Alias "RasDialA" (ByVal lpRasDialExtensions As Object, ByVal lpszPhonebook As Object, ByRef lprasdialparams As RASDIALPARAMS95, ByVal dwNotifierType As Object, ByRef lpvNotifier As MyDelegate, ByRef lphRasConn As Int32) As Int32
    Public Declare Auto Function RasHangUp Lib "rasapi32.dll" Alias "RasHangUpA" (ByVal hRasConn As Int32) As Int32
    Public Delegate Sub MyDelegate(ByRef unMsg As Int32, ByRef ConnState As Int32, ByRef dwError As Int32) '先声明委托MyDelegate
    Dim lprasdialparams As RASDIALPARAMS95

    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 Int32
        Dim lngRetCode, lngRetHangUp As int32
        Dim lngRetLstrcpy As int32
        With lprasdialparams
            ReDim .szEntryName(RAS95_MaxEntryName)
            ReDim .szPhoneNumber(RAS95_MaxPhoneNumber)
            ReDim .szCallbackNumber(RAS95_MaxCallbackNumber)
            ReDim .szUserName(UNLEN)
            ReDim .szPassword(PWLEN)
            ReDim .szDomain(DNLEN)
            lprasdialparams.dwSize = 1052
            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)
        End With
        Cursor.Current = Cursors.WaitCursor '改变鼠标样式
        hRasConn = 0
        Application.DoEvents()
        '若使用以下CallBack function的方式,则RasDial()不等连线成功或失败便结束。
        Dim MyDlg As MyDelegate
        MyDlg = AddressOf RasDialFunc
        lngRetCode = RasDial(APINULL, Nothing, lprasdialparams, 0, MyDlg, hRasConn) '异步通信
        '若第二、三个叁数都是0则,RasDial会等连线成功或失败後才执行下一行指令
        'lngRetCode = RasDial(APINULL, APINULL, lprasdialparams, APINULL, APINULL, hRasConn)
        Application.DoEvents()
        Cursor.Current = Cursors.Default '改变鼠标样式
        '测试有没有错误
        If lngRetCode Then
            lngRetHangUp = RasHangUp(hRasConn)
        End If
        AddConnection = lngRetCode
    End Function

    Public Sub RasDialFunc(ByRef unMsg As Int32, ByRef ConnState As Int32, ByRef dwError As Int32)
        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
2016-06-15 12:14
rogersgb
Rank: 1
等 级:新手上路
帖 子:68
专家分:0
注 册:2016-2-3
  得分:0 
回复 8楼 rogersgb
无法封送处理类型为“RASDIALPARAMS95”的字段“szEntryName”: 无效的托管/非托管类型组合(Array 类型的字段必须与 ByValArray 或 SafeArray 成对出现)。
2016-06-15 12:15







关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.039026 second(s), 8 queries.
Copyright©2004-2018, BCCN.NET, All Rights Reserved