📄 40.htm
字号:
<p>建立拨号联接 </p>
<p> </p>
<p>Public Const RAS_MaxEntryName = 256</p>
<p></p>
<p>Private Type RASENTRYNAME</p>
<p>dwSize As Long</p>
<p>szEntryName(RAS_MaxEntryName) As Byte</p>
<p>End Type</p>
<p></p>
<p>c 中 Char aa[16] 代表长度是16,可放 15个byte所以对应於vb便是 aa(15) as Byte</p>
<p>如此才是长度16 ( 0--15)。故VB的宣告中不能再用szEntryName(RAS_MaxEntryName+1)</p>
<p></p>
<p>但是Lenb(RASENTRYNAME)的长度却是 261 (4+257),的确,这是vb的问题,而c 的SizeOf</p>
<p>传回的是4的倍数(32位元嘛)故值为264,所以我们计算某个Structure的长度时,要再多一</p>
<p>些运算。</p>
<p></p>
<p>以下的Fuction只适用於32位元的win95/ NT,</p>
<p></p>
<p>'以下在Form中</p>
<p></p>
<p>Private hConn as Long</p>
<p>Private Sub Command1_Click()</p>
<p>hConn = Dialup("我的连线", "user", "passwd")</p>
<p>if hConn = 0 Then</p>
<p>Debug.Print "连线失败"</p>
<p>end if</p>
<p>End Sub</p>
<p></p>
<p>Private Sub Command2_Click()</p>
<p>Call HangUp(hConn)</p>
<p>End Sub</p>
<p></p>
<p>'以下在.bas中</p>
<p>Option Explicit</p>
<p>Public Const RAS_MaxEntryName = 256</p>
<p>Public Const RAS_MaxDeviceName = 128</p>
<p>Public Const RAS_MaxDeviceType = 16</p>
<p>Public Const RAS_MaxPhoneNumber = 128</p>
<p>Public Const RAS_MaxCallbackNumber = 128</p>
<p>Public Const UNLEN = 256</p>
<p>Public Const PWLEN = 256</p>
<p>Public Const DNLEN = 15</p>
<p>Public Const ERROR_INVALID_HANDLE = 6</p>
<p>Type RASDIALPARAMS</p>
<p>dwSize As Long '1052</p>
<p>szEntryName(RAS_MaxEntryName) As Byte</p>
<p>szPhoneNumber(RAS_MaxPhoneNumber) As Byte</p>
<p>szCallbackNumber(RAS_MaxCallbackNumber) As Byte</p>
<p>szUserName(UNLEN) As Byte</p>
<p>szPassword(PWLEN) As Byte</p>
<p>szDomain(DNLEN) As Byte</p>
<p>End Type</p>
<p></p>
<p>Type RASCONNSTATUS</p>
<p>dwSize As Long '144</p>
<p>RasConnState As Long</p>
<p>dwError As Long</p>
<p>szDeviceType(RAS_MaxDeviceType) As Byte</p>
<p>szDeviceName(RAS_MaxDeviceName) As Byte</p>
<p>End Type</p>
<p></p>
<p>Declare Function RasGetErrorString Lib "rasapi32" _</p>
<p>Alias "RasGetErrorStringA" (ByVal ErrValue As Long, ByVal lpErrStr As String, _</p>
<p>ByVal cSize As Long) As Long</p>
<p>Declare Function RasDial Lib "rasapi32" _</p>
<p>Alias "RasDialA" (DialExt As Long, ByVal lpPhoneBook As String, _</p>
<p>RasDialParam As RASDIALPARAMS, ByVal NotifyType As Long, _</p>
<p>ByVal Notifter As Long, hRasConn As Long) As Long</p>
<p>Declare Function RasHangUp Lib "rasapi32" Alias _</p>
<p>"RasHangUpA" (ByVal hRasConn As Long) As Long</p>
<p>Declare Function RasGetConnectStatus Lib "rasapi32" Alias _</p>
<p>"RasGetConnectStatusA" (ByVal hRasConn As Long, _</p>
<p>lprasconnstatus As RASCONNSTATUS) As Long</p>
<p>Declare Function RasGetEntryDialParams Lib "rasapi32" _</p>
<p>Alias "RasGetEntryDialParamsA" (ByVal lpszPhonebook As String, _</p>
<p>lpRasDialParams As RASDIALPARAMS, _</p>
<p>lpfPassword As Byte) As Long</p>
<p>Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)</p>
<p></p>
<p>'自动拨接(Win95 4, 5 个参数不传,或为vbNullString)</p>
<p>Public Function DialUp(ByVal EntryName As String, ByVal UserN As String, _</p>
<p>ByVal Pwd As String, Optional ByVal PhoneBook As String, Optional sDomain As String) As Long</p>
<p>Dim RasDialPara As RASDIALPARAMS</p>
<p>Dim bya() As Byte, di As Long</p>
<p>Dim len5 As Long, i As Long</p>
<p>Dim hRasConn As Long</p>
<p></p>
<p>len5 = LenB(RasDialPara)</p>
<p>i = (4 - (len5 Mod 4)) Mod 4</p>
<p>RasDialPara.dwSize = len5 + i '1052</p>
<p>bya = StrConv(EntryName, vbFromUnicode) + ChrB(0)</p>
<p>Call CopyByte(RasDialPara.szEntryName, bya)</p>
<p></p>
<p>bya = StrConv(UserN, vbFromUnicode) + ChrB(0)</p>
<p>Call CopyByte(RasDialPara.szUserName, bya)</p>
<p></p>
<p>bya = StrConv(Pwd, vbFromUnicode) + ChrB(0)</p>
<p>Call CopyByte(RasDialPara.szPassword, bya)</p>
<p></p>
<p>bya = StrConv(sDomain, vbFromUnicode) + ChrB(0)</p>
<p>Call CopyByte(RasDialPara.szDomain, bya)</p>
<p>'若使用以下CallBack function的方式,则RasDial()不等连线成功或失败便结束。</p>
<p>di = RasDial(0, PhoneBook, RasDialPara, 0, AddressOf RasDialFunc, hRasConn)</p>
<p></p>
<p>'若第二、叁个参数都是0则,RasDial会等连线成功或失败後才执行下一行指令</p>
<p>'di = RasDial(0, PhoneBook, RasDialPara, 0, 0, hRasConn)</p>
<p></p>
<p>If di = 0 Then</p>
<p>DialUp = hRasConn</p>
<p>Else</p>
<p>DialUp = 0</p>
<p>Dim str5 As String</p>
<p>str5 = String(255, Chr(0))</p>
<p>Call RasGetErrorString(di, str5, 256)</p>
<p>MsgBox Left(str5, InStr(1, str5, Chr(0)) - 1), vbCritical</p>
<p>Call HangUp(hRasConn)</p>
<p>End If</p>
<p>End Function</p>
<p></p>
<p>Public Sub RasDialFunc(ByVal unMsg As Long, _</p>
<p>ByVal ConnState As Long, _</p>
<p>ByVal dwError As Long)</p>
<p>If ConnState = &H2000 Then</p>
<p>' Connect Complete</p>
<p>End If</p>
<p></p>
<p>'取消拨接</p>
<p>Public Function HangUp(ByVal hconn As Long) As Boolean</p>
<p>Dim st As Long, len5 As Long</p>
<p>Dim i As Long, ConStatus As RASCONNSTATUS</p>
<p>st = RasHangUp(hconn)</p>
<p>len5 = LenB(ConStatus)</p>
<p>i = (4 - (len5 Mod 4)) Mod 4</p>
<p>ConStatus.dwSize = len5 + i</p>
<p>Do While True</p>
<p>Call Sleep(0)</p>
<p>i = RasGetConnectStatus(hconn, ConStatus)</p>
<p>If i = ERROR_INVALID_HANDLE Then</p>
<p>Exit Do</p>
<p>End If</p>
<p>Loop</p>
<p>If st = 0 Then</p>
<p>HangUp = True</p>
<p>Else</p>
<p>HangUp = False</p>
<p>End If</p>
<p>End Function</p>
<p></p>
<p>Private Sub CopyByte(dest() As Byte, sour() As Byte)</p>
<p>Dim sourL As Long, sourU As Long</p>
<p>Dim destL As Long, destU As Long, i As Long, j As Long</p>
<p>sourL = LBound(sour)</p>
<p>sourU = UBound(sour)</p>
<p>destL = LBound(dest)</p>
<p>destU = UBound(dest)</p>
<p>j = 0</p>
<p>For i = sourL To sourU</p>
<p>dest(destL + j) = sour(i)</p>
<p>j = j + 1</p>
<p>If j >= (destU - destL) + 1 Then</p>
<p>Exit For</p>
<p>End If</p>
<p>Next i</p>
<p>End Sub</p>
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -