• 0

[VB] Creating PPPoE programicaly

Asked by Plamen Nikolov,

 Share

Question

Rookie

Plamen Nikolov

Posted
Posted

Hello, All!

I want to create pppoe connection with visual basic 6 or visual studio 2010... My question is how to set 2 text boxes for insert username and password to pppoe connection. I have code that create pppoe connection but i can't set username and password to pppoe connection. Also I want to make checkbox to save username and password for all users on the computer... My Idea is based on my work in Internet Service Provider as php developer.

Link to comment
https://www.neowin.net/forum/topic/898156-vb-creating-pppoe-programicaly/
Share on other sites

9 answers to this question

Recommended Posts

  • 0
Veteran

James Rose

Posted
Posted

This is said with the caviat that I do not know what a "pppoe" object is, and that I am going to guess that I don't need to know for this answer.

I'm assuming that the pppoe object has a connection string. Some text based property that you assign the userid,password and whatever other settings you need to specific to make a connection. So if that is the case, then in VB code it would look something like this:

txtUserName is the Text Box for, duh, the user name

txtPassword is the Text Box for... well, you get it.

DIM sConnection as String

sConnection = "THIS IS THE USER ID: " & txtUserName.Text & " and now THIS IS THE USER PASSWORD: " & txtPassword.Text & " and any other settings you will need."

  • 0
Rookie

Plamen Nikolov

Posted
  • Author
Posted
  On 04/05/2010 at 19:07, jameswjrose said:

This is said with the caviat that I do not know what a "pppoe" object is, and that I am going to guess that I don't need to know for this answer.

I'm assuming that the pppoe object has a connection string. Some text based property that you assign the userid,password and whatever other settings you need to specific to make a connection. So if that is the case, then in VB code it would look something like this:

txtUserName is the Text Box for, duh, the user name

txtPassword is the Text Box for... well, you get it.

DIM sConnection as String

sConnection = "THIS IS THE USER ID: " & txtUserName.Text & " and now THIS IS THE USER PASSWORD: " & txtPassword.Text & " and any other settings you will need."

For Creating PPPoE I use RASApis but with RasDialParams I can't creat pppoe with user cridentials. I know this, which you wrote. A Can't set username and password to ras connection.

  • 0
Rookie

Plamen Nikolov

Posted
  • Author
Posted
  On 05/05/2010 at 11:21, Antaris said:

Have you tried DotRAS? It's an open source project hosted on codeplex which provides a managed wrapper around P/Invoke calls for creating RAS connections:

http://dotras.codeplex.com/

I test DotRas but have a little mistake... Cannot understand the functions and my VS2010 cannot open correctly this source.... I have written a question in forums of DotRas but I can't finish my project with codes which I'm using.

  • 0
Rookie

Plamen Nikolov

Posted
  • Author
Posted
  On 06/05/2010 at 10:58, Antaris said:

Do you mind sharing your code here so we can see as to what stage you have managed to get to?

This is my vb6 project. I can't import it to VB2010. This code create pppoe store selected name for PPPoE Connection and add some variables to pppoe connection like preview username and password, Negotiate multilink etc. I can't speak English very well but I understand you... Do anyone from here speak Bulgarian and find me in skype - djpatzo . Thanks before.

Private Sub CreateNewEntry()

   Dim sRASEntryName As String
   Dim typVBRasEntry As VBRasEntry
   'typVBRasEntry.AutodialFunc = 0
   typVBRasEntry.DeviceName = "WAN Miniport (PPPOE)"
   typVBRasEntry.DeviceType = "PPPoE"
   typVBRasEntry.fNetProtocols = RASNP_Ip
   typVBRasEntry.FramingProtocol = RASFP_Ppp
   typVBRasEntry.options = RASEO_RemoteDefaultGateway + RASEO_PreviewUserPw + RASEO_ShowDialingProgress + RASEO_SwCompression
   typVBRasEntry.Win2000_CustomAuthKey = "0"

   typVBRasEntry.Win2000_Type = RASET_Broadband
   'typVBRasEntry.Win2000_VpnStrategy = VS_PptpFirst

   typVBRasEntry.ipAddrDns.a = "0"
   typVBRasEntry.ipAddrDns.b = "0"
   typVBRasEntry.ipAddrDns.C = "0"
   typVBRasEntry.ipAddrDns.d = "0"
   typVBRasEntry.ipAddrDnsAlt.a = "0"
   typVBRasEntry.ipAddrDnsAlt.b = "0"
   typVBRasEntry.ipAddrDnsAlt.C = "0"
   typVBRasEntry.ipAddrDnsAlt.d = "0"
   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.WinXP_Options2 = RASEO2_ReconnectIfDropped + RASEO2_DontNegotiateMultilink + RASEO2_UseGlobalDeviceSettings
   typVBRasEntry.WinXP_RedialCount = "99"
   typVBRasEntry.WinXP_RedialPause = "5"

   Dim typVBRasEntry2 As VBRasDialParams
   typVBRasEntry2.UserName = txtUserName.Text 'име на полето за потребителя
   typVBRasEntry2.Password = txtPassword.Text 'име на полето за паролата

   Dim rtn As Long
   If Trim(txtConnectoidName.Text) = "" Then
      sRASEntryName = "name of connection"
   Else
      sRASEntryName = Trim(txtConnectoidName.Text)
   End If

   rtn = VBRasSetEntryProperties(sRASEntryName, typVBRasEntry)
   If rtn <> 0 Then
      MsgBox VBRASErrorHandler(rtn)
   Else
      If FormState = ShowNew Then
         MsgBox "Âðúçêàòà å ñúçäàäåíà óñïåøíî!", vbOKOnly, "Complete"
      End If

   End If
End Sub

Option Explicit
'RAS IP Structure Type
Public Type RASIPADDR
a As Byte
b As Byte
C As Byte
d As Byte
End Type

'Ras Entry Options
Public Enum RasEntryOptions
' 0-3
RASEO_UseCountryAndAreaCodes = &H1
RASEO_SpecificIpAddr = &H2
RASEO_SpecificNameServers = &H4
RASEO_IpHeaderCompression = &H8
'4-7
RASEO_RemoteDefaultGateway = &H10
RASEO_DisableLcpExtensions = &H20
RASEO_TerminalBeforeDial = &H40
RASEO_TerminalAfterDial = &H80
'8-11
RASEO_ModemLights = &H100
RASEO_SwCompression = &H200
RASEO_RequireEncryptedPw = &H400
RASEO_RequireMsEncryptedPw = &H800
'12-15
RASEO_RequireDataEncryption = &H1000
RASEO_NetworkLogon = &H2000
RASEO_UseLogonCredentials = &H4000
RASEO_PromoteAlternates = &H8000
'16-19
RASEO_SecureLocalFiles = &H10000
RASEO_RequireEAP = &H20000
RASEO_RequirePAP = &H40000
RASEO_RequireSPAP = &H80000
'20,21,23
RASEO_Custom = &H100000
RASEO_PreviewPhoneNumber = &H200000
RASEO_SharedPhoneNumbers = &H800000
'24-27
RASEO_PreviewUserPw = &H1000000
RASEO_PreviewDomain = &H2000000
RASEO_ShowDialingProgress = &H4000000
RASEO_RequireCHAP = &H8000000
'28-31
RASEO_RequireMsCHAP = &H10000000
RASEO_RequireMsCHAP2 = &H20000000
RASEO_RequireW95MSCHAP = &H40000000
RASEO_CustomScript = &H80000000
End Enum

'********************************************************
*******************
'****Thanks to CHOI LIM JU for helping with the following addition**
'********************************************************
*******************
Public Enum RasEntryOptions2
RASEO2_SecureFileAndPrint = &H1 '0x00000001
RASEO2_SecureClientForMSNet = &H2 '0x00000002
RASEO2_DontNegotiateMultilink = &H4 '0x00000004
RASEO2_DontUseRasCredentials = &H8 '0x00000008
RASEO2_UsePreSharedKey = &H10 '0x00000010
RASEO2_Internet = &H20 '0x00000020
RASEO2_DisableNbtOverIP = &H40 '0x00000040
RASEO2_UseGlobalDeviceSettings = &H80 '0x00000080
RASEO2_ReconnectIfDropped = &H100 '0x00000100
RASEO2_SharePhoneNumbers = &H200 '0x00000200
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 Enum VPNStrategies
VS_Default = &H0 ' default (PPTP for now)
VS_PptpOnly = &H1 ' Only PPTP is attempted.
VS_PptpFirst = &H2 ' PPTP is tried first.
VS_L2tpOnly = &H3 ' Only L2TP is attempted.
VS_L2tpFirst = &H4 ' L2TP is tried first.
End Enum

Public Enum dwTypes
RASET_Phone = 1
RASET_Vpn = 2
RASET_Direct = 3
RASET_Internet = 4
RASET_Broadband = 5
End Enum

Public Type VBRasEntry
dwSize As Long
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 dwTypes
Win2000_EncryptionType As Long
Win2000_CustomAuthKey As Long
Win2000_guidId(0 To 15) As Byte
Win2000_CustomDialDll As String
Win2000_VpnStrategy As VPNStrategies
'********************************************************
*******************
'****Thanks to CHOI LIM JU for helping with the following change **
'********************************************************
*******************
WinXP_Options2 As RasEntryOptions2
'********************************************************
*******************
WinXP_Options3 As Long
WinXP_DNSSuffix As String
WinXP_TcpWindowSize As Long
WinXP_PrerequisitePbk As String
WinXP_PrerequisiteEntry As String
WinXP_RedialCount As Long
WinXP_RedialPause As Long
End Type

Public Type VBRasDialParams
EntryName As String
PhoneNumber As String
CallbackNumber As String
UserName As String
Password As String
Domain As String
SubEntryIndex As Long
RasDialFunc2CallbackId As Long
End Type

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

'Constants for GlobalAlloc
Global Const GMEM_FIXED = &H0
Global Const GMEM_ZEROINIT = &H40
Global Const GPTR = (GMEM_FIXED Or GMEM_ZEROINIT)

' Constants needed for LocalAlloc
Global Const LMEM_FIXED = &H0
Global Const LMEM_ZEROINIT = &H40
Global Const LPTR = (LMEM_FIXED Or LMEM_ZEROINIT)

Global Const ERROR_BUFFER_TOO_SMALL = 603

' Constant needed for RASENTRYNAME
Global Const RAS_MaxEntryName = 256

Global Const APINULL = 0&

' Function prototype for RasEnumEntries
Public Declare Function RasEnumEntries Lib "rasapi32.dll" Alias "RasEnumEntriesA" ( _
ByVal reserved As String, _
ByVal szPhoneBook As String, _
lpRasEntries As Any, _
lpcb As Long, _
lpcEntries As Long) As Long

Public Declare Function RasDeleteEntry _
Lib "rasapi32.dll" Alias "RasDeleteEntryA" _
(ByVal lpszPhonebook As String, _
ByVal lpszEntry As String) As Long


' Type definition for RASENTRYNAME
Type RASENTRYNAME
dwSize As Long
szEntryName(RAS_MaxEntryName) As Byte
End Type

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

' Function prototype for LocalAlloc
Declare Function LocalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal _
dwBytes As Long) As Long

' Function prototype for LocalFree
Declare Function LocalFree Lib "kernel32" (ByVal hMem As Long) As Long


Public Declare Function GetWindowsDirectoryA Lib "kernel32" (ByVal lpBuffer _
As String, ByVal nSize As Long) As Long

Public Declare Function RasGetEntryDialParams _
Lib "rasapi32.dll" Alias "RasGetEntryDialParamsA" _
(ByVal lpszPhonebook As String, _
lpRasDialParams As Any, _
blnPasswordRetrieved As Long) As Long

Public Declare Function RasSetEntryDialParams _
Lib "rasapi32.dll" Alias "RasSetEntryDialParamsA" _
(ByVal lpszPhonebook As String, _
lpRasDialParams As Any, _
ByVal blnRemovePassword As Long) As Long

Public Enum DeviceTypeSearch
FindbyName
FindbyType
End Enum

Public Enum RASCreationType
NonSecure5400
MSRRAS
End Enum




'========================================================
=================================
Function FindDevice(strPartialName As String, Optional Findby As DeviceTypeSearch) As String
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
Dim sTempString As String

If IsMissing(Findby) Then
Findby = FindbyName
End If

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)
If Findby = FindbyName Then
sTempString = (ByteToString(lpRasDevInfo.szDeviceName))
Else
sTempString = (ByteToString(lpRasDevInfo.szDeviceType))
End If
If InStr(1, sTempString, strPartialName) > 0 Then
FindDevice = (ByteToString(lpRasDevInfo.szDeviceName))
Exit For
End If
t_ptr = t_ptr + LenB(lpRasDevInfo) + (LenB(lpRasDevInfo) Mod 4)
Next i
Else
App.LogEvent "Error Enumerating Devices: Code " & nRet, vbLogEventTypeError
End If

If t_Buff <> 0 Then GlobalFree (t_Buff)

End Function 'FindDevice(strPartialName As String) As String
'========================================================
=======================
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
App.LogEvent "Error in Get Devices. Error #:" & nRet, vbLogEventTypeError
End If

If t_Buff <> 0 Then GlobalFree (t_Buff)

End Sub 'GetDevices(lst As ComboBox)
'========================================================
=======================
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 'ByteToString(bytearray() As Byte) As String
'=================================================+======
======================
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

If lngCb > 2088 Then
CopyMemory b(2088), typRasEntry.WinXP_Options2, 4
CopyMemory b(2092), typRasEntry.WinXP_Options3, 4
CopyStringToByte b(2096), typRasEntry.WinXP_DNSSuffix, 260
End If
End If

End If

rtn = RasSetEntryProperties(strPhonebook, strEntryName, b(0), lngCb, ByVal 0&, ByVal 0&)

VBRasSetEntryProperties = rtn

End Function 'VBRasSetEntryProperties(strEntryName As String, typRasEntry As VBRasEntry,
'Optional strPhoneBook As String) 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 'VBRASErrorHandler(rtn As Long) As String
'========================================================
=================================
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&)
'MsgBox "lngCB:" & CStr(lngCb)

rtn = RasGetEntryProperties(strPhonebook, strEntryName, ByVal 0&, lngBuffLen, ByVal 0&, ByVal 0&)
'MsgBox "StrPhoneBook: " & strPhoneBook
'MsgBox "lngBuffLen: " & lngBuffLen


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
CopyMemory typRasEntry.WinXP_Options2, b(2088), 4
CopyMemory typRasEntry.WinXP_Options3, b(2092), 4
CopyByteToTrimmedString typRasEntry.WinXP_DNSSuffix, b(2096), 260

End If

End If




End Function 'VBRasGetEntryProperties(strEntryName As String, typRasEntry As VBRasEntry,
'Optional strPhoneBook As String) As Long
'========================================================
=================================
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 'VBRasEnumDevices(clsVBRasDevInfo() As VBRASDEVINFO) As Long
'========================================================
=================================
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 'CopyByteToTrimmedString(strToCopyTo As String, bPos As Byte, lngMaxLen As Long)
'========================================================
=================================
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 'CopyStringToByte(bPos As Byte, strToCopy As String, lngMaxLen As Long)
'========================================================
=================================
Public Function GetEntries(ByRef sEntryName() As String) As Integer
Dim tRasEntryName As RASENTRYNAME
Dim cb As Long
Dim cEntries As Long
Dim t_Buff As Long
Dim t_ptr As Long
Dim nRet As Long
Dim i As Long
Dim iTempCount As Integer

iTempCount = 0
cb = LenB(tRasEntryName)
ReDim sEntryName(40)
' Initialize the dwSize field
tRasEntryName.dwSize = cb

' Allocate input buffer with enough room for at least one structure
t_Buff = LocalAlloc(LPTR, cb)

If (t_Buff) Then
' Initialize the first entry
' Since t_Buff is the actual memory address we need to pass it by value (ByVal)
' to CopyMemory because VB passes parameters by reference by default
Call iCopyMemory(ByVal t_Buff, tRasEntryName, LenB(tRasEntryName))

' Call RasEnumEntries to enumerate the phonebook entries
' in the default system phonebook
nRet = RasEnumEntries(vbNullString, vbNullString, ByVal t_Buff, cb, cEntries)

'Check return value
If (ERROR_BUFFER_TOO_SMALL = nRet And cb <> 0) Then
Call LocalFree(t_Buff)
t_Buff = LocalAlloc(LPTR, cb)
ElseIf (0 <> nRet) Then
App.LogEvent "RasEnumEntries failed: Error " & CStr(nRet), vbLogEventTypeError


Call LocalFree(t_Buff)
Exit Function
End If

If (t_Buff) Then
If (nRet <> 0) Then
Call iCopyMemory(ByVal t_Buff, tRasEntryName, LenB(tRasEntryName))

' Call RasEnumEntries to enumerate the phonebook entries
' in the default system phonebook
nRet = RasEnumEntries(vbNullString, vbNullString, ByVal t_Buff, cb, cEntries)
End If

If nRet = 0 Then ' RasEnumEntries returned success
t_ptr = t_Buff

' Copy the values of the first entry
Call iCopyMemory(tRasEntryName, ByVal t_ptr, LenB(tRasEntryName))

' Add phonebook entries to the combo box
For i = 1 To cEntries
Call iCopyMemory(tRasEntryName, ByVal t_ptr, LenB(tRasEntryName))
iTempCount = iTempCount + 1
sEntryName(iTempCount) = (ByteToString(tRasEntryName.szEntryName))
t_ptr = t_ptr + tRasEntryName.dwSize
Next i
Else
App.LogEvent "RasEnumEntries failed = " & CStr(nRet), vbLogEventTypeError
End If

' Free the allocated input buffer
Call LocalFree(t_Buff)

Else ' RasEnumEntries returned an error
App.LogEvent "LocalAlloc failed!" & CStr(nRet), vbLogEventTypeError
End If


Else
App.LogEvent "LocalAlloc failed!" & CStr(nRet), vbLogEventTypeError
End If
If iTempCount > 0 Then
ReDim Preserve sEntryName(iTempCount)
End If
GetEntries = iTempCount
End Function 'GetEntries(ByRef sEntryName() As String) As Integer
'========================================================
=================================
Function BytesToVBRasDialParams(bytesIn() As Byte, _
udtVBRasDialParamsOUT As VBRasDialParams) As Boolean

Dim iPos As Long, lngLen As Long
Dim dwSize As Long
On Error GoTo badBytes

CopyMemory dwSize, bytesIn(0), 4

If dwSize = 816& Then
lngLen = 21&
ElseIf dwSize = 1060& Or dwSize = 1052& Then
lngLen = 257&
Else
'unkown size
Exit Function
End If
iPos = 4
With udtVBRasDialParamsOUT
CopyByteToTrimmedString .EntryName, bytesIn(iPos), lngLen
iPos = iPos + lngLen: lngLen = 129
CopyByteToTrimmedString .PhoneNumber, bytesIn(iPos), lngLen
iPos = iPos + lngLen: lngLen = 129
CopyByteToTrimmedString .CallbackNumber, bytesIn(iPos), lngLen
iPos = iPos + lngLen: lngLen = 257
CopyByteToTrimmedString .UserName, bytesIn(iPos), lngLen
iPos = iPos + lngLen: lngLen = 257
CopyByteToTrimmedString .Password, bytesIn(iPos), lngLen
iPos = iPos + lngLen: lngLen = 16
CopyByteToTrimmedString .Domain, bytesIn(iPos), lngLen

If dwSize > 1052& Then
CopyMemory .SubEntryIndex, bytesIn(1052), 4&
CopyMemory .RasDialFunc2CallbackId, bytesIn(1056), 4&
End If
End With
BytesToVBRasDialParams = True
Exit Function
badBytes:
'error handling goes here ??
BytesToVBRasDialParams = False
End Function

Function VBRasDialParamsToBytes( _
udtVBRasDialParamsIN As VBRasDialParams, _
bytesOut() As Byte) As Boolean

Dim rtn As Long
Dim blnPsswrd As Long
Dim b() As Byte
Dim bLens As Variant
Dim dwSize As Long, i As Long
Dim iPos As Long, lngLen As Long

bLens = Array(1060&, 1052&, 816&)
For i = 0 To 2
dwSize = bLens(i)
ReDim b(dwSize - 1)
CopyMemory b(0), dwSize, 4
rtn = RasGetEntryDialParams(vbNullString, b(0), blnPsswrd)
If rtn = 623& Then Exit For
Next i

If rtn <> 623& Then Exit Function

On Error GoTo badBytes
ReDim bytesOut(dwSize - 1)
CopyMemory bytesOut(0), dwSize, 4

If dwSize = 816& Then
lngLen = 21&
ElseIf dwSize = 1060& Or dwSize = 1052& Then
lngLen = 257&
Else
'unkown size
Exit Function
End If
iPos = 4
With udtVBRasDialParamsIN
CopyStringToByte bytesOut(iPos), .EntryName, lngLen
iPos = iPos + lngLen: lngLen = 129
CopyStringToByte bytesOut(iPos), .PhoneNumber, lngLen
iPos = iPos + lngLen: lngLen = 129
CopyStringToByte bytesOut(iPos), .CallbackNumber, lngLen
iPos = iPos + lngLen: lngLen = 257
CopyStringToByte bytesOut(iPos), .UserName, lngLen
iPos = iPos + lngLen: lngLen = 257
CopyStringToByte bytesOut(iPos), .Password, lngLen
iPos = iPos + lngLen: lngLen = 16
CopyStringToByte bytesOut(iPos), .Domain, lngLen

If dwSize > 1052& Then
CopyMemory bytesOut(1052), .SubEntryIndex, 4&
CopyMemory bytesOut(1056), .RasDialFunc2CallbackId, 4&
End If
End With
VBRasDialParamsToBytes = True
Exit Function
badBytes:
'error handling goes here ??
VBRasDialParamsToBytes = False
End Function

  • 0
Grand Master

Antaris Veteran

Posted
  • Veteran
Posted

I'm wondering if this will help:

http://www.tech-archive.net/Archive/VB/microsoft.public.vb.winapi.networks/2006-02/msg00002.html

Johno on that thread has apparently got a VB6 implementation that allows him to set the credentials of a RAS connection. Read that post and see if that helps.

  • 0
Rookie

Plamen Nikolov

Posted
  • Author
Posted
  On 06/05/2010 at 17:40, Antaris said:

I'm wondering if this will help:

http://www.tech-archive.net/Archive/VB/microsoft.public.vb.winapi.networks/2006-02/msg00002.html

Johno on that thread has apparently got a VB6 implementation that allows him to set the credentials of a RAS connection. Read that post and see if that helps.

I test code before i had written here... I can't set username and password. How can I do this? Thanks before!

This topic is now closed to further replies.
 Share
Go to question listing

  • Recently Browsing   0 members

    • No registered users viewing this page.