Solved

Rasapi32 code does not start vpn connection

Posted on 2004-04-23
7
377 Views
Last Modified: 2007-12-19
All

I cannot get this code to dial a vpn connection.

Can anyone tell how it should be changed?

Wing

'You need a form with a list,2 textbox and a command button

Option Explicit
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, ByVal pSrc As String, ByVal ByteLen As Long)
Private Declare Sub ZeroMemory Lib "kernel32.dll" Alias "RtlZeroMemory" (Destination As Any, ByVal Length As Long)

Const RAS95_MaxEntryName = 256
Const RAS_MaxPhoneNumber = 128
Const RAS_MaxCallbackNumber = RAS_MaxPhoneNumber

Const UNLEN = 256
Const PWLEN = 256
Const DNLEN = 12
Private Type RASDIALPARAMS
   dwSize As Long ' 1052
   szEntryName(RAS95_MaxEntryName) As Byte
   szPhoneNumber(RAS_MaxPhoneNumber) As Byte
   szCallbackNumber(RAS_MaxCallbackNumber) As Byte
   szUserName(UNLEN) As Byte
   szPassword(PWLEN) As Byte
   szDomain(DNLEN) As Byte
End Type

Private Type RASENTRYNAME95
    'set dwsize to 264
    dwSize As Long
    szEntryName(RAS95_MaxEntryName) As Byte
End Type

Private Declare Function RasDial Lib "rasapi32.dll" Alias "RasDialA" (ByVal lprasdialextensions As Long, ByVal lpcstr As String, ByRef lprasdialparamsa As RASDIALPARAMS, ByVal dword As Long, lpvoid As Any, ByRef lphrasconn 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 Declare Function RasGetEntryDialParams Lib "rasapi32.dll" Alias "RasGetEntryDialParamsA" (ByVal lpcstr As String, ByRef lprasdialparamsa As RASDIALPARAMS, ByRef lpbool As Long) As Long

Private Function Dial(ByVal Connection As String, ByVal UserName As String, ByVal Password As String) As Boolean
    Dim rp As RASDIALPARAMS, h As Long, resp As Long
    rp.dwSize = Len(rp) + 6
    ChangeBytes Connection, rp.szEntryName
    ChangeBytes "", rp.szPhoneNumber 'Phone number stored for the connection
    ChangeBytes "*", rp.szCallbackNumber 'Callback number stored for the connection
    ChangeBytes UserName, rp.szUserName
    ChangeBytes Password, rp.szPassword
    ChangeBytes "*", rp.szDomain 'Domain stored for the connection
    'Dial
    resp = RasDial(ByVal 0, ByVal 0, rp, 0, ByVal 0, h)   'AddressOf RasDialFunc
    Dial = (resp = 0)
End Function

Private Function ChangeToStringUni(Bytes() As Byte) As String
    'Changes an byte array to a Visual Basic unicode string
    Dim temp As String
    temp = StrConv(Bytes, vbUnicode)
    ChangeToStringUni = Left(temp, InStr(temp, Chr(0)) - 1)
End Function

Private Function ChangeBytes(ByVal str As String, Bytes() As Byte) As Boolean
    'Changes a Visual Basic unicode string to an byte array
    'Returns True if it truncates str
    Dim lenBs As Long 'length of the byte array
    Dim lenStr As Long 'length of the string
    lenBs = UBound(Bytes) - LBound(Bytes)
    lenStr = LenB(StrConv(str, vbFromUnicode))
    If lenBs > lenStr Then
        CopyMemory Bytes(0), str, lenStr
        ZeroMemory Bytes(lenStr), lenBs - lenStr
    ElseIf lenBs = lenStr Then
        CopyMemory Bytes(0), str, lenStr
    Else
        CopyMemory Bytes(0), str, lenBs 'Queda truncado
        ChangeBytes = True
    End If
End Function

Private Sub Command1_Click()
    Dial List1.Text, Text1, Text2
End Sub


Private Sub List1_Click()
    Dim rdp As RASDIALPARAMS, t As Long
    rdp.dwSize = Len(rdp) + 6
    ChangeBytes List1.Text, rdp.szEntryName
    'Get User name and password for the connection
    t = RasGetEntryDialParams(List1.Text, rdp, 0)
    If t = 0 Then
        Text1 = ChangeToStringUni(rdp.szUserName)
        Text2 = ChangeToStringUni(rdp.szPassword)
    End If
End Sub
0
Comment
Question by:WingYip
  • 4
7 Comments
 
LVL 7

Expert Comment

by:OHDev2004
Comment Utility
hey WingYip
you must first check for connections and add them to the list when the form loads

like :

Form_Load()
' call a routine to add available Connections
end sub
0
 
LVL 7

Expert Comment

by:OHDev2004
Comment Utility
here it is : i found that not my code but it'll help

=====================================

Private Sub Form_Load()
    'example created by Daniel Kaufmann (daniel@i.com.uy)
    'load the connections
    Text2.PasswordChar = "*"
    Command1.Caption = "Dial"
    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
    If List1.ListCount > 0 Then
        List1.ListIndex = 0
        List1_Click
    End If
End Sub
0
 
LVL 1

Author Comment

by:WingYip
Comment Utility
Sorry I missed that bit out of the message but that is already in my code.  Niether is code mine by the way.

Still does not work though.

Wing
0
 
LVL 7

Expert Comment

by:OHDev2004
Comment Utility
:)
i thought so also that you forgot to type that part ,, lol
0
 
LVL 7

Accepted Solution

by:
OHDev2004 earned 250 total points
Comment Utility
no way man :( i think this way can be used only with win95 as it seems to,,
what ver of windows do you use ?

i got a way from the net to get the connection properties EXcept the username and password ,, it works on winXp and 2k ,, here it is :

===========================================
'in a module

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 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



Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
         (Destination As Any, Source As Any, ByVal Length 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

'__________________________________________________________________

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 'NT4 Enhancements & Win2000
      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 ' Win2000
         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
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


============================================

to get the properties of a connection you can use this:
then all the properties of the connection are stored in the "clsVBRasEntry"
by example :you can get the phonenumber by ---> clsVBRasEntry.LocalPhoneNumber

============================================
Dim clsVBRasEntry As VBRasEntry
Dim rtn As Long
rtn = VBRasGetEntryProperties(List1.Text, clsVBRasEntry) ' List1.Text is for the connection name
if ret<>0 then MsgBox VBRASErrorHandler(rtn)
============================================


C ya ,, hope this helps a bit
0

Featured Post

6 Surprising Benefits of Threat Intelligence

All sorts of threat intelligence is available on the web. Intelligence you can learn from, and use to anticipate and prepare for future attacks.

Join & Write a Comment

There are many ways to remove duplicate entries in an SQL or Access database. Most make you temporarily insert an ID field, make a temp table and copy data back and forth, and/or are slow. Here is an easy way in VB6 using ADO to remove duplicate row…
Introduction In a recent article (http://www.experts-exchange.com/A_7811-A-Better-Concatenate-Function.html) for the Excel community, I showed an improved version of the Excel Concatenate() function.  While writing that article I realized that no o…
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 process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…

744 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

Need Help in Real-Time?

Connect with top rated Experts

18 Experts available now in Live!

Get 1:1 Help Now