Source code for Issue Number 31

Copyright 1997-2000 by C&D Programming Corp. All Rights Reserved. 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

Code of the Week Home

Source Code

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
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
'  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
    '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
        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))
            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
            Case "string()", "variant"
                ReDim List(LBound(saEntryNames) To UBound(saEntryNames))
                For x = LBound(saEntryNames) To UBound(saEntryNames)
                    List(x) = saEntryNames(x)
        End Select
    End If
    GetEntries = True
End Function