• Home
 · 
• Custom Controls/Forms/Menus
 · 
• Creates a DIal-Up Networking Session. Detects Multiple modems.

Creates a DIal-Up Networking Session. Detects Multiple modems.

Creates a DIal-Up Networking Session. Detects Multiple modems.

API Declarations


Public Type RASIPADDR
a As Byte
b As Byte
c As Byte
d As Byte
End Type

Public Enum RasEntryOptions
RASEO_UseCountryAndAreaCodes = &H1
RASEO_SpecificIpAddr = &H2
RASEO_SpecificNameServers = &H4
RASEO_IpHeaderCompression = &H8
RASEO_RemoteDefaultGateway = &H10
RASEO_DisableLcpExtensions = &H20
RASEO_TerminalBeforeDial = &H40
RASEO_TerminalAfterDial = &H80
RASEO_ModemLights = &H100
RASEO_SwCompression = &H200
RASEO_RequireEncryptedPw = &H400
RASEO_RequireMsEncryptedPw = &H800
RASEO_RequireDataEncryption = &H1000
RASEO_NetworkLogon = &H2000
RASEO_UseLogonCredentials = &H4000
RASEO_PromoteAlternates = &H8000
RASEO_SecureLocalFiles = &H10000
RASEO_RequireEAP = &H20000
RASEO_RequirePAP = &H40000
RASEO_RequireSPAP = &H80000
RASEO_Custom = &H100000
RASEO_PreviewPhoneNumber = &H200000
RASEO_SharedPhoneNumbers = &H800000
RASEO_PreviewUserPw = &H1000000
RASEO_PreviewDomain = &H2000000
RASEO_ShowDialingProgress = &H4000000
RASEO_RequireCHAP = &H8000000
RASEO_RequireMsCHAP = &H10000000
RASEO_RequireMsCHAP2 = &H20000000
RASEO_RequireW95MSCHAP = &H40000000
RASEO_CustomScript = &H80000000
End Enum

Public Enum RASNetProtocols
RASNP_NetBEUI = &H1
RASNP_Ipx = &H2
RASNP_Ip = &H4
End Enum

Public Enum RasFramingProtocols
RASFP_Ppp = &H1
RASFP_Slip = &H2
RASFP_Ras = &H4
End Enum


Public Type VBRasEntry
options As RasEntryOptions
CountryID As Long
CountryCode As Long
AreaCode As String
LocalPhoneNumber As String
AlternateNumbers As String
ipAddr As RASIPADDR
ipAddrDns As RASIPADDR
ipAddrDnsAlt As RASIPADDR
ipAddrWins As RASIPADDR
ipAddrWinsAlt As RASIPADDR
FrameSize As Long
fNetProtocols As RASNetProtocols
FramingProtocol As RasFramingProtocols
ScriptName As String
AutodialDll As String
AutodialFunc As String
DeviceType As String
DeviceName As String
X25PadType As String
X25Address As String
X25Facilities As String
X25UserData As String
Channels As Long
NT4En_SubEntries As Long
NT4En_DialMode As Long
NT4En_DialExtraPercent As Long
NT4En_DialExtraSampleSeconds As Long
NT4En_HangUpExtraPercent As Long
NT4En_HangUpExtraSampleSeconds As Long
NT4En_IdleDisconnectSeconds As Long
Win2000_Type As Long
Win2000_EncryptionType As Long
Win2000_CustomAuthKey As Long
Win2000_guidId(0 To 15) As Byte
Win2000_CustomDialDll As String
Win2000_VpnStrategy As Long
End Type



Rate Creates a DIal-Up Networking Session. Detects Multiple modems.

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

'in the form Dim clsVbRasEntry As VbRasEntry
'make calls as clsVbRasEntry.options = selected options
'clsVbRasEntry.LocalPhoneNumber = "555-5555" and so forth

Public Declare Function RasSetEntryProperties _
      Lib "rasapi32.dll" Alias "RasSetEntryPropertiesA" _
        (ByVal lpszPhonebook As String, _
        ByVal lpszEntry As String, _
        lpRasEntry As Any, _
        ByVal dwEntryInfoSize As Long, _
        lpbDeviceInfo As Any, _
        ByVal dwDeviceInfoSize As Long) _
As Long

Public Declare Function RasGetErrorString _
     Lib "rasapi32.dll" Alias "RasGetErrorStringA" _
      (ByVal uErrorValue As Long, ByVal lpszErrorString As String, _
       cBufSize As Long) As Long

Public Declare Function FormatMessage _
     Lib "kernel32" Alias "FormatMessageA" _
      (ByVal dwFlags As Long, lpSource As Any, _
       ByVal dwMessageId As Long, ByVal dwLanguageId As Long, _
       ByVal lpBuffer As String, ByVal nSize As Long, _
       Arguments As Long) As Long
       
Public Declare Function RasGetEntryProperties _
      Lib "rasapi32.dll" Alias "RasGetEntryPropertiesA" _
       (ByVal lpszPhonebook As String, _
        ByVal lpszEntry As String, _
        lpRasEntry As Any, _
        lpdwEntryInfoSize As Long, _
        lpbDeviceInfo As Any, _
        lpdwDeviceInfoSize As Long) As Long
        Public Type VBRASDEVINFO
   DeviceType As String
   DeviceName As String
End Type

Public Declare Function RasEnumDevices _
   Lib "rasapi32.dll" Alias "RasEnumDevicesA" ( _
        lpRasDevInfo As Any, _
        lpcb As Long, _
        lpcDevices As Long _
) As Long



Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
         (Destination As Any, Source As Any, ByVal Length As Long)
         
Global Const RAS_MaxDeviceType = 16
Global Const RAS_MaxDeviceName = 128

Global Const GMEM_FIXED = &H0
Global Const GMEM_ZEROINIT = &H40
Global Const GPTR = (GMEM_FIXED Or GMEM_ZEROINIT)

Global Const ApINULL = 0&

Type RASDEVINFO
    dwSize As Long
    szDeviceType(RAS_MaxDeviceType) As Byte
    szDeviceName(RAS_MaxDeviceName) As Byte
End Type

Declare Function iRasEnumDevices Lib "rasapi32.dll" Alias "RasEnumDevicesA" ( _
    lpRasDevInfo As Any, _
    lpcb As Long, _
    lpcDevices As Long) As Long
    
Declare Sub iCopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
         hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
         
Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long

Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long

Sub GetDevices(lst As ComboBox)
    Dim lpRasDevInfo As RASDEVINFO
    Dim lpcb As Long
    Dim cDevices As Long
    Dim t_Buff As Long
    Dim nRet As Long
    Dim t_ptr As Long
    Dim i As Long
    
    lpcb = 0

    lpRasDevInfo.dwSize = LenB(lpRasDevInfo) + (LenB(lpRasDevInfo) Mod 4)

    nRet = iRasEnumDevices(ByVal 0, lpcb, cDevices)

    t_Buff = GlobalAlloc(GPTR, lpcb)

    iCopyMemory ByVal t_Buff, lpRasDevInfo, LenB(lpRasDevInfo)
 
    nRet = iRasEnumDevices(ByVal t_Buff, lpcb, lpcb)

    If nRet = 0 Then
        t_ptr = t_Buff

        For i = 0 To cDevices - 1
            iCopyMemory lpRasDevInfo, ByVal t_ptr, LenB(lpRasDevInfo)
            lst.AddItem (ByteToString(lpRasDevInfo.szDeviceName))
            t_ptr = t_ptr + LenB(lpRasDevInfo) + (LenB(lpRasDevInfo) Mod 4)
        Next i
    Else
        MsgBox nRet
    End If
    
    If t_Buff <> 0 Then GlobalFree (t_Buff)

End Sub

Function ByteToString(bytearray() As Byte) As String
    Dim i As Integer, t As String
    i = 0
    t = ""
    While i < UBound(bytearray) And bytearray(i) <> 0
        t = t & Chr$(bytearray(i))
        i = i + 1
    Wend
    ByteToString = t
End Function

         
Function VBRasSetEntryProperties(strEntryName As String, _
         clsRasEntry As VBRasEntry, _
         Optional strPhoneBook As String) As Long
   
   Dim rtn As Long, lngCb As Long, lngBuffLen As Long
   Dim b() As Byte
   Dim lngPos As Long, lngStrLen As Long
   
   rtn = RasGetEntryProperties(vbNullString, vbNullString, _
                           ByVal 0&, lngCb, ByVal 0&, ByVal 0&)

   If rtn <> 603 Then VBRasSetEntryProperties = rtn: Exit Function
   
   lngStrLen = Len(clsRasEntry.AlternateNumbers)
   lngBuffLen = lngCb + lngStrLen + 1
   ReDim b(lngBuffLen)
   
   CopyMemory b(0), lngCb, 4
   CopyMemory b(4), clsRasEntry.options, 4
   CopyMemory b(8), clsRasEntry.CountryID, 4
   CopyMemory b(12), clsRasEntry.CountryCode, 4
   CopyStringToByte b(16), clsRasEntry.AreaCode, 11
   CopyStringToByte b(27), clsRasEntry.LocalPhoneNumber, 129
   
   If lngStrLen > 0 Then
     CopyMemory b(lngCb), _
               ByVal clsRasEntry.AlternateNumbers, lngStrLen
     CopyMemory b(156), lngCb, 4
   End If

   CopyMemory b(160), clsRasEntry.ipAddr, 4
   CopyMemory b(164), clsRasEntry.ipAddrDns, 4
   CopyMemory b(168), clsRasEntry.ipAddrDnsAlt, 4
   CopyMemory b(172), clsRasEntry.ipAddrWins, 4
   CopyMemory b(176), clsRasEntry.ipAddrWinsAlt, 4
   CopyMemory b(180), clsRasEntry.FrameSize, 4
   CopyMemory b(184), clsRasEntry.fNetProtocols, 4
   CopyMemory b(188), clsRasEntry.FramingProtocol, 4
   CopyStringToByte b(192), clsRasEntry.ScriptName, 260
   CopyStringToByte b(452), clsRasEntry.AutodialDll, 260
   CopyStringToByte b(712), clsRasEntry.AutodialFunc, 260
   CopyStringToByte b(972), clsRasEntry.DeviceType, 17
      If lngCb = 1672& Then lngStrLen = 33 Else lngStrLen = 129
   CopyStringToByte b(989), clsRasEntry.DeviceName, lngStrLen
      lngPos = 989 + lngStrLen
   CopyStringToByte b(lngPos), clsRasEntry.X25PadType, 33
      lngPos = lngPos + 33
   CopyStringToByte b(lngPos), clsRasEntry.X25Address, 201
      lngPos = lngPos + 201
   CopyStringToByte b(lngPos), clsRasEntry.X25Facilities, 201
      lngPos = lngPos + 201
   CopyStringToByte b(lngPos), clsRasEntry.X25UserData, 201
      lngPos = lngPos + 203
   CopyMemory b(lngPos), clsRasEntry.Channels, 4
   
   If lngCb > 1768 Then
      CopyMemory b(1768), clsRasEntry.NT4En_SubEntries, 4
      CopyMemory b(1772), clsRasEntry.NT4En_DialMode, 4
      CopyMemory b(1776), clsRasEntry.NT4En_DialExtraPercent, 4
      CopyMemory b(1780), clsRasEntry.NT4En_DialExtraSampleSeconds, 4
      CopyMemory b(1784), clsRasEntry.NT4En_HangUpExtraPercent, 4
      CopyMemory b(1788), clsRasEntry.NT4En_HangUpExtraSampleSeconds, 4
      CopyMemory b(1792), clsRasEntry.NT4En_IdleDisconnectSeconds, 4
      
      If lngCb > 1796 Then
         CopyMemory b(1796), clsRasEntry.Win2000_Type, 4
         CopyMemory b(1800), clsRasEntry.Win2000_EncryptionType, 4
         CopyMemory b(1804), clsRasEntry.Win2000_CustomAuthKey, 4
         CopyMemory b(1808), clsRasEntry.Win2000_guidId(0), 16
         CopyStringToByte b(1824), clsRasEntry.Win2000_CustomDialDll, 260
         CopyMemory b(2084), clsRasEntry.Win2000_VpnStrategy, 4
      End If
      
   End If
   
   rtn = RasSetEntryProperties(strPhoneBook, strEntryName, _
                              b(0), lngCb, ByVal 0&, ByVal 0&)
   
   VBRasSetEntryProperties = rtn

End Function


Function VBRASErrorHandler(rtn As Long) As String
   Dim strError As String, i As Long
   strError = String(512, 0)
   If rtn > 600 Then
      RasGetErrorString rtn, strError, 512&
   Else
      FormatMessage &H1000, ByVal 0&, rtn, 0&, strError, 512, ByVal 0&
   End If
   i = InStr(strError, Chr$(0))
   If i > 1 Then VBRASErrorHandler = Left$(strError, i - 1)
End Function

Function VBRasGetEntryProperties(strEntryName As String, _
         clsRasEntry As VBRasEntry, _
         Optional strPhoneBook As String) As Long
   
   Dim rtn As Long, lngCb As Long, lngBuffLen As Long
   Dim b() As Byte
   Dim lngPos As Long, lngStrLen As Long

   rtn = RasGetEntryProperties(vbNullString, vbNullString, _
                           ByVal 0&, lngCb, ByVal 0&, ByVal 0&)
   
   rtn = RasGetEntryProperties(strPhoneBook, strEntryName, _
                        ByVal 0&, lngBuffLen, ByVal 0&, ByVal 0&)
   
   If rtn <> 603 Then VBRasGetEntryProperties = rtn: Exit Function
   
   ReDim b(lngBuffLen - 1)
   CopyMemory b(0), lngCb, 4
   
   rtn = RasGetEntryProperties(strPhoneBook, strEntryName, _
                           b(0), lngBuffLen, ByVal 0&, ByVal 0&)
   
   VBRasGetEntryProperties = rtn
   If rtn <> 0 Then Exit Function
   
   CopyMemory clsRasEntry.options, b(4), 4
   CopyMemory clsRasEntry.CountryID, b(8), 4
   CopyMemory clsRasEntry.CountryCode, b(12), 4
   CopyByteToTrimmedString clsRasEntry.AreaCode, b(16), 11
   CopyByteToTrimmedString clsRasEntry.LocalPhoneNumber, b(27), 129
   
   CopyMemory lngPos, b(156), 4
   If lngPos <> 0 Then
     lngStrLen = lngBuffLen - lngPos
     clsRasEntry.AlternateNumbers = String(lngStrLen, 0)
     CopyMemory ByVal clsRasEntry.AlternateNumbers, _
               b(lngPos), lngStrLen
   End If
   
   CopyMemory clsRasEntry.ipAddr, b(160), 4
   CopyMemory clsRasEntry.ipAddrDns, b(164), 4
   CopyMemory clsRasEntry.ipAddrDnsAlt, b(168), 4
   CopyMemory clsRasEntry.ipAddrWins, b(172), 4
   CopyMemory clsRasEntry.ipAddrWinsAlt, b(176), 4
   CopyMemory clsRasEntry.FrameSize, b(180), 4
   CopyMemory clsRasEntry.fNetProtocols, b(184), 4
   CopyMemory clsRasEntry.FramingProtocol, b(188), 4
   CopyByteToTrimmedString clsRasEntry.ScriptName, b(192), 260
   CopyByteToTrimmedString clsRasEntry.AutodialDll, b(452), 260
   CopyByteToTrimmedString clsRasEntry.AutodialFunc, b(712), 260
   CopyByteToTrimmedString clsRasEntry.DeviceType, b(972), 17
      If lngCb = 1672& Then lngStrLen = 33 Else lngStrLen = 129
   CopyByteToTrimmedString clsRasEntry.DeviceName, b(989), lngStrLen
      lngPos = 989 + lngStrLen
   CopyByteToTrimmedString clsRasEntry.X25PadType, b(lngPos), 33
      lngPos = lngPos + 33
   CopyByteToTrimmedString clsRasEntry.X25Address, b(lngPos), 201
      lngPos = lngPos + 201
   CopyByteToTrimmedString clsRasEntry.X25Facilities, b(lngPos), 201
      lngPos = lngPos + 201
   CopyByteToTrimmedString clsRasEntry.X25UserData, b(lngPos), 201
      lngPos = lngPos + 203
   CopyMemory clsRasEntry.Channels, b(lngPos), 4
   
   If lngCb > 1768 Then
      CopyMemory clsRasEntry.NT4En_SubEntries, b(1768), 4
      CopyMemory clsRasEntry.NT4En_DialMode, b(1772), 4
      CopyMemory clsRasEntry.NT4En_DialExtraPercent, b(1776), 4
      CopyMemory clsRasEntry.NT4En_DialExtraSampleSeconds, b(1780), 4
      CopyMemory clsRasEntry.NT4En_HangUpExtraPercent, b(1784), 4
      CopyMemory clsRasEntry.NT4En_HangUpExtraSampleSeconds, b(1788), 4
      CopyMemory clsRasEntry.NT4En_IdleDisconnectSeconds, b(1792), 4
      
      If lngCb > 1796 Then
         CopyMemory clsRasEntry.Win2000_Type, b(1796), 4
         CopyMemory clsRasEntry.Win2000_EncryptionType, b(1800), 4
         CopyMemory clsRasEntry.Win2000_CustomAuthKey, b(1804), 4
         CopyMemory clsRasEntry.Win2000_guidId(0), b(1808), 16
         CopyByteToTrimmedString _
                  clsRasEntry.Win2000_CustomDialDll, b(1824), 260
         CopyMemory clsRasEntry.Win2000_VpnStrategy, b(2084), 4
      End If
      
   End If
   
End Function


Function VBRasEnumDevices(clsVBRasDevInfo() As VBRASDEVINFO) As Long
   Dim rtn As Long, i As Long
   Dim lpcb As Long, lpcDevices As Long
   Dim b() As Byte
   Dim dwSize As Long
   
   rtn = RasEnumDevices(ByVal 0&, lpcb, lpcDevices)

   If lpcDevices = 0 Then Exit Function
   
   dwSize = lpcb \ lpcDevices
   
   ReDim b(lpcb - 1)
   
   CopyMemory b(0), dwSize, 4
   
   rtn = RasEnumDevices(b(0), lpcb, lpcDevices)
   
   If lpcDevices = 0 Then Exit Function
   
   ReDim clsVBRasDevInfo(lpcDevices - 1)
   
   For i = 0 To lpcDevices - 1
     CopyByteToTrimmedString clsVBRasDevInfo(i).DeviceType, _
                                    b((i * dwSize) + 4), 17
     CopyByteToTrimmedString clsVBRasDevInfo(i).DeviceName, _
                           b((i * dwSize) + 21), dwSize - 21
   Next i
   
   VBRasEnumDevices = lpcDevices

End Function

Sub CopyByteToTrimmedString(strToCopyTo As String, _
                              bPos As Byte, lngMaxLen As Long)
   Dim strTemp As String, lngLen As Long
   strTemp = String(lngMaxLen + 1, 0)
   CopyMemory ByVal strTemp, bPos, lngMaxLen
   lngLen = InStr(strTemp, Chr$(0)) - 1
   strToCopyTo = Left$(strTemp, lngLen)
End Sub


Sub CopyStringToByte(bPos As Byte, _
                        strToCopy As String, lngMaxLen As Long)
   Dim lngLen As Long
   lngLen = Len(strToCopy)
   If lngLen = 0 Then
      Exit Sub
   ElseIf lngLen > lngMaxLen Then
      lngLen = lngMaxLen
   End If
   CopyMemory bPos, ByVal strToCopy, lngLen
End Sub