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
|