form1.frm

主要是网络和数据库的一些东东

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "监测网络"
   ClientHeight    =   2130
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   2685
   LinkTopic       =   "Form1"
   ScaleHeight     =   2130
   ScaleWidth      =   2685
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command3 
      Caption         =   "查看连接状态"
      Height          =   495
      Left            =   120
      TabIndex        =   2
      Top             =   1440
      Width           =   2295
   End
   Begin VB.CommandButton Command2 
      Caption         =   "挂断连接"
      Height          =   375
      Left            =   120
      TabIndex        =   1
      Top             =   840
      Width           =   2295
   End
   Begin VB.CommandButton Command1 
      Caption         =   "建立拨号上网的连接"
      Height          =   495
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   2295
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
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
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

'查看连接
Public Function ActiveConnection() 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
    ActiveConnection = 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
                ActiveConnection = False
            Else
                ActiveConnection = True
            End If
        End If
        RegCloseKey (hKey)
    End If
End Function

Private Sub Command1_Click()
    Dim res
    '调用拨号网络。
    res = Shell("rundll32.exe rnaui.dll,RnaDial " & "connection_name", 1)
End Sub

Private Sub Command2_Click()
    Call HangUp
End Sub

Private Sub Command3_Click()
    If ActiveConnection = True Then
        Call MsgBox("现在处于链结状态。", vbInformation)
    Else
        Call MsgBox("现在处于断开状态。", vbInformation)
    End If
End Sub