枚举当前活动的拨号连接

'###############窗体代码######################
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmMain
    BorderStyle      =    1   'Fixed Single
    Caption          =    "枚举当前活动的拨号连接"
    ClientHeight     =    3795
    ClientLeft       =    45
    ClientTop        =    375
    ClientWidth      =    6525
    Icon             =    "frmMain.frx":0000
    LinkTopic        =    "Form1"
    MaxButton        =    0    'False
    MinButton        =    0    'False
    ScaleHeight      =    3795
    ScaleWidth       =    6525
    StartUpPosition =    2   '屏幕中心
    Begin VB.Timer Timer1
       Interval         =    1000
       Left             =    120
       Top              =    3240
    End
    Begin VB.CommandButton cmdHangUp
       Caption          =    "挂断(&H)"
       Height           =    495
       Left             =    5160
       TabIndex         =    2
       Top              =    3240
       Width            =    1215
    End
    Begin MSComctlLib.ListView ListView1
       Height           =    2535


       Left             =    120
       TabIndex         =    0
       Top              =    600
       Width            =    6255
       _ExtentX         =    11033
       _ExtentY         =    4471
       View             =    3
       LabelEdit        =    1
       LabelWrap        =    -1   'True
       HideSelection    =    0    'False
       FullRowSelect    =    -1   'True
       _Version         =    393217
       ForeColor        =    -2147483640
       BackColor        =    -2147483643
       Appearance       =    1
       NumItems         =    4
       BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628}
          Text             =    "编号"
          Object.Width            =    1411
       EndProperty
       BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628}
          SubItemIndex     =    1
          Text             =    "连接名称"
          Object.Width            =    2540
       EndProperty


       BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628}
          SubItemIndex     =    2
          Text             =    "设备名称"
          Object.Width            =    4410
       EndProperty
       BeginProperty ColumnHeader(4) {BDD1F052-858B-11D1-B16A-00C0F0283628}
          SubItemIndex     =    3
          Text             =    "设备类型"
          Object.Width            =    2540
       EndProperty
    End
    Begin VB.Label Label1
       Caption          =    "当前活动的拨号连接："
       Height           =    255
       Left             =    120
       TabIndex         =    1
       Top              =    240
       Width            =    2055
    End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub cmdHangUp_Click()
     With ListView1.SelectedItem
         If ListView1.SelectedItem Is Nothing Then Exit Sub
         If MsgBox("您确定要挂断选中连接吗?", 48 + vbYesNo, "提示") <> vbYes Then Exit Sub
         If .Tag > 0 Then
             RasHangUp .Tag
         End If
     End With
End Sub
Private Sub Timer1_Timer()
     Dim Conns As Long '记录当前连接数
     ReDim RasConn(255) As RASCONN95 '记录


     Dim lRet As Long '接受枚举返回
     Dim lSize As Long '数组总长度
     Dim i As Long '循环变量
     Dim j As Long '循环变量
     Dim Item As ListItem '列表项
    
     RasConn(0).dwSize = 412
     lSize = RasConn(0).dwSize * 255
    
     lRet = RasEnumConnections(RasConn(0), lSize, Conns)
    
     '排除枚举错
     If lRet <> 0 Then Exit Sub
    
     '排除空连接
     If Conns = 0 Then
         ListView1.ListItems.Clear '清空
         Exit Sub
     End If
    
     '遍历所有连接查看是否已经存在列表中, 如果没有存在再做添加
     For i = 0 To Conns - 1
         '如果在这循环中找到了指定项 跳转到下一条
         For Each Item In ListView1.ListItems
             If Item.Tag = RasConn(i).hRasConn Then GoTo lblNext
         Next
         '添加进列表
         Set Item = ListView1.ListItems.Add(, , "")
         Item.ListSubItems.Add , , StrConv(RasConn(i).szEntryName, vbUnicode) '连接名称
         Item.ListSubItems.Add , , StrConv(RasConn(i).szDeviceName, vbUnicode) '设备名称
         Item.ListSubItems.Add , , StrConv(RasConn(i).szDeviceType, vbUnicode) '设备类型
         Item.Tag = RasConn(i).hRasConn
lblNext:
     Next
    
     '删除列表中无效的项
     For j = ListView1.ListItems.Count To 1 Step -1
         For i = 0 To Conns - 1
             If ListView1.ListItems(j).Tag = RasConn(i).hRasConn Then GoTo lblValid
         Next
         ListView1.ListItems.Remove (j)
lblValid:
     Next
    
End Sub


'######################模块代码#############################
Attribute VB_Name = "Mod_Declare"
Option Explicit
Public Const RAS95_MaxEntryName = 256
Public Const RAS95_MaxDeviceName = 128
Public Const RAS_MaxDeviceType = 16
Public Type RASCONN95
     'set dwsize to 412
     dwSize As Long
     hRasConn As Long
     szEntryName(RAS95_MaxEntryName) As Byte
     szDeviceType(RAS_MaxDeviceType) As Byte
     szDeviceName(RAS95_MaxDeviceName) As Byte
End Type
Public Declare Function RasHangUp Lib "RasApi32.DLL" Alias "RasHangUpA" (ByVal hRasConn As Long) As Long
Public Declare Function RasEnumConnections Lib "RasApi32.DLL" Alias "RasEnumConnectionsA" (lprasconn As Any, lpcb As Long, lpcConnections As Long) As Long


源码在此: http://ishare.iask.sina.com.cn/f/12631541.html

让我想起一个很给力的工具 但忘记在哪里找到的了。
ADSL密码查看工具 连路由也能查。虽然路由密码没改。但好多工具都不能查。