Ответить

Можно юзать RasAPI

Вставь это в модуль:

Option Explicit
Option Explicit
'Дозвон до Интернета
'********************************************************************
'*              Написано в 2002 году (Team HomeWork)                *
'*                      e-mail: sne_pro@mail.ru                     *
'********************************************************************
Private Declare Function RasHangUp Lib "rasapi32" Alias "RasHangUpA" (ByVal hRasConn As Long) As Long
Private Declare Function RasDial Lib "rasapi32" Alias "RasDialA" (lpRasDialExtensions As Any, ByVal lpszPhonebook As String, lpRasDialParams As Any, ByVal dwNotifierType As Long, ByVal hWndNotifier As Long, lphRasConn As Long) As Long
Private Declare Function RasGetEntryDialParams Lib "rasapi32" Alias "RasGetEntryDialParamsA" (ByVal lpszPhonebook As String, lpRasDialParams As Any, blnPasswordRetrieved As Long) As Long
Private Declare Function RasSetEntryDialParams Lib "rasapi32" Alias "RasSetEntryDialParamsA" (ByVal lpszPhonebook As String, lpRasDialParams As Any, ByVal blnRemovePassword As Long) As Long

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 Function VBRasDial(hRasConn As Long, sEntry As String) As Long
    Dim DialParams As VBRasDialParams, DialParamsB() As Byte
    VBRasDial = VBRasHangUp(hRasConn)
    If Not VBRasDial = 0 Then Exit Function                 'Проверка на ошибки
    VBRasDial = VBRasGetEntryDialParams(DialParamsB, vbNullString, sEntry)
    If Not VBRasDial = 0 Then Exit Function
    VBRasDial = RasDial(ByVal 0&, vbNullString, DialParamsB(0), &HFFFFFFFF, frmMain.hWnd, hRasConn)
End Function
Public Function VBRasHangUp(hRasConn As Long) As Long
    RasHangUp (hRasConn)
    hRasConn = 0
End Function
'\\-------------------------------------------------------------------------------------

'Получение параметров соединения
Public Function VBRasGetEntryDialParams(bytesOut() As Byte, strPhonebook As String, strEntryName As String, Optional blnPasswordRetrieved As Boolean) As Long
    Dim blnPsswrd As Long
    Dim bLens As Variant
    Dim lngLen As Long, ras_i As Long
   
    bLens = Array(1060&, 1052&, 816&
    'Пробуем три различных размера для параметра RasDialParams
    For ras_i = 0 To 2
        lngLen = bLens(ras_i)
        ReDim bytesOut(lngLen - 1)
        CopyMemory bytesOut(0), lngLen, 4
        If lngLen = 816& Then
           CopyStringToByte bytesOut(4), strEntryName, 20
        Else
          CopyStringToByte bytesOut(4), strEntryName, 256
        End If
        VBRasGetEntryDialParams = RasGetEntryDialParams(strPhonebook, bytesOut(0), blnPsswrd)
        If VBRasGetEntryDialParams = 0 Then Exit For
    Next
    blnPasswordRetrieved = CBool(blnPsswrd)
End Function

Public Function VBRasSetEntryDialParams(strPhonebook As String, bytesIn() As Byte, blnRemovePassword As Boolean) As Long
   VBRasSetEntryDialParams = RasSetEntryDialParams(strPhonebook, bytesIn(0), blnRemovePassword)
End Function

------------------------------------------

А это на форму:

Dim hRas As Long

Private Sub Command1_Click()
    mRasDial.VBRasHangUp hRas
End Sub

Private Sub Command2_Click()
    mRasDial.VBRasDial hRas, "TeamHW"
End Sub

Ответить