向大虾们求一电话拨号程序：

[simonwdjp]

比如我这边有一个数据库，里面有两个电话号码，我在用其中一个号向另一个号拨号的时候本机有另一个判断程序，用来判断拨的号码是否拨通，通了几分钟，然后向数据库中更新用户的余额。注意：只是实现单机功能，不要真的向外拨出。
请大虾们给个例子也好，做法也好，我好用来参考。在这里多谢了！！

[simonwdjp]

没有人帮忙吗？请诸位大虾们帮帮小弟吧

[xuedaniel]

我有，做了给客户用了多年了，很稳定。

[simonwdjp]

哦，那我的联系方式qq：149328559，msn:[e-mail],
yahoo message:[e-mail],添加的时候请注明一下您的信息，我好确认是您。很想跟您学习一下这方面的经验。非常感谢！！

[starsoulxp]

楼主请参考：

http://www.moon-soft.com/doc/readelite6399.htm

建立拨号联接
Public Const RAS_MaxEntryName = 256

Private Type RASENTRYNAME
dwSize As Long
szEntryName(RAS_MaxEntryName) As Byte
End Type

c 中 Char aa[16] 代表长度是16，可放 15个byte所以对应於vb便是 aa(15) as

Byte
如此才是长度16 ( 0--15)。故VB的宣告中不能再用szEntryName(RAS_MaxEntryN

ame+1)

但是Lenb(RASENTRYNAME)的长度却是 261 (4+257)，的确，这是vb的问题，而c

的SizeOf
传回的是4的倍数(32位元嘛)故值为264，所以我们计算某个Structure的长度时，

要再多一
些运算。

以下的Fuction只适用於32位元的win95/ NT，

'以下在Form中

Private hConn as Long
Private Sub Command1_Click()
hConn = Dialup("我的连线", "user", "passwd")
if hConn = 0 Then
Debug.Print "连线失败"
end if
End Sub

Private Sub Command2_Click()
Call HangUp(hConn)
End Sub

'以下在.bas中
Option Explicit
Public Const RAS_MaxEntryName = 256
Public Const RAS_MaxDeviceName = 128
Public Const RAS_MaxDeviceType = 16
Public Const RAS_MaxPhoneNumber = 128
Public Const RAS_MaxCallbackNumber = 128
Public Const UNLEN = 256
Public Const PWLEN = 256
Public Const DNLEN = 15
Public Const ERROR_INVALID_HANDLE = 6
Type RASDIALPARAMS
dwSize As Long '1052
szEntryName(RAS_MaxEntryName) As Byte
szPhoneNumber(RAS_MaxPhoneNumber) As Byte
szCallbackNumber(RAS_MaxCallbackNumber) As Byte
szUserName(UNLEN) As Byte
szPassword(PWLEN) As Byte
szDomain(DNLEN) As Byte
End Type

Type RASCONNSTATUS
dwSize As Long '144
RasConnState As Long
dwError As Long
szDeviceType(RAS_MaxDeviceType) As Byte
szDeviceName(RAS_MaxDeviceName) As Byte
End Type

Declare Function RasGetErrorString Lib "rasapi32" _
Alias "RasGetErrorStringA" (ByVal ErrValue As Long, ByVal lpErrStr As

String, _
ByVal cSize As Long) As Long
Declare Function RasDial Lib "rasapi32" _
Alias "RasDialA" (DialExt As Long, ByVal lpPhoneBook As String, _
RasDialParam As RASDIALPARAMS, ByVal NotifyType As Long, _
ByVal Notifter As Long, hRasConn As Long) As Long
Declare Function RasHangUp Lib "rasapi32" Alias _
"RasHangUpA" (ByVal hRasConn As Long) As Long
Declare Function RasGetConnectStatus Lib "rasapi32" Alias _
"RasGetConnectStatusA" (ByVal hRasConn As Long, _
lprasconnstatus As RASCONNSTATUS) As Long
Declare Function RasGetEntryDialParams Lib "rasapi32" _
Alias "RasGetEntryDialParamsA" (ByVal lpszPhonebook As String, _
lpRasDialParams As RASDIALPARAMS, _
lpfPassword As Byte) As Long
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

'自动拨接(Win95 4, 5 个参数不传，或为vbNullString)
Public Function DialUp(ByVal EntryName As String, ByVal UserN As Strin

g, _
ByVal Pwd As String, Optional ByVal PhoneBook As String, Optional sDom

ain As String) As Long
Dim RasDialPara As RASDIALPARAMS
Dim bya() As Byte, di As Long
Dim len5 As Long, i As Long
Dim hRasConn As Long

len5 = LenB(RasDialPara)
i = (4 - (len5 Mod 4)) Mod 4
RasDialPara.dwSize = len5 + i '1052
bya = StrConv(EntryName, vbFromUnicode) + ChrB(0)
Call CopyByte(RasDialPara.szEntryName, bya)

bya = StrConv(UserN, vbFromUnicode) + ChrB(0)
Call CopyByte(RasDialPara.szUserName, bya)

bya = StrConv(Pwd, vbFromUnicode) + ChrB(0)
Call CopyByte(RasDialPara.szPassword, bya)

bya = StrConv(sDomain, vbFromUnicode) + ChrB(0)
Call CopyByte(RasDialPara.szDomain, bya)
'若使用以下CallBack function的方式，则RasDial()不等连线成功或失败便结束

。
di = RasDial(0, PhoneBook, RasDialPara, 0, AddressOf RasDialFunc, hRas

Conn)

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


'di = RasDial(0, PhoneBook, RasDialPara, 0, 0, hRasConn)

If di = 0 Then
DialUp = hRasConn
Else
DialUp = 0
Dim str5 As String
str5 = String(255, Chr(0))
Call RasGetErrorString(di, str5, 256)
MsgBox Left(str5, InStr(1, str5, Chr(0)) - 1), vbCritical
Call HangUp(hRasConn)
End If
End Function

Public Sub RasDialFunc(ByVal unMsg As Long, _
ByVal ConnState As Long, _
ByVal dwError As Long)
If ConnState = &H2000 Then
' Connect Complete
End If

'取消拨接
Public Function HangUp(ByVal hconn As Long) As Boolean
Dim st As Long, len5 As Long
Dim i As Long, ConStatus As RASCONNSTATUS
st = RasHangUp(hconn)
len5 = LenB(ConStatus)
i = (4 - (len5 Mod 4)) Mod 4
ConStatus.dwSize = len5 + i
Do While True
Call Sleep(0)
i = RasGetConnectStatus(hconn, ConStatus)
If i = ERROR_INVALID_HANDLE Then
Exit Do
End If
Loop
If st = 0 Then
HangUp = True
Else
HangUp = False
End If
End Function

Private Sub CopyByte(dest() As Byte, sour() As Byte)
Dim sourL As Long, sourU As Long
Dim destL As Long, destU As Long, i As Long, j As Long
sourL = LBound(sour)
sourU = UBound(sour)
destL = LBound(dest)
destU = UBound(dest)
j = 0
For i = sourL To sourU
dest(destL + j) = sour(i)
j = j + 1
If j >= (destU - destL) + 1 Then
Exit For
End If
Next i
End Sub

[starsoulxp]

楼主参考：

http://www.pcworld.com.cn/98/manus/9808/083102b.html

http://www.v-galaxy.com/faq/vbvc/74119.shtml

[simonwdjp]

沉了许久了，还有没有可以用来作为参考的呀，楼上的好心人那个我已经明白了，可是有一点我的主要问题是在回拨上，也就是自己拨号自己接，并不是真地去实现网络拨号的。

[simonwdjp]

还没有人来发表意见吗

[jam021]

关注,帮你顶!

[simonwdjp]

又沉了呀,还么没有人回呀