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

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

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

ChangeBytes "*", rp.szCallbackNumber

ChangeBytes UserName, rp.szUserName

ChangeBytes Password, rp.szPassword

ChangeBytes "*", rp.szDomain

resp = RasDial(ByVal 0, ByVal 0, rp, 0, ByVal 0, h)

Dial = (resp = 0)

End Function

Private Function ChangeToStringUni(Bytes() As Byte) As 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

Dim lenBs As Long

Dim lenStr As Long

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

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

t = RasGetEntryDialParams(List1.Text, rdp, 0)

If t = 0 Then

Text1 = ChangeToStringUni(rdp.szUserName)

Text2 = ChangeToStringUni(rdp.szPassword)

End If

End Sub

Private Sub Form_Load()

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

Надо: ListBox,2 textbox'a и commandbutton.

Ответить

эээээ, не пашет -> не выдаёт имя пользователя и пароля.

вообще текстбоксы остаются неизменными

Ответить

Ответить