VBA EXCEL и RAS API. Как установить коннект через Dial-Up?
Формулировка задачи:
Привет! Столкнулся с необходимостью выполнить следующие задачи, связанные с удаленным соединением:
1. Проверить наличие и статус удаленного соединения;
2. Если статус соединения- "разъединено", то выполнить коннект.
3. При необходимости разорвать соединение.
Перерыл много форумов и вышел на функции RAS API. Удалось решить вопросы 1(используя функции RasEnumConnections и RasGetConnectStatus) и 3 (используя функцию RasHangUp). Т.е. теперь я могу узнать, что соединение физически существует и оно соединено/разорвано. Могу его разорвать принудительно.
Но вот никак не разберусь с функцией RasDial, которая устанавливает соединение. Мне достаточно использовать параметры соединения по умолчанию, необходимо только правильно задать переменные для этой функции, с чем, подозреваю, у меня проблемы.
К сожалению, я не программирую в Delphi или С++, а все примеры по использованию функций RAS API прописаны, в основном, на этих языках.
Прошу знающих людей помочь с кодом VBA для вызова функции RasDial и установлением соединения.
P.S. Как вариант, рассматриваю возможность оперировать с соотв. окнами через API-функции, но это как-то коряво, учитывая, что они опять же, сами используют RAS API в своей работе.
1. Проверить наличие и статус удаленного соединения;
2. Если статус соединения- "разъединено", то выполнить коннект.
3. При необходимости разорвать соединение.
Перерыл много форумов и вышел на функции RAS API. Удалось решить вопросы 1(используя функции RasEnumConnections и RasGetConnectStatus) и 3 (используя функцию RasHangUp). Т.е. теперь я могу узнать, что соединение физически существует и оно соединено/разорвано. Могу его разорвать принудительно.
Но вот никак не разберусь с функцией RasDial, которая устанавливает соединение. Мне достаточно использовать параметры соединения по умолчанию, необходимо только правильно задать переменные для этой функции, с чем, подозреваю, у меня проблемы.
К сожалению, я не программирую в Delphi или С++, а все примеры по использованию функций RAS API прописаны, в основном, на этих языках.
Прошу знающих людей помочь с кодом VBA для вызова функции RasDial и установлением соединения.
P.S. Как вариант, рассматриваю возможность оперировать с соотв. окнами через API-функции, но это как-то коряво, учитывая, что они опять же, сами используют RAS API в своей работе.
Решение задачи: «VBA EXCEL и RAS API. Как установить коннект через Dial-Up?»
textual
Листинг программы
'This program let you dial to your dial-up connections using whether 'the stored user name and password or the ones you specifies '(It use RasDial for dialing) '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 Long, 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) As Boolean Dim rp As RASDIALPARAMS, h As Long, resp As Long, str As String, t As Long rp.dwSize = Len(rp) + 6 ChangeBytes Connection, rp.szEntryName t = RasGetEntryDialParams(vbNullString, rp, 0) h = 0 'Dial resp = RasDial(0, 0, rp, 0, 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 End Sub Private Sub List1_Click() Dim rdp As RASDIALPARAMS, t As Long rdp.dwSize = Len(rdp) + 6 ChangeBytes List1.Text, rdp.szEntryName End Sub Private Sub UserForm_Activate() 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
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д