Just paste this code into a new class module and change the name of the class to DialUpNetworking. Ideally this should be added to the class we introduced last week (Part 1 of the Dial-Up Networking Series).
'----------------------------------------------------------------------
'
' Module Name: DialUpNetworking
' Written By: C&D Programming Corp.
' Create Date: 3/98
' Copyright: Copyright 1998 by C&D Programming Corp. Source
' code may not be reproduced except for use in a
' compiled executable. All rights reserved. If
' you would like to reprint any or all of this
' code please email us at info@codeoftheweek.com
'----------------------------------------------------------------------
Option Explicit
'
' The below two lines were included in Part 1 of the
' Dial-Up Networking Series. If you are interested in
' getting Part 1 you can subscribe to COTW at
' http://www.codeoftheweek.com/order.html. Part 1 included
' code for dialing and hanging up a DUN connection.
'
Dim mlError As Long
Private Const SUCCESS = 0 ' this was included in Part 1.
'
' All the following code is specific to Part 2.
'
Private Const RAS_MaxEntryName = 256
'
' Structure to hold the entry name information
'
Private Type RASENTRYNAME
'set dwsize to 264
dwSize As Long
szEntryName(RAS_MaxEntryName) As Byte
End Type
'
' Function to retrieve available phone book entries
'
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
Dim saEntryNames() As String ' to hold the DUN entry info
Dim mlEntries As Long ' number of entries found
'
' Used to trim the nulls off the end of a string
'
Private Function TrimNulls(sData As String)
Dim lNullLocation As Long
lNullLocation = InStr(sData, vbNullChar)
If lNullLocation = 0 Then
TrimNulls = sData
Else
TrimNulls = Left$(sData, lNullLocation - 1)
End If
End Function
'
' Calls the RAS API to retrieve the available phone
' entries for use by DUN. This code will only with
' Windows 95
'
Private Function GetEntriesInArray() As Boolean
Dim lStructureSize As Long ' stores the size of the
' ENTRYNAME structure
Dim iArraySize As Integer ' the number of elements
Dim iCount As Integer ' temporary counter
Dim lEntries As Long ' number of entries found
' Putting a maximum of 256 Entries. This should be
' adequate for all the machines with DUN.
iArraySize = 255
' Allocates the memory to hold the entry names
ReDim EntryName(iArraySize) As RASENTRYNAME
' make sure the structure has the right length so the API
' knows how to handle it.
EntryName(0).dwSize = 264
lStructureSize = 256 * EntryName(0).dwSize
mlEntries = 0
mlError = RasEnumEntries(vbNullString, vbNullString, _
EntryName(0), lStructureSize, lEntries)
If mlError = SUCCESS Then
If lEntries > 0 Then
'resize array so that it is correct size based on return from function
ReDim saEntryNames(0 To lEntries - 1)
For iCount = 0 To UBound(saEntryNames())
saEntryNames(iCount) = TrimNulls(StrConv(EntryName(iCount).szEntryName, vbUnicode))
Next
Else
Erase saEntryNames
End If
mlEntries = lEntries
End If
Erase EntryName
GetEntriesInArray = (mlError = SUCCESS)
End Function
'
' Put the DUN entries into an array, combobox or listbox. If
' it returns false you should call the ErrorMessage function
' to get the complete error description.
'
Public Function GetEntries(List As Variant) As Boolean
Dim x As Long
If GetEntriesInArray Then
If mlEntries = 0 Then
GetEntries = True
Exit Function
End If
Select Case LCase$(TypeName(List))
Case "combobox", "listbox"
For x = LBound(saEntryNames) To UBound(saEntryNames)
List.AddItem saEntryNames(x)
List.ItemData(List.NewIndex) = x
Next
Case "string()", "variant"
ReDim List(LBound(saEntryNames) To UBound(saEntryNames))
For x = LBound(saEntryNames) To UBound(saEntryNames)
List(x) = saEntryNames(x)
Next
End Select
End If
GetEntries = True
End Function