Пример RasSetEntryProperties и RasSetCredentials VPN

[Adam Smith]

Функция RASDial принимает логин и пароль подключения, но её совершенно не волнует как вы их сохраняете.

Как заставить винду сохранить логин и пас?

[NashRus]

RasSetEntryDialParams

Может все таки изучить RAS API уже.

ЗЫ: ну да или RasSetCredentials если сам не увидишь, что в MSDN написано.

[Adam Smith]

RasSetEntryDialParams

Разумеется, уже использую.

Может все-таки изучить RAS API уже.

Зачем?
Если на vbstreets ради повышения самооценки дадут хороший совет.

ЗЫ: ну да или RasSetCredentials если сам не увидишь, что в MSDN написано.

Спасибо!

[NashRus]

Новогоднее пожелание ради повышения своей самооценки: еще больше адекватности.
Никто не должен напрягаться вместо тебя, а паразитический образ мыслей характеризует тебя не только как плохого программиста.

[Adam Smith]

Юзабельный шмат кода с китайского MSDN. Паразитирую изо всех сил

Код: Выделить всё

Option Explicit

Private Const RAS_MaxEntryName = 256

Private Const RAS_MaxPhoneNumber = 128

Private Const RAS_MaxCallbackNumber = RAS_MaxPhoneNumber

Private Const UNLEN = 256

Private Const PWLEN = 256

Private Const DNLEN = 12

Private Type RASDIALPARAMS

  dwSize As Long ' 1052
  szEntryName(RAS_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 Declare Function RasGetEntryDialParams _
                Lib "rasapi32.dll" _
                Alias "RasGetEntryDialParamsA" (ByVal lpcstr As String, _
                                                ByRef lprasdialparamsa As RASDIALPARAMS, _
                                                ByRef lpbool As Long) As Long

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

Private Type GUID

  Data1 As Long
  Data2 As Integer
  Data3 As Integer
  Data4(7) As Byte

End Type

Private Type RASIPADDR

  a As Byte
  b As Byte
  c As Byte
  d As Byte

End Type

Private Type RASENTRY

  dwSize As Long
  dwfOptions As Long
  dwCountryID As Long
  dwCountryCode As Long
  szAreaCode(10) As Byte
  szLocalPhoneNumber(128) As Byte
  dwAlternateOffset As Long
  ipaddr As RASIPADDR
  ipaddrDns As RASIPADDR
  ipaddrDnsAlt As RASIPADDR
  ipaddrWins As RASIPADDR
  ipaddrWinsAlt As RASIPADDR
  dwFrameSize As Long
  dwfNetProtocols As Long
  dwFramingProtocol As Long
  szScript(259) As Byte
  szAutodialDll(259) As Byte
  szAutodialFunc(259) As Byte
  szDeviceType(16) As Byte
  szDeviceName(128) As Byte
  szX25PadType(32) As Byte
  szX25Address(200) As Byte
  szX25Facilities(200) As Byte
  szX25UserData(200) As Byte
  dwChannels As Long
  dwReserved1 As Long
  dwReserved2 As Long
  dwSubEntries As Long
  dwDialMode As Long
  dwDialExtraPercent As Long
  dwDialExtraSampleSeconds As Long
  dwHangUpExtraPercent As Long
  dwHangUpExtraSampleSeconds As Long
  dwIdleDisconnectSeconds As Long
  dwType As Long
  dwEncryptionType As Long
  dwCustomAuthKey As Long
  guidId As GUID
  szCustomDialDll(259) As Byte
  dwVpnStrategy As Long
  dwfOptions2 As Long
  dwfOptions3 As Long
  szDnsSuffix(255) As Byte
  dwTcpWindowSize As Long
  szPrerequisitePbk(259) As Byte
  szPrerequisiteEntry(256) As Byte
  dwRedialCount As Long
  dwRedialPause As Long

End Type

Private Type RASCREDENTIALS

  dwSize As Long
  dwMask As Long
  szUserName(256) As Byte
  szPassword(256) As Byte
  szDomain(15) As Byte

End Type

Private Const ET_None         As Long = 0 ' No encryption

Private Const ET_Require      As Long = 1 ' Require Encryption

Private Const ET_RequireMax   As Long = 2 ' Require max encryption

Private Const ET_Optional     As Long = 3 ' Do encryption if possible. None Ok.

Private Const VS_Default      As Long = 0 ' default (PPTP for now)

Private Const VS_PptpOnly     As Long = 1 ' Only PPTP is attempted.

Private Const VS_PptpFirst    As Long = 2 ' PPTP is tried first.

Private Const VS_L2tpOnly     As Long = 3 ' Only L2TP is attempted.

Private Const VS_L2tpFirst    As Long = 4 ' L2TP is tried first.

Private Const RASET_Phone     As Long = 1 ' Phone lines: modem, ISDN, X.25, etc

Private Const RASET_Vpn       As Long = 2 ' Virtual private network

Private Const RASET_Direct    As Long = 3 ' Direct connect: serial, parallel

Private Const RASET_Internet  As Long = 4 ' BaseCamp internet

Private Const RASET_Broadband As Long = 5 ' Broadband

Private Declare Function RasSetEntryProperties _
                Lib "rasapi32" _
                Alias "RasSetEntryPropertiesA" (ByVal lpszPhonebook As String, _
                                                ByVal lpszEntry As String, _
                                                lpRasEntry As RASENTRY, _
                                                ByVal dwEntryInfoSize As Long, _
                                                ByVal lpbDeviceInfo As Long, _
                                                ByVal dwDeviceInfoSize As Long) As Long

Private Declare Function RasSetCredentials _
                Lib "rasapi32" _
                Alias "RasSetCredentialsA" (ByVal lpszPhonebook As String, _
                                            ByVal lpszEntry As String, _
                                            lpCredentials As RASCREDENTIALS, _
                                            ByVal fClearCredentials As Long) As Long

Private Sub Command1_Click()

  Dim sEntryName As String, sUsername As String, sPassword As String

  '??VPN
  Dim sServer    As String

  sServer = "8.8.8.8 "
  sEntryName = "Kaban Telecom2 "
  sUsername = "кто непонял, тут логин"
  sPassword = "а тут пароль"

  If Create_VPN_Connection(sEntryName, sServer, sUsername, sPassword) Then
    If Connect_VPN_Connection(sEntryName) Then
      MsgBox "Успех"
    Else
      MsgBox "Облом"
    End If

  Else
    MsgBox "Облом"
  End If

End Sub

Function Create_VPN_Connection(ByVal sEntryName As String, _
                               ByVal sServer As String, _
                               ByVal sUsername As String, _
                               ByVal sPassword As String) As Boolean

  Dim re          As RASENTRY

  Dim rc          As RASCREDENTIALS

  Dim rtn         As Long

  Dim sDeviceName As String, sDeviceType As String

  Create_VPN_Connection = False

  sDeviceName = "WAN Miniport (PPTP) "
  sDeviceType = "vpn"

  With re
    .dwSize = LenB(re)
    '.dwCountryCode = 86: .dwCountryID = 86
    .dwDialExtraPercent = 75
    .dwDialExtraSampleSeconds = 120
    .dwDialMode = 1
    .dwfNetProtocols = 4
    .dwfOptions = 1007485711 '1024262928 îêíî 16777217, òåë. êîä ñòðàíû 1,
    .dwfOptions2 = 367
    .dwFramingProtocol = 1
    .dwHangUpExtraPercent = 10
    .dwHangUpExtraSampleSeconds = 120
    .dwRedialCount = 3
    .dwRedialPause = 60
    .dwType = RASET_Vpn
    CopyMemory .szDeviceName(0), ByVal sDeviceName, Len(sDeviceName)
    CopyMemory .szDeviceType(0), ByVal sDeviceType, Len(sDeviceType)
    CopyMemory .szLocalPhoneNumber(0), ByVal sServer, Len(sServer)
    .dwVpnStrategy = VS_PptpOnly ' VS_Default 'L2TP
    .dwEncryptionType = ET_Optional
  End With

  With rc
    .dwSize = LenB(rc)
    .dwMask = 11
    CopyMemory .szUserName(0), ByVal sUsername, Len(sUsername)
    CopyMemory .szPassword(0), ByVal sPassword, Len(sPassword)
  End With

  If RasSetEntryProperties(vbNullString, sEntryName, re, LenB(re), 0, 0) = 0 Then
    If RasSetCredentials(vbNullString, sEntryName, rc, 0) = 0 Then
      Create_VPN_Connection = True
    End If
  End If

End Function

Function Connect_VPN_Connection(ByVal sEntryName As String) As Boolean

  Dim lTemp     As Long

  Dim sUsername As String

  Dim sPassword As String

  Dim tRDP      As RASDIALPARAMS

  tRDP.dwSize = Len(tRDP) + 6
  CopyMemory tRDP.szEntryName(0), ByVal sEntryName, Len(sEntryName)
  'ChangeBytes sEntryName, DP.szEntryName
  'Get User name and password for the connection
  lTemp = RasGetEntryDialParams(vbNullString, tRDP, 0)

  If lTemp = 0 Then
    sUsername = Replace$(StrConv(tRDP.szUserName, vbUnicode), vbNullChar, vbNullString)
    sPassword = Replace$(StrConv(tRDP.szPassword, vbUnicode), vbNullChar, vbNullString)
    MsgBox sUsername & vbCrLf & sPassword
    Connect_VPN_Connection = RasDial(ByVal 0, vbNullString, tRDP, 1, ByVal 0, lTemp) = 0
    'Connect_VPN_Connection = True
  End If

End Function

Private Sub Command2_Click()

  Dim sEntryName As String, sUsername As String, sPassword As String

  '??PPPoE
  sEntryName = "???? "
  sUsername = "******"
  sPassword = "*******"

  If Create_PPPoE_Connection(sEntryName, sUsername, sPassword) Then
      MsgBox "Успех"
    Else
      MsgBox "Облом"
  End If

End Sub

Function Create_PPPoE_Connection(ByVal sEntryName As String, _
                                 ByVal sUsername As String, _
                                 ByVal sPassword As String) As Boolean

  Dim rtn         As Long

  Dim re          As RASENTRY

  Dim sDeviceName As String, sDeviceType As String

  Dim rc          As RASCREDENTIALS

  Create_PPPoE_Connection = False
  sDeviceName = "WAN ???? (PPPOE) "
  sDeviceType = "PPPoE"

  With re
    .dwSize = LenB(re)
    .dwCountryCode = 86
    .dwCountryID = 86
    .dwDialExtraPercent = 75
    .dwDialExtraSampleSeconds = 120
    .dwDialMode = 1
    .dwEncryptionType = 3
    .dwfNetProtocols = 4
    .dwfOptions = 1024262928
    .dwfOptions2 = 367
    .dwFramingProtocol = 1
    .dwHangUpExtraPercent = 10
    .dwHangUpExtraSampleSeconds = 120
    .dwRedialCount = 3
    .dwRedialPause = 60
    .dwType = RASET_Broadband
    CopyMemory .szDeviceName(0), ByVal sDeviceName, Len(sDeviceName)
    CopyMemory .szDeviceType(0), ByVal sDeviceType, Len(sDeviceType)
  End With

  With rc
    .dwSize = LenB(rc)
    .dwMask = 11
    CopyMemory .szUserName(0), ByVal sUsername, Len(sUsername)
    CopyMemory .szPassword(0), ByVal sPassword, Len(sPassword)
  End With

  If RasSetEntryProperties(vbNullString, sEntryName, re, LenB(re), 0, 0) = 0 Then
    If RasSetCredentials(vbNullString, sEntryName, rc, 0) = 0 Then
      Create_PPPoE_Connection = True
    End If
  End If

End Function


[Adam Smith]

Скомпилированный в VB6 ехе-шник не определяется ни одним из 46 антивиров,
НО стоит добавить / изменить его ресурсы, манифест, иконки, файл инфо как он тутже становится зловредным.

Люди, кто знает, пожалуйста объясните почему?

Суперантивиры типа Avira, BitDefender, Emsisoft, MicroWorld-eScan меняют отношение в зависимости от иконки?

Можно как-то бороться с этим? Можно как-то подавать файл ресурсов ВБшному линковщику, может всё дело в этом?

Я знаю, что в проект можно добавить RES-файл, но ехе-шник может и не скомпилировать если ресурсы сложные.

[Хакер]

Я знаю, что в проект можно добавить RES-файл, но ехе-шник может и не скомпилировать если ресурсы сложные.

Чушь.

[Adam Smith]

Добавил к проекту RES-файл, который раньше внедрял батником и ресхакером и теперь ехе-шник не компилируется.

Не хочешь, не верь, это всего лишь реальность.

[Хакер]

Оставайся при своём мнении, вот проблема-то. Мучайся, бейся, делай что пожелаешь.

[Adam Smith]

Проект не компилировался из-за конфликта иконки в РЕС файле с ВБшной.

Изменил номер, теперь компилируется, но главная проблема остается.

Ложно определяется чуть меньшим кол-вом антивиров, иконки зловреды