Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium


Need to create dial-up connection

Posted on 2003-03-10
Medium Priority
Last Modified: 2007-12-19
Can anyone provide an example of code that using the RAS libraries or anything else from VB to create a new dial-up connection?

We need to deploy a tool for uploading data via a dial-up to an ISP and then an ftp to an ftp server.  I've seen examples doing the dial-up from existing dial-up connections (in Win95 and beyond), and some code for doing an ftp upload (although we can use libraries for that).

The only trick left is to create a small program which will create an appropriate dial-up connection when installing the tool (or first time use).
Question by:Gene Klamerus
  • 2
  • 2

Author Comment

by:Gene Klamerus
ID: 8107407
Or I suppose alternatively, if there's a way to directly dial from within the program to an ISP without creating a dial-up entry at all, but using the Windows dialer as if there was an entry.  That might work too.

Also, I need for this to work from Win95-WinXP
LVL 28

Expert Comment

ID: 8107446

Accepted Solution

reinhardt007 earned 2000 total points
ID: 8109485
Create new Form (Form1)

Put the following components on form

Combobox (cboDevices)
Button One (cmdCreateConnection) (New Connection)
Button Exit (cmdExit)

Declare this in a module (Module1)

Option Explicit
    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
'Make a combo box for the modem devices and use the GetDevices command.
'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 ApINULL = 0&

    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
        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
    ByteToString = t
End Function

Function VBRasSetEntryProperties(strEntryName As String, _
         typRasEntry 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(typRasEntry.AlternateNumbers)
   lngBuffLen = lngCb + lngStrLen + 1
   ReDim b(lngBuffLen)
   CopyMemory b(0), lngCb, 4
   CopyMemory b(4), typRasEntry.options, 4
   CopyMemory b(8), typRasEntry.CountryID, 4
   CopyMemory b(12), typRasEntry.CountryCode, 4
   CopyStringToByte b(16), typRasEntry.AreaCode, 11
   CopyStringToByte b(27), typRasEntry.LocalPhoneNumber, 129
   If lngStrLen > 0 Then
     CopyMemory b(lngCb), _
               ByVal typRasEntry.AlternateNumbers, lngStrLen
     CopyMemory b(156), lngCb, 4
   End If

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

Copy this to code of Form1

Private Sub cmdCreateConnection_Click()

End Sub

Private Sub cmdExit_Click()
Unload Me
End Sub

'list devices installed in combobox lstDevice
Private Sub Form_Load()
If cboDevices.ListCount = 0 Then cmdCreateConnection.Enabled = False
End Sub
Private Sub ListDevices()
GetDevices cboDevices
If cboDevices.ListCount > 0 Then cboDevices.ListIndex = 0
End Sub

Private Sub CreateNewEntry()
'make the DUN called DUN_NAME
'Will work if the selected device in the combo box is a modem
'The Connection Created is a "dummy" one
'If you want a real one, change the below parameters
'to the what you need, or add text boxes to a form
'so the user can enter them him/herself

Dim typVBRasEntry As VBRasEntry
typVBRasEntry.AreaCode = ""
typVBRasEntry.AutodialFunc = 0
typVBRasEntry.CountryCode = "1"
typVBRasEntry.CountryID = "1"
typVBRasEntry.DeviceName = cboDevices.Text
typVBRasEntry.DeviceType = "Modem"
typVBRasEntry.fNetProtocols = RASNP_Ip
typVBRasEntry.FramingProtocol = RASFP_Ppp
typVBRasEntry.Options = RASEO_SwCompression + RASEO_IpHeaderCompression + RASEO_RemoteDefaultGateway _
+ RASEO_SpecificNameServers

typVBRasEntry.ipAddrDns.a = "206"
typVBRasEntry.ipAddrDns.b = "211"
typVBRasEntry.ipAddrDns.c = "214"
typVBRasEntry.ipAddrDns.d = "206"
typVBRasEntry.ipAddrDnsAlt.a = "212"
typVBRasEntry.ipAddrDnsAlt.b = "200"
typVBRasEntry.ipAddrDnsAlt.c = "200"
typVBRasEntry.ipAddrDnsAlt.d = "200"
typVBRasEntry.ipAddrWins.a = "0"
typVBRasEntry.ipAddrWins.b = "0"
typVBRasEntry.ipAddrWins.c = "0"
typVBRasEntry.ipAddrWins.d = "0"
typVBRasEntry.ipAddrWinsAlt.a = "0"
typVBRasEntry.ipAddrWinsAlt.b = "0"
typVBRasEntry.ipAddrWinsAlt.c = "0"
typVBRasEntry.ipAddrWinsAlt.d = "0"
typVBRasEntry.LocalPhoneNumber = "555-5555"
Dim rtn As Long
rtn = VBRasSetEntryProperties("DUN NAME", typVBRasEntry)
If rtn <> 0 Then
    MsgBox VBRASErrorHandler(rtn)
    MsgBox "DUN Created.", vbOKOnly, "Complete"
End If
End Sub


Author Comment

by:Gene Klamerus
ID: 8113323
Is there any way to use Windows dial-up without actually creating a dial-up "object"?  In other words, is there anyway to establish a TCP/IP connecting to an ISP using methods similar to the above and not create a permanent dial-up connection (just doing it via the API)?
LVL 28

Expert Comment

ID: 8113846
Yes there is.

Featured Post

What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Introduction While answering a recent question (http://www.experts-exchange.com/Q_27402310.html) in the VB classic zone, I wrote some VB code in the (Office) VBA environment, rather than fire up my older PC.  I didn't post completely correct code o…
I was working on a PowerPoint add-in the other day and a client asked me "can you implement a feature which processes a chart when it's pasted into a slide from another deck?". It got me wondering how to hook into built-in ribbon events in Office.
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
Suggested Courses
Course of the Month10 days, 22 hours left to enroll

571 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question