Темы

Прошу помощи у тех, кому повезло научиться коннектиться по DialUP через код VBA.
Функция  RasGetEntryDialParams и RasDial возвращают ошибку, что не найдена запись телефонной книги. Грешу, что в структуре RASDIALPARAMS что-то не так. Может, размер структуры задаю не так. Помогите добиться работоспособности этого кода!

[spoiler]

Код (vb) Выделить Развернуть


Option Explicit

Const RAS_MaxEntryName = 256
Const RAS_MaxPhoneNumber = 128
Const RAS_MaxCallbackNumber = RAS_MaxPhoneNumber
Const RAS_MaxAreaCode = 10
Const RAS_MaxDeviceType = 16
Const RAS_MaxDeviceName = 128
Const RAS_MaxPadType = 32
Const RAS_MaxX25Address = 200
Const RAS_MaxFacilities = 200
Const RAS_MaxUserData = 200
Const UNLEN = 256
Const PWLEN = 256
Const DNLEN = 15
Private Type RASDIALPARAMS

dwSize As Long ' 1052
dwSubEntry As Long
dwIfIndex As Long
dwCallbackId As Long
szEntryName(RAS_MaxEntryName + 1) As Byte
szPhoneNumber(RAS_MaxPhoneNumber + 1) As Byte
szCallbackNumber(RAS_MaxCallbackNumber + 1) As Byte
szUserName(UNLEN + 1) As Byte
szPassword(PWLEN + 1) As Byte
szDomain(DNLEN + 1) As Byte

End Type

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)
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 RasGetEntryDialParams Lib "rasapi32.dll" Alias "RasGetEntryDialParamsA" (ByVal lpcstr As String, ByRef lprasdialparamsa As RASDIALPARAMS, ByRef lpbool As Long) As Long

Sub gogogo()
Form.Show

End Sub
Private Sub Dial_xx()



Dim FParams As RASDIALPARAMS
Dim FConnHandle  As Long
Dim lpbool As Long

Dim t As Long
Dim resp As Long

Dim Path As String

FParams.dwSize = 1052

ChangeBytes "Internet Contract", FParams.szEntryName ' загнали текст имени соединения в переменную szEntryName (в виде байтов)

'path = "c:\ProgramData\Microsoft\Network\Connections\Pbk\rasphone.pbk" ' путь к телефонной книге. Из нее соединения коннектятся отлично

             t = RasGetEntryDialParams(vbNullString, FParams, lpbool)

FConnHandle = 0

            resp = RasDial(ByVal 0, ByVal 0, FParams, 0, ByVal 0, FConnHandle)
End Sub

Private Function ChangeBytes(ByVal str As String, Bytes() As Byte) As Boolean
'Конвертор текстовой стоки из Юникода в читабельный байтовый массив. Его кушает RasAPI:))
'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
ChangeBytes = True
End If
End Function

[/spoiler]

Вопрос пытался решить здесь: http://www.excel-vba.ru/forum/index.php?topic=2586.0
Обошел эту проблему через запуск бат-файла из VBA : http://www.excel-vba.ru/forum/index.php?topic=2650.new#new

Текст батника такой (где-то на форумах нашел и модифицировал под себя):
[spoiler]

@echo off
:: Имя соединения
set connection=Internet Contract
rasdial "%connection:"=%"
pause

[/spoiler]
Интересует все же первый способ коннекта через VBA посредством фции RasDial как более гибкий и технологичный.

Привет всем! Ребята, посоветуйте, как можно получить код ошибки Windows, которая может возникнуть при выполнении приложения?
К примеру, я стартую .bat- файл, который устанавливает интернет- соединение. Возможны случаи, когда система по какой-либо причине возвращает ошибку, о чем сообщает в окне cmd.exe. Как мне перехватить из VBA код этой ошибки для дальнейшей обработки?

[Вводные данные по софту и оборудованию]

Доброго времени суток всем! Прошу дельного совета по возникшей проблеме.

Вводные данные по софту и оборудованию:
Система: Windows 7 Prof SP1
Модем: HUAWEI Mobile Connect - 3G Modem. Провайдер: Киевстар. Вид подключения:EDGE
EXCEL: Excel 2003 SP3

Описание проблемы.
Имеется соединение с сетью посредством 3G модема HUAWEI. Модем определен в системе как ряд виртуальных устройств- USB-накопителя и модема собственно. Оболочка управления модемом автоматически инсталлится в систему при первом подключении. В дальнейшем можно выбрать тип подключения (Contract,Prepaid, XL, 3G и тп) Работаю по умолчанию на Internet Contract. Все соединения отображаются также в окне подключений Windows. Работаю с модемом через его программную оболочку.

Модем имеет неприятное свойство дисконнектиться по непонятной причине случайным образом или показывать соединение с сетью, но пинг не проходит- модем типа "зависает")).

Моя программа должна принимать и отправлять данные в Интернет посредством этого ненадежного "свистка". Собственно, при таком коннекте о полной автоматизации речи идти не может. Я поставил задачу определить наличие связи с Интернетом (пингуя сервер), и, если связи нет, пересбросить модем и подключиться вновь по соединению, заданному по умолчанию.
В процессе поиска решений данной проблемы докопался до функций RasAPI. На сегодня я  программно могу проверить наличие доступных соединений, сделать дисконнект соединения. А вот с коннектом происходят непонятки. Не получается установить соединение.

Лог моих действий и возникающие при этом проблемы:

1. Делаю вручную дисконнект (имитация разрыва связи)- успешно;
2. Программно проверяю наличие доступных соединений (RasEnumEntries)- успешно;
3. Программно пытаюсь получить данные по выбранному соединению(RasGetEntryDialParams)- возвращаемый массив почему-то пуст. Нет ни UserName, ни  PhoneNumber...
4. Программно пытаюсь подконнектиться с параметрами соединения по умолчанию (RasDial) .
4.1. Первое подключение- возвращает код 0- успешное соединение и тут же выкидывает сообщение:"Run-time error:-2147417848 (80010108) Automation error. Вызванный объект был отключен от клиентов"
4.2. Повторные попытки коннекта по данному соединению возвращает код 756- "соединение уже используется".
При этом соединение физически не устанавливается. При попытке подключиться через оболочку 3G модема или стандартную Windows (в обеих случаях присутствует кнопка "Подключение"), модем выдает ошибку 756- "соединение уже выполнено".

До тех пор, пока открыто мое приложение  Excel, ситуация не меняется. Выбранное соединение занято чем-то и доступ к нему не происходит. После закрытия приложения Excel  (при этом система долго думает) сразу становится возможным установить связь штатными средствами.

Я проверял работу модуля  на XP, но ситуация та же. Компиляция кода VBA происходит без ошибок типов и тп. Люди добрые,  я уже всю плешь проел с этой проблемой! Возможно, 3G модем как-то влияет на типовое использование функций RasAPI. Я в тупике... Проверить работу модуля на другом модеме не имею возможности.

Для примера приведу код, который я использовал для проверки возможности программного подключения к сети:

[spoiler]
'Программа выводит UserForm с названиями доступных соединений.
'После выбора соединения в List1 и нажатия кнопки Command1
'должен произойти коннект по выбранному соединению.


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)
' константы для структуры RASDIALPARAMS
Const RAS95_MaxEntryName = 256
Const RAS_MaxPhoneNumber = 128
Const RAS_MaxCallbackNumber = RAS_MaxPhoneNumber
Const UNLEN = 256
Const PWLEN = 256
Const DNLEN = 12

' описываем структуру RASDIALPARAMS (для функций RasGetEntryDialParams и RasDial). Структура содержит параметры выбранного соединения
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

' описываем структуру RASENTRYNAME95 (для функции RasEnumEntries)
Private Type RASENTRYNAME95
    dwSize As Long ' размер структуры (264 байт)
    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 Sub UserForm_Activate()
   
    Command1.Caption = "Dial"
    Dim s As Long, i As Long, ln As Long, a$
    ReDim rdp(255) As RASENTRYNAME95
   
    rdp(0).dwSize = 264
    s = 256 * rdp(0).dwSize ' задали размер структуры
    i = RasEnumEntries(vbNullString, vbNullString, rdp(0), s, ln) ' получили имена всех доступных соединений и сохранили их в массиве rdp
    ' функция вернет в переменной ln количество доступных соединений
    ' заполняем читабельными именами ListBox
    For i = 0 To ln - 1
        a$ = StrConv(rdp(i).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

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 Command1_Click()
   
    Dial List1.Text

End Sub

Private Function Dial(ByVal Connection As String) As Boolean
    ' дозвон по выбранному соединению
   
    Dim rdp As RASDIALPARAMS, h As Long, resp As Long, str As String, t As Long
   
    rdp.dwSize = Len(rdp) + 6 ' задали размер структуры
    ChangeBytes Connection, rdp.szEntryName 'перевели выбранное имя в байтовый массив и поместили его в структуру RASDIALPARAMS
       
        t = RasGetEntryDialParams(vbNullString, rdp, 0) ' тут можно вытянуть параметры по выбранному соединению.
        ' Однако не вытягиваются ни PhoneNumber, ни UserName...
   
    h = 0 ' обнулили хэндл соединения
        resp = RasDial(0, 0, rdp, 0, 0, h)   'Звоним! Возвращаемый код resp:0-дозвон успешно состоялся;756-Подключение уже выполнено
    Dial = (resp = 0)

End Function

'---------- Вспомогательные функции -------------------------------

Private Function ChangeToStringUni(Bytes() As Byte) As String
    'Трансформируем байтовый массив в UniCode, пригодный для чтения
   
    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
    'Трансформируем  строку UniCode в байтовый массив, пригодный для RasAPI- функций
 
    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
        ChangeBytes = True
    End If

End Function

[/spoiler]

Спасибо, что дочитали до конца! )). Помогите добрым словом и компетентным советом, пожалуйста!