要在 VB 程序中中断【拨号网路连线】,可以使用 Remote Access Services Hangup 函数:´在模组的声明区中加入以下声明及模组:Public Const RAS_MAXENTRYNAME As Integer = 256
Public Const RAS_MAXDEVICETYPE As Integer = 16
Public Const RAS_MAXDEVICENAME As Integer = 128
Public Const RAS_RASCONNSIZE As Integer = 412
Public Const ERROR_SUCCESS = 0&Public Type RasEntryName
dwSize As Long
szEntryName(RAS_MAXENTRYNAME) As Byte
End TypePublic Type RasConn
dwSize As Long
hRasConn As Long
szEntryName(RAS_MAXENTRYNAME) As Byte
szDeviceType(RAS_MAXDEVICETYPE) As Byte
szDeviceName(RAS_MAXDEVICENAME) As Byte
End TypePublic Declare Function RasEnumConnections Lib _
"rasapi32.dll" Alias "RasEnumConnectionsA" (lpRasConn As _
Any, lpcb As Long, lpcConnections As Long) As LongPublic Declare Function RasHangUp Lib "rasapi32.dll" Alias _
"RasHangUpA" (ByVal hRasConn As Long) As LongPublic gstrISPName As String
Public ReturnCode As LongPublic Sub HangUp()
Dim i As Long
Dim lpRasConn(255) As RasConn
Dim lpcb As Long
Dim lpcConnections As Long
Dim hRasConn As LonglpRasConn(0).dwSize = RAS_RASCONNSIZE
lpcb = RAS_MAXENTRYNAME * lpRasConn(0).dwSize
lpcConnections = 0
ReturnCode = RasEnumConnections(lpRasConn(0), lpcb, lpcConnections)
If ReturnCode = ERROR_SUCCESS Then
For i = 0 To lpcConnections - 1
If Trim(ByteToString(lpRasConn(i).szEntryName)) = Trim(gstrISPName) Then
hRasConn = lpRasConn(i).hRasConn
ReturnCode = RasHangUp(ByVal hRasConn)
End If
Next i
End If
End SubPublic Function ByteToString(bytString() As Byte) As String
Dim i As Integer
ByteToString = ""
i = 0
While bytString(i) = 0&
ByteToString = ByteToString & Chr(bytString(i))
i = i + 1
Wend
End Function´在程序中使用实例为 Call HangUp

解决方案 »

  1.   

    Private hConn as Long
    Private Sub Command1_Click()
      hConn = Dialup("我的连线", "user", "passwd")
      if hConn = 0 Then
         Debug.Print "连线失败"
      end if
    End SubPrivate Sub Command2_Click()
      Call HangUp(hConn)
    End Sub'注释:以下在模块中
    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