form1.frm

本文件包含200个visual baisc实例

VERSION 5.00
Begin VB.Form form1 
   Caption         =   "获得拨号网络的列表并拨号"
   ClientHeight    =   3660
   ClientLeft      =   1260
   ClientTop       =   2070
   ClientWidth     =   5220
   LinkTopic       =   "Form1"
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   3660
   ScaleWidth      =   5220
   StartUpPosition =   1  '所有者中心
   Begin VB.CommandButton Command2 
      Caption         =   "退出"
      Height          =   495
      Left            =   2715
      TabIndex        =   4
      Top             =   3075
      Width           =   1485
   End
   Begin VB.Timer Timer1 
      Interval        =   600
      Left            =   450
      Top             =   3150
   End
   Begin VB.CommandButton Command1 
      Caption         =   "连接"
      Height          =   495
      Left            =   1065
      TabIndex        =   2
      Top             =   3075
      Width           =   1485
   End
   Begin VB.ListBox List1 
      Height          =   2580
      Left            =   75
      TabIndex        =   1
      Top             =   360
      Width           =   5085
   End
   Begin VB.Label Label2 
      Caption         =   "Label2"
      Height          =   225
      Left            =   1590
      TabIndex        =   3
      Top             =   120
      Width           =   3555
   End
   Begin VB.Label Label1 
      Caption         =   "拨号网络列表"
      Height          =   240
      Left            =   90
      TabIndex        =   0
      Top             =   120
      Width           =   1170
   End
End
Attribute VB_Name = "form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
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

Const RAS_MaxDeviceType = 16
Const RAS95_MaxDeviceName = 128
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 Sub Form_Load()
  Dim lpcb, l As Long, lpce As Long
  Dim link As String
  Dim i As Integer
  ReDim ipr(255) As RASENTRYNAME95
  ipr(0).dwSize = 264
  lpcb = 256 * ipr(0).dwSize
  i = RasEnumEntries(vbNullString, vbNullString, ipr(0), lpcb, lpce)
  If lpce <> 0 Then    '获取拨号链接列表
     For i = 0 To lpce - 1
         link = StrConv(ipr(i).szEntryName(), vbUnicode)
         List1.AddItem Left(link, InStr(link, Chr(0)) - 1)
     Next
  End If
End Sub

Private Sub Timer1_Timer()
  Dim lpcb As Long, lpce As Long
  Dim link As String
  Dim i As Integer
  ReDim ipr(255) As RASCONN95
  ipr(0).dwSize = 412
  lbcb = 256 * ipr(0).dwSize
  i = RasEnumConnections(ipr(0), lpcb, lpce)
  For i = 0 To lpce - 1
      link = StrConv(ipr(i).szEntryName(), vbUnicode)
      link = Left$(link, InStr(link, Chr$(0)) - 1)
      If link = List1.List(List1.ListIndex) Then    '判断是否连接internet
         Label2.Caption = List1.Text & "  已经连接"
         Exit Sub
      End If
  Next
  Label2.Caption = "拨号网络没有连接"
End Sub

Private Sub Command1_Click()   '拨号链接
  Dim mtval
  On Error GoTo error
  mtval = "rundll rnaui.dll,RnaDial " & List1.List(List1.ListIndex)
  Shell mtval, vbNormalFocus
error:
  MsgBox ("没有拨号链接")
End Sub

Private Sub Command2_Click()
  End
End Sub