用VB6.0实现拨号

这个

5个控件TEXT1 TEXT2 TIMER1 TIMER2 COMMAND1

设置timer1 interval=1000

timer2 interval=500

text1.text=1

text2.text=你想设置的数值 为秒

Private Sub Command1_Click()

if text1>text2 then 你想要做的事情 就是什么关闭连接 或者虾米东西关电脑

End Sub

Private Sub Timer1_Timer()

Text1 = Text1 + 1

End Sub

Private Sub Timer2_Timer()

Command1_Click

End Sub

或者..

我们常用的软件如：JETCAR（现在为FLASHGET），GO！ZILLA等都具有拨号上网功能。那么，如何在自己编写的应用程序中也实现上述的功能呢？本文就利用RAS调用介绍在自己数如颂编写的应用程序如何实现拨号上网。

一.与拨号网络有关的结构和函数

1.RASDIALPARAMS95结构.其定义如下：

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

其中，dwSize表示该结构的大小（以字节为单位）。szEntryName表示一个薯郑远程访问的入口名，也就是WINDOWS下的拨号网络中的连接图标小的文字；szEntryName参数可是是空串，表示仅与第一个有效的MODEM建立远程连接。szPhoneNumber为表示呼叫的号码。当szEntryName是空时，zPhoneNumber不能为空。szCallbackNumber表示回叫号码，一般都设为空。szUserName为建立远程访问的用户名。szPassword为建立远程访问的密码。szDomain为进行远程访问用户名和密码认证的域名。我们将szDomain设为空，表示远程访问的服务器也是该域名下的成员。

2.RASDIAL函数.其API声明为：

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

RASDIAL函数用于建立RAS客户机和RAS服务器的连接。

各参数解释如下：

lpRasDialExtensions参数在WINDOWS95/98下被忽略。

lpszPhonebook参数在WINDOWS95/98下也被忽略。

lprasdialparams参数是指向一个含有RAS连接参数值的RASDIALPARAMS结构变量。

dwNotifierType参数用于指出参数lpvNotifier的性质。若lpvNotifier 为NULL，则dwNotifierType的值被忽略；若lpvNotifier不为NULL，则dwNotifierType应该为下列值之一：

（1）.0XFFFFFFFF------指出lpvNotifier参数是一个接收进程通知消息橡禅的窗口句柄；

（2）.0----------------指出lpvNotifier指向一个RASDIALFUNC回调函数；

（3）.1----------------指出lpvNotifier指向下一个RASDIALFUNC1回调函数。

lpvNotifier参数用于指向一个接收RASDIAL事件通知的窗口或者回调函数，其性质由dwNotifierType参数决定:

（1）.若lpvNotifier不NULL，表示是异步通信。即RASDIAL会对每个事件发送一个窗口消息或者调用回调函数。RASDIAL函数会立即返回，它通过窗口或者调用回调函数建立连接，与进程通信。

（2）.若lpvNotifier是NULL，表示同步通信。即RASDIAL函数在连接建立完成或者失败后才会返回。

lphRasConn参数指向HRASCONN变量，必须先将lphRasConn设置为NULL，然后再调用RASDIAL函数。如果RASDIAL函数调用成功，lphRasconn会放置一个RAS连接句柄。

3.RASHANGUP函数.其API声明为：

Public Declare Function RasHangUp Lib "RasApi32.DLL" Alias "RasHangUpA" (ByVal hRasConn As Long) As Long

RASHANGUP函数用于断开一个RAS连接。其参数hRasConn为指向一个RAS连接的句柄。

二.用VB6.0实现RAS拨号上网过程。

新建一个工程，取名为RasDial然后在该工程中加入如下项目：

1.新建一个窗体Form1，然后在该窗体中加入如下组件：

("连接"按钮取名为Ras_Dial,"挂断"按钮取名为:Ras_HangUp,"退出"按钮取名为："Cancel".

3个文本框分别取名为：PhoneNumber,UserName,PassWord.)

2.双击连接按钮，加入如下代码：

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

6.最后，编译生成应用程序，我们就实现了在自己的应用程序中拨号上网。本程序在PWIN98,VB6.0环境下编译通过。

呵呵，其实楼主完全可以用易语言编写一个，不过用VB也挺简单的：

新建工程，窗体上放置一个文本框用来接受用户写入的电话号码；一个命令按钮用来开始执行。要用到windows的TAPI32.DLL动态链接库，通过动蠢散态链接库通知Windows，请求使用调制解调器进行拔号。

Private Declare Function tapiRequestMakeCall&Lib "TAPI32.DLL" (ByVal DestAddress$, ByVal AppName$, ByVal CalledParty$, ByVal Comment$)

Private Const TAPIERR_NOREQUESTRECIPIENT = -2&

Private Const TAPIERR_REQUESTQUEUEFULL = -3&

Private Const TAPIERR_INVALDESTADDRESS = -4&

Private Sub Command1_Click()

Dim buff As String

Dim nResult As Long

’打开调制解调器拨号

nResult = tapiRequestMakeCall&(Trim$(txtNumber), CStr(Caption), "Test Dial", "")

’显示出错信息

If nResult <>0 Then

buff = "哗陵非法 *** 作 : "

Select Case nResult

Case TAPIERR_NOREQUESTRECIPIENT

buff = buff &"未找到Windows拨号程序接口"

Case TAPIERR_REQUESTQUEUEFULL

buff = buff &"拨号已连接."

Case TAPIERR_INVALDESTADDRESS

buff = buff &"不正确的号码"

Case Else

buff = buff &"未知错误."

End Select

MsgBox buff

End If

End Sub

Private Sub Form_Load()

Move (Screen.Width - Width) \ 2, (Screen.Height - Height) \ 2

EnableDial

End Sub

Private Sub Text1_Change()

EnableDial

End Sub

Private Sub EnableDial()

Command1.Enabled = Len(Trim$(Text1.Text)) >0

End Sub

Win2K/WinXP/Vista测试通乱档戚过，不过有些机器不太兼容。

---