moddialup.bas

功能强大的API

Attribute VB_Name = "Module1"
Option Explicit
'****************************************
'汉化: 小聪明       [e-mail]
'小聪明的主页VB版:  http://coolzm.533.net
'****************************************
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003
Public Const HKEY_PERFORMANCE_DATA = &H80000004
Public Const HKEY_CURRENT_CONFIG = &H80000005
Public Const HKEY_DYN_DATA = &H80000006
Public Const ERROR_SUCCESS = 0&
Public Const APINULL = 0&
Public Const MAX_STRING_LENGTH As Integer = 256

Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long

Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
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 Type RasEntryName
    dwSize As Long
    szEntryName(RAS_MAXENTRYNAME) As Byte
End Type

Public 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 Declare Function RasEnumConnections Lib "rasapi32.dll" Alias "RasEnumConnectionsA" (lpRasConn As Any, lpcb As Long, lpcConnections As Long) As Long


Public Declare Function RasHangUp Lib "rasapi32.dll" Alias "RasHangUpA" (ByVal hRasConn As Long) As Long

Public gstrISPName As String
Public ReturnCode As Long
                        
        
'如果已经连接到Internet则返回True,否则返回False
Public Function Connected_To_ISP() As Boolean


    Dim hKey As Long
    Dim lpSubKey As String
    Dim phkResult As Long
    Dim lpValueName As String
    Dim lpReserved As Long
    Dim lpType As Long
    Dim lpData As Long
    Dim lpcbData As Long
    Connected_To_ISP = False
    lpSubKey = "System\CurrentControlSet\Services\RemoteAccess"
    ReturnCode = RegOpenKey(HKEY_LOCAL_MACHINE, lpSubKey, phkResult)


    If ReturnCode = ERROR_SUCCESS Then
        hKey = phkResult
        lpValueName = "Remote Connection"
        lpReserved = APINULL
        lpType = APINULL
        lpData = APINULL
        lpcbData = APINULL
        ReturnCode = RegQueryValueEx(hKey, lpValueName, lpReserved, lpType, _
        ByVal lpData, lpcbData)
        lpcbData = Len(lpData)
        ReturnCode = RegQueryValueEx(hKey, lpValueName, lpReserved, lpType, _
        lpData, lpcbData)


        If ReturnCode = ERROR_SUCCESS Then


            If lpData = 0 Then
                ' 未连接
            Else
                ' 已连接
                Connected_To_ISP = True
            End If

        End If

        RegCloseKey (hKey)
    End If

End Function

'断开拨号连接
Public Sub HangUp()

    Dim i As Long
    Dim lpRasConn(255) As RasConn
    Dim lpcb As Long
    Dim lpcConnections As Long
    Dim hRasConn As Long

    lpRasConn(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

Wait (3)

While Connected_To_ISP
    Wait (1)
Wend

End Sub
Public Sub Wait(sngSeconds As Single)

    Dim sngEndTime As Single
    sngEndTime = Timer + sngSeconds

    While Timer < sngEndTime
        DoEvents
    Wend

End Sub

'把字节格式转换为字符串格式
Public 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

'返回所连接的ISP的名称
Public Function Get_ISP_Name() As String

    Dim hKey As Long
    Dim lpSubKey As String
    Dim phkResult As Long
    Dim lpValueName As String
    Dim lpReserved As Long
    Dim lpType As Long
    Dim lpData As String
    Dim lpcbData As Long
    Get_ISP_Name = ""


    If Connected_To_ISP Then
        lpSubKey = "RemoteAccess"
        ReturnCode = RegOpenKey(HKEY_CURRENT_USER, lpSubKey, phkResult)


        If ReturnCode = ERROR_SUCCESS Then
            hKey = phkResult
            lpValueName = "Default"
            lpReserved = APINULL
            lpType = APINULL
            lpData = APINULL
            lpcbData = APINULL
            ReturnCode = RegQueryValueEx(hKey, lpValueName, lpReserved, _
            lpType, ByVal lpData, lpcbData)
            lpData = String(lpcbData, 0)
            ReturnCode = RegQueryValueEx(hKey, lpValueName, lpReserved, _
            lpType, ByVal lpData, lpcbData)


            If ReturnCode = ERROR_SUCCESS Then
                          Get_ISP_Name = Left(lpData, lpcbData - 1)
            End If

            RegCloseKey (hKey)
        End If

    End If

End Function