如何通过API的调用,来知道拨号网络中有多少个连接,并且知道每一个连接的名称!!

Question

Option ExplicitPublic Const RAS_MAXDEVICETYPE As Integer = 16
Public Const RAS_MAXDEVICENAME As Integer = 128
Public Const RAS_MAXENTRYNAME As Integer = 256
Public Const RAS_RASCONNSIZE As Integer = 412Public Type RASCONN95
    'set dwsize to 412
    dwSize As Long
    hRasConn As Long
    szEntryName(RAS_MAXENTRYNAME) As Byte
    szDeviceType(RAS_MAXDEVICETYPE) As Byte
    szDeviceName(RAS_MAXDEVICENAME) As Byte
End TypePublic Type RASCONNSTATUS95
    dwSize As Long
    RasConnState As Long
    dwError As Long
    szDeviceType(RAS_MAXDEVICETYPE) As Byte
    szDeviceName(RAS_MAXDEVICENAME) As Byte
End TypePublic Type RASENTRYNAME95
    'set dwsize to 264
    dwSize As Long
    szEntryName(RAS_MAXENTRYNAME) As Byte
End Type
Public Declare Function RasEnumConnections Lib "rasapi32.dll" Alias "RasEnumConnectionsA" (lpRasConn As Any, lpcb As Long, lpcConnections As Long) As Long
Public Declare Function RasEnumEntries Lib "rasapi32.dll" Alias "RasEnumEntriesA" (ByVal Reserved As String, ByVal lpszPhonebook As String, lprasentryname As Any, lpcb As Long, lpcEntries As Long) As Long
Public Declare Function RasGetConnectStatus Lib "rasapi32.dll" Alias "RasGetConnectStatusA" (ByVal hRasCon As Long, lpStatus As Any) As Long
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 Type
Public Function IsConnected() As Boolean     '//是否连接上
Dim TRasCon(255) As RASCONN95
Dim lg As Long
Dim lpcon As Long
Dim RetVal As Long
Dim Tstatus As RASCONNSTATUS95
'
TRasCon(0).dwSize = 412
lg = 256 * TRasCon(0).dwSize
'
RetVal = RasEnumConnections(TRasCon(0), lg, lpcon)
If RetVal <> 0 Then
    MsgBox "ERROR"
    Exit Function
End If
'
Tstatus.dwSize = 160
RetVal = RasGetConnectStatus(TRasCon(0).hRasConn, Tstatus)
If Tstatus.RasConnState = &H2000 Then
    IsConnected = True
Else
    IsConnected = False
End IfEnd FunctionPublic Function down_f(soft_type As String, ftplocadir As String) As String                             '// 从网上下载文件过程Dim lfile As String, rfile As StringDim pData As WIN32_FIND_DATA
Dim bActiveSession As Boolean
Dim hOpen As Long, hConnection As Long
Dim dwType As Long
Dim bRet As Boolean
Dim hFind As Long
Dim oko As Boolean
bActiveSession = False
hOpen = 0
hConnection = 0
'dwType = FTP_TRANSFER_TYPE_ASCII
dwType = FTP_TRANSFER_TYPE_BINARY'//打开通讯
'  DoEvents
 hOpen = InternetOpen(scUserAgent, INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0)
 If hOpen = 0 Then
   MsgBox "对不起，打开通讯出现问题！" & Err.LastDllError, vbOKOnly, "提示"
   down_f = "网络连接出现问题！"
   Exit Function
 End If '//开始连接
 Dim nFlag As Long
 nFlag = INTERNET_FLAG_PASSIVE
 ' nFlag = 0
' bb = INTERNET_INVALID_PORT_NUMBER
Dim servertxt, usertxt, passtxt As String
servertxt = "www.sz-it.com"
usertxt = "sz-it"
passtxt = "sz-it01045"
' DoEvents
hConnection = InternetConnect(hOpen, servertxt, 21, _
        usertxt, passtxt, INTERNET_SERVICE_FTP, nFlag, 0)If hConnection = 0 Then
   'MsgBox "对不起，网络联接出现问题！" & Err.LastDllError, vbOKOnly, "提示"
   down_f = "升级服务器连接出现问题！"
   Exit Function
End If
     
bActiveSession = True'//开始查找文件
 pData.cFileName = String(MAX_PATH, 0)
 hFind = FtpFindFirstFile(hConnection, soft_type & "/*.zip", pData, 0, 0)
 DoEvents
 w_no4.List1.AddItem "正在下载文件名 ->> " & pData.cFileName
 w_no4.List1.AddItem "此文件大小为 ->>" & pData.nFileSizeLow
 rfile = Left(pData.cFileName, InStr(1, pData.cFileName, String(1, 0), vbBinaryCompare) - 1)
 If hFind <> 0 Then
    'MsgBox rfile, vbOKOnly, "ok"
    '//开始下载文件
    lfile = ftplocadir + "\" + rfile
    rfile = soft_type + "/" + rfile
    DoEvents
    bRet = FtpGetFile(hConnection, rfile, lfile, False, _
        INTERNET_FLAG_RELOAD, dwType, 0)
    If bRet <> False Then
                              'MsgBox "下载完成！", vbOKOnly, "提示"
       'oko = FtpDeleteFile(hConnection, rfile)        '删除已下载的文件
    Else
        '//没有下载成功，作处理
    End If
    Do
        DoEvents
        pData.cFileName = String(MAX_PATH, 0)
        bRet = InternetFindNextFile(hFind, pData)
        w_no4.List1.AddItem "正在下载文件名 ->> " & pData.cFileName
        w_no4.List1.AddItem "此文件大小为 ->>" & pData.nFileSizeLow
        rfile = Left(pData.cFileName, InStr(1, pData.cFileName, String(1, 0), vbBinaryCompare) - 1)
        If bRet Then
          '//开始下载文件
           w_no4.List1.AddItem "正在下载文件名 ->> " & pData.cFileName
           w_no4.List1.AddItem "此文件大小为 ->>" & pData.nFileSizeLow
           lfile = ftplocadir + "\" + rfile
           rfile = soft_type + "/" + rfile
           DoEvents
           bRet = FtpGetFile(hConnection, rfile, lfile, False, _
           INTERNET_FLAG_RELOAD, dwType, 0)
           If bRet <> False Then
                                                           'MsgBox "下载完成！", vbOKOnly, "提示"
'           oko = FtpDeleteFile(hConnection, rfile)        '删除已下载的文件
           Else
                                                          '//没有下载成功，作处理
           End If
        'InternetCloseHandle (hFind)
       Else
          
          InternetCloseHandle (hFind)
          Exit Do
       End If
    Loop
'//断开连接
down_f = "ok"
Else
down_f = "软件还没有最新的版本！"
End If
If hConnection <> 0 Then InternetCloseHandle (hConnection)
   If hOpen <> 0 Then InternetCloseHandle (hOpen)
hConnection = 0
hOpen = 0End Function
Public Sub add_bh(list_1 As ComboBox)          '//枚举所有连接放入COMBO
    Dim s As Long, l As Long, ln As Long, A$
    ReDim R(255) As RASENTRYNAME95
    
    R(0).dwSize = 264
    s = 256 * R(0).dwSize
    l = RasEnumEntries(vbNullString, vbNullString, R(0), s, ln)
    For l = 0 To ln - 1
        A$ = StrConv(R(l).szEntryName(), vbUnicode)
        list_1.AddItem Left$(A$, InStr(A$, Chr$(0)) - 1)
    Next
    On Error GoTo E
    list_1.ListIndex = -1
    Exit Sub
E:
    MsgBox "你可能没安装拨号网络！", , "网络拨号"
End Sub