说三道四技术文摘-感悟人生的经典句子
说三道四 > 文档快照

VB建立拨号联接 -VB资料

HTML文档下载 WORD文档下载 PDF文档下载
VB建立拨号联接 -VB资料

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_MaxEntryName+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 String, _
ByVal Pwd As String, Optional ByVal PhoneBook As String, Optional sDomain 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, hRasConn)

'若第二、叁个参数都是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
备案号:鲁ICP备13029499号-2 说三道四 www.s3d4.cn 说三道四技术文摘