dun.frm

vb代码集,收集许多VB网络编程代码

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Dun Sample"
   ClientHeight    =   3660
   ClientLeft      =   1260
   ClientTop       =   2070
   ClientWidth     =   5670
   LinkTopic       =   "Form1"
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   3660
   ScaleWidth      =   5670
   Begin VB.ListBox List2 
      Height          =   1500
      Left            =   2760
      TabIndex        =   4
      Top             =   360
      Width           =   2775
   End
   Begin VB.CommandButton Command2 
      Caption         =   "Status"
      Height          =   495
      Left            =   3420
      TabIndex        =   3
      Top             =   2280
      Width           =   1695
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Connect"
      Height          =   495
      Left            =   3420
      TabIndex        =   2
      Top             =   3000
      Width           =   1695
   End
   Begin VB.ListBox List1 
      Height          =   3120
      Left            =   60
      TabIndex        =   1
      Top             =   360
      Width           =   2535
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      Caption         =   "Dial-Up Connections"
      Height          =   255
      Left            =   120
      TabIndex        =   0
      Top             =   60
      Width           =   3075
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False


Option Explicit

' Dun sample from BlackBeltVB.com
' http://blackbeltvb.com
'
' Written by Matt Hart
' Copyright 1999 by Matt Hart
'
' This software is FREEWARE. You may use it as you see fit for
' your own projects but you may not re-sell the original or the
' source code. Do not copy this sample to a collection, such as
' a CD-ROM archive. You may link directly to the original sample
' using "http://blackbeltvb.com/dun.htm"
'
' No warranty express or implied, is given as to the use of this
' program. Use at your own risk.
'
' This sample shows how to fire up a DUN (Dial Up Networking)
' connection and see if it is online. There are a lot more
' API functions available in the RAS API. You can download an excellent
' sample program from Microsoft called VB32RAS.EXE at:
' http://support.microsoft.com/support/downloads/dp2109.asp
'
' Christian Gustavo Riva gave me the NT dial version. Thanks Christian!

Private Const RAS_MaxDeviceType = 16
Private Const RAS95_MaxDeviceName = 128
Private Const RAS95_MaxEntryName = 256
Private Type RASCONN95
    'set dwsize to 412
    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
    'set dwsize to 264
    dwSize As Long
    szEntryName(RAS95_MaxEntryName) As Byte
End Type
Private Type RASDEVINFO
    dwSize As Long
    szDeviceType(RAS_MaxDeviceType) As Byte
    szDeviceName(RAS95_MaxDeviceName) As Byte
End Type
Private Declare Function RasEnumDevices Lib "RasApi32.DLL" Alias "RasEnumDevicesA" (lprasdevinfo As Any, lpcb As Long, lpcConnections As Long) As Long
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 Sub Command1_Click()
    Dim a$
    a$ = "rundll rnaui.dll,RnaDial " & List1.List(List1.ListIndex)
    ' NT Version
    ' a$ = "rasphone.exe " & Chr$(34) & List1.List(List1.ListIndex) & Chr$(34)
    Shell a$, vbNormalFocus
End Sub

Private Sub Command2_Click()
    Dim s As Long, l As Long, ln As Long, a$, b$
    
    b$ = List1.List(List1.ListIndex)
    ReDim R(255) As RASCONN95
    
    R(0).dwSize = 412
    s = 256 * R(0).dwSize
    l = RasEnumConnections(R(0), s, ln)
    For l = 0 To ln - 1
        a$ = StrConv(R(l).szEntryName(), vbUnicode)
        a$ = Left$(a$, InStr(a$, Chr$(0)) - 1)
        If a$ = b$ Then MsgBox "Connected (or connecting)!": Exit Sub
    Next
    MsgBox "Not Connected!"
End Sub

Private Sub Form_Load()
    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)
        List1.AddItem Left$(a$, InStr(a$, Chr$(0)) - 1)
    Next
    On Local Error Resume Next
    List1.ListIndex = 0
    
    
    ReDim Rd(255) As RASDEVINFO
    
    Rd(0).dwSize = Len(Rd(0)) + 3
    s = 256 * Rd(0).dwSize
    l = RasEnumDevices(Rd(0), s, ln)
    For l = 0 To ln - 1
        a$ = StrConv(Rd(l).szDeviceName(), vbUnicode)
        List2.AddItem Left$(a$, InStr(a$, Chr$(0)) - 1)
    Next
    List2.ListIndex = 0
End Sub