• 拨号、断网、枚举连接名称,判断是否在线、连接方式


    Option Explicit
    '拨号/断网
    Private Declare Function InternetDial Lib "wininet.dll" (ByVal hwndParent As Long, ByVal lpszConnectoid As String, ByVal dwFlags As Long, lpdwConnection As Long, ByVal dwReserved As Long) As Long
    Private Declare Function InternetHangUp Lib "wininet.dll" (ByVal dwConnection As Long, ByVal dwReserved As Long) As Long
    Private Declare Function InternetAutodial Lib "wininet.dll" (ByVal dwFlags As Long, ByVal dwReserved As Long) As Long
    Private Declare Function InternetAutodialHangup Lib "wininet.dll" (ByVal dwReserved As Long) As Long
    Private Const INTERNET_DIALSTATE_DISCONNECTED = 1
    Private Const INTERNET_AUTODIAL_FORCE_ONLINE = 1
    Private Const INTERNET_AUTODIAL_FORCE_UNATTENDED = 2
    Private Const INTERNET_DIAL_UNATTENDED = &H8000
    Private Handle As Long

    '网络状态
    Private Declare Function InternetGetConnectedStateEx Lib "wininet.dll" Alias "InternetGetConnectedStateExA" (ByRef lpdwFlags As Long, ByVal lpszConnectionName As String, ByVal dwNameLen As Long, ByVal dwReserved As Long) As Long
    Private Declare Function InternetGetConnectedState Lib "wininet.dll" (ByRef dwFlags As Long, ByVal dwReserved As Long) As Long
    Private Const INTERNET_CONNECTION_MODEM As Long = &H1      '本系统使用调制解调器与因特网相连
    Private Const INTERNET_CONNECTION_LAN As Long = &H2        '本系统通过LAN与因特网相连
    Private Const INTERNET_CONNECTION_PROXY As Long = &H4      '本系统使用proxy代理服务器与因特网相连
    Private Const INTERNET_CONNECTION_MODEM_BUSY As Long = &H8 '未使用
    Private Const INTERNET_RAS_INSTALLED As Long = &H10
    Private Const INTERNET_CONNECTION_OFFLINE As Long = &H20
    Private Const INTERNET_CONNECTION_CONFIGURED As Long = &H40

    '枚举网络连接
    Private Const RAS_MaxDeviceType = 16
    Private Const RAS95_MaxDeviceName = 128
    Private Const RAS95_MaxEntryName = 256
    Private Type RASCONN95
        dwSize As Long
        hRasConn As Long
        szEntryName(RAS95_MaxEntryName) As Byte
        szDeviceType(RAS_MaxDeviceType) As Byte
        szDeviceName(RAS95_MaxDeviceName) As Byte
    End Type
    Private Type RASENTRYNAME95
        dwSize As Long
        szEntryName(RAS95_MaxEntryName) As Byte
    End Type
    Private Declare Function RasEnumConnections Lib "rasapi32.dll" Alias "RasEnumConnectionsA" (lprasconn As Any, lpcb As Long, lpcConnections As Long) As Long
    Private 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
    Private Declare Function RasHangUp Lib "rasapi32.dll" Alias "RasHangUpA" (ByVal hRasConn As Long) As Long

    '拨号
    Public Function DialUp(LinkName As String) As Boolean
        InternetDial 0, LinkName, INTERNET_AUTODIAL_FORCE_UNATTENDED, Handle, 0
        DialUp = (Handle <> 0)
    End Function
    '断网
    Public Sub HangUp()
        If Handle <> 0 Then
            InternetHangUp Handle, 0
            Handle = 0
        End If
    End Sub


    '枚举网络连接
    Public Sub EnumConnectName(Value() As String)
        Dim s As Long, l As Long, ln As Long, a As String
        ReDim r(255) As RASENTRYNAME95

        r(0).dwSize = 264
        s = 256 * r(0).dwSize
        l = RasEnumEntries(vbNullString, vbNullString, r(0), s, ln)
        ReDim Value(ln - 1)
        For l = 0 To ln - 1
            a = StrConv(r(l).szEntryName(), vbUnicode)
            Value(l) = Left$(a$, InStr(a$, Chr$(0)) - 1)
        Next
    End Sub

    '判断是否在线
    Public Function Online() As Boolean
        Online = InternetGetConnectedState(0&, 0&)
    End Function
    '判断是否在线并返回连接方式
    Public Property Get OnlineOfLinkName(LinkName As String) As Boolean
        LinkName = Space$(128)
        OnlineOfLinkName = InternetGetConnectedStateEx(0, LinkName, 128, 0&)
    End Property

    '如果是通过LAN的连接,则返回True
    Public Function IsNetConnectViaLAN() As Boolean
        Dim dwFlags As Long
        Call InternetGetConnectedState(dwFlags, 0&)
        IsNetConnectViaLAN = dwFlags And INTERNET_CONNECTION_LAN
    End Function
    '如果是通过调制解调器的连接,则返回True
    Public Function IsNetConnectViaModem() As Boolean
        Dim dwFlags As Long
        Call InternetGetConnectedState(dwFlags, 0&)
        IsNetConnectViaModem = dwFlags And INTERNET_CONNECTION_MODEM
    End Function
    '如果是通过Proxy代理服务器的连接,则返回True
    Public Function IsNetConnectViaProxy() As Boolean
        Dim dwFlags As Long
        Call InternetGetConnectedState(dwFlags, 0&)
        IsNetConnectViaProxy = dwFlags And INTERNET_CONNECTION_PROXY
    End Function
    '如果已安装了RAS,则返回True
    Public Function IsNetRASInstalled() As Boolean
        Dim dwFlags As Long
        Call InternetGetConnectedState(dwFlags, 0&)
        IsNetRASInstalled = dwFlags And INTERNET_RAS_INSTALLED
    End Function
    '返回当前网络状态信息字符串
    Public Function GetNetConnectString() As String
        Dim dwFlags As Long
        Dim msg As String
        If InternetGetConnectedState(dwFlags, 0&) Then
            If dwFlags And INTERNET_CONNECTION_CONFIGURED Then
                msg = msg & "系统配置了网络连接" & vbCrLf
            End If
            If dwFlags And INTERNET_CONNECTION_LAN Then
                msg = msg & "系统通过局域网与因特网相连接"
            End If
            If dwFlags And INTERNET_CONNECTION_PROXY Then
                msg = msg & "并使用了Proxy代理服务"
            Else: msg = msg & "."
            End If
            If dwFlags And INTERNET_CONNECTION_MODEM Then
                msg = msg & "系统使用调制解调器与因特网相连接"
            End If
            If dwFlags And INTERNET_CONNECTION_OFFLINE Then
                msg = msg & "系统当前处于离线状态"
            End If
            If dwFlags And INTERNET_CONNECTION_MODEM_BUSY Then
                msg = msg & "系统的调制解调器未连接到因特网"
            End If
            If dwFlags And INTERNET_RAS_INSTALLED Then
                msg = msg & "本系统安装了远程访问服务"
            End If
        Else
            msg = "当前未与因特网相连"
        End If
        GetNetConnectString = msg
    End Function

  • 相关阅读:
    Tomcat && Servlet
    List,Set,Collections工具类
    多表查询
    常用的API--集合
    msmpeng.exe阻止移动硬盘弹出
    接口400错误解析
    JDBC/Mybatis连接数据库报错:The server time zone value 'Öйú±ê׼ʱ¼ä' is unrecognized or represents more than one time zone.
    tomcat启动报错:A child container failed during start
    PAT 1019 数字黑洞
    PAT 1017 A除以B
  • 原文地址:https://www.cnblogs.com/MaxWoods/p/3170759.html
Copyright © 2020-2023  润新知