扫一扫
分享文章到微信
扫一扫
关注官方公众号
至顶头条
作者：兰伟波 来源：yesky 2007年10月15日
关键字：
| Private Sub Ras_Dial_Click() Dim temp As Long If PhoneNumber.Text = "" Or UserName.Text = "" Or PassWord.Text = "" Then temp = MsgBox("您没有输入有效的拨号网络参数。", vbOKOnly, "错误") Exit Sub End If temp = AddConnection("", PhoneNumber.Text, "", UserName.Text, PassWord.Text, "") Select Case temp Case ERROR_PORT_ALREADY_OPEN: temp = MsgBox("错误，端口已经打开！", vbOKOnly, "Error") Case ERROR_UNKNOWN: temp = MsgBox("未知的错误！", vbOKOnly, "Error") Case ERROR_REQUEST_TIMEOUT: temp = MsgBox("错误，请求超时！", vbOKOnly, "Error") Case ERROR_PASSWD_EXPIRED: temp = MsgBox("错误，您没有输入密码！", vbOKOnly, "Error") Case ERROR_NO_DIALIN_PERMISSION: temp = MsgBox("错误，没有拨号音！", vbOKOnly, "Error") Case ERROR_SERVER_NOT_RESPONDING: temp = MsgBox("错误，拨入的远程计算机没有响应！", vbOKOnly, "Error") Case ERROR_UNRECOGNIZED_RESPONSE: temp = MsgBox("错误，未知的响应！", vbOKOnly, "Error") Case ERROR_NO_RESPONSES: temp = MsgBox("错误，没有响应！", vbOKOnly, "Error") Case ERROR_DEVICE_NOT_READY: temp = MsgBox("错误，设备没有准备好！", vbOKOnly, "Error") Case ERROR_LINE_BUSY: temp = MsgBox("错误，占线！", vbOKOnly, "Error") Case ERROR_NO_ANSWER: temp = MsgBox("错误，没有应答信号！", vbOKOnly, "Error") Case ERROR_NO_CARRIER: temp = MsgBox("错误，没有载波信号！", vbOKOnly, "Error") Case ERROR_NO_DIALTONE: temp = MsgBox("错误，没有拨号音！", vbOKOnly, "Error") Case ERROR_AUTHENTICATION_FAILURE: temp = MsgBox("用户名密码出错！", vbOKOnly, "Error") Case ERROR_PPP_TIMEOUT: temp = MsgBox("PPP接入超时。", vbOKOnly, "Error") End Select End Sub 3.双击挂断按钮，加入如下代码： Private Sub Ras_HangUp_Click() Dim temp As Long temp = RasHangUp(hRasConn) End Sub 4.双击退出按钮，加入如下代码： Private Sub Cancel_Click() Unload Me End Sub 5.最后，新建一个模块，取名为Ras_Dial,加入如下代码： Option Explicit Public hRasConn As Long '定义一个指向RAS调用的全局句柄 Public Const APINULL = 0& Public Const UNLEN = 256 Public Const DNLEN = 15 Public Const PWLEN = 256 Public Const RAS95_MaxPhoneNumber = 128 Public Const RAS95_MaxEntryName = 256 Public Const RAS95_MaxCallbackNumber = RAS95_MaxPhoneNumber Public Type RASDIALPARAMS95 dwSize As Long szEntryName(RAS95_MaxEntryName) As Byte szPhoneNumber(RAS95_MaxPhoneNumber) As Byte szCallbackNumber(RAS95_MaxCallbackNumber) As Byte szUserName(UNLEN) As Byte szPassword(PWLEN) As Byte szDomain(DNLEN) As Byte End Type '********************************** '* RAS调用错误代号 * '********************************** Public Const NOT_SUPPORTED = 120& Public Const RASBASEERROR = 600& Public Const SUCCESS = 0& Public Const ERROR_PORT_ALREADY_OPEN = (RASBASEERROR + 2) Public Const ERROR_UNKNOWN = (RASBASEERROR + 35) Public Const ERROR_REQUEST_TIMEOUT = (RASBASEERROR + 38) Public Const ERROR_PASSWD_EXPIRED = (RASBASEERROR + 48) Public Const ERROR_NO_DIALIN_PERMISSION = (RASBASEERROR + 49) Public Const ERROR_SERVER_NOT_RESPONDING = (RASBASEERROR + 50) Public Const ERROR_UNRECOGNIZED_RESPONSE = (RASBASEERROR + 52) Public Const ERROR_NO_RESPONSES = (RASBASEERROR + 60) Public Const ERROR_DEVICE_NOT_READY = (RASBASEERROR + 66) Public Const ERROR_LINE_BUSY = (RASBASEERROR + 76) Public Const ERROR_NO_ANSWER = (RASBASEERROR + 78) Public Const ERROR_NO_CARRIER = (RASBASEERROR + 79) Public Const ERROR_NO_DIALTONE = (RASBASEERROR + 80) Public Const ERROR_AUTHENTICATION_FAILURE = (RASBASEERROR + 91) Public Const ERROR_PPP_TIMEOUT = (RASBASEERROR + 118) '********************************** '* RAS API 声明 * '********************************** Public Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (lpString1 As Any, ByVal lpString2 As String) As Long Public Declare Function RasDial Lib "RasApi32.DLL" Alias "RasDialA" (lpRasDialExtensions As Any, ByVal lpszPhonebook As String, lprasdialparams As Any, ByVal dwNotifierType As Long, lpvNotifier As Long, lphRasConn As Long) As Long Public Declare Function RasHangUp Lib "RasApi32.DLL" Alias "RasHangUpA" (ByVal hRasConn As Long) As Long Public Function AddConnection(strNewEntryName As String, strNewPhoneNumber As String, strNewCallbackNumber As String, strNewUsername As String, strNewPassword As String, strNewDomain As String) As Integer Dim lngRetCode As Long Dim lngRetLstrcpy As Long Dim lngRetHangUp As Long Dim lprasdialparams As RASDIALPARAMS95 lprasdialparams.dwSize = 1052 '在WINDOWS95/98中必须将dwSize设为1052 '利用lstrcpy函数将字符串拷贝到BYTE数组 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) '我们使用同步通信 Screen.MousePointer = vbHourglass hRasConn = 0 ' lngRetCode = RasDial(ByVal APINULL, vbNullString, lprasdialparams, APINULL, ByVal APINULL, hRasConn) Screen.MousePointer = vbDefault '测试有没有错误 If lngRetCode Then lngRetHangUp = RasHangUp(hRasConn) End If AddConnection = lngRetCode End Function Public Sub RemoveConnection(H_RasConn As Long) Call RasHangUp(hRasConn) End Sub |
如果您非常迫切的想了解IT领域最新产品与技术信息，那么订阅至顶网技术邮件将是您的最佳途径之一。
京公网安备 11010802021500号