VBNet - Форум - Dialer под .Net

Вопрос: Dialer под .Net Добавлено: 02.04.06 00:39

Автор вопроса: mich | Web-сайт: belkyokushin.net | ICQ: 261800349

Переводил код Sne под Net
Вот что получилось:

Option Explicit On

Module Module1
    Public f As New Form1
    Sub main()
        Application.Run(f)
    End Sub
End Module

Public Class clsRasDial

    Private Overloads Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Integer, ByVal nIndex As Integer, ByVal dwNewLong As Integer) As Integer
    Delegate Function ConnectedRapiDelegate(ByVal hRasCon As Integer, ByVal unMsg As Integer, ByVal RascOnState As Integer, ByVal dwError As Integer, ByRef dwExtendedError As Integer) As Integer
    Private Overloads Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Integer, ByVal nIndex As Integer, ByVal dwNewLong As ConnectedRapiDelegate) As Integer

    Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Integer, ByVal hwnd As Integer, ByVal Msg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
    Private Declare Function RegisterWindowMessage Lib "user32" Alias "RegisterWindowMessageA" (ByVal lpString As String) As Integer
    Private lngHandle As Integer
    Private OldWndProc As Integer
    Private WinProcMsg As Integer
    'Написано в 2002 году (Team HomeWork) e-mail: sne_pro@mail.ru
    Private Declare Function RasHangUp Lib "rasapi32" Alias "RasHangUpA" (ByVal hRasConn As Integer) As Integer
    Private Overloads Declare Function RasDial Lib "rasapi32" Alias "RasDialA" (ByRef lpRasDialExtensions As Integer, ByVal lpszPhonebook As String, ByRef lpRasDialParams As Byte, ByVal dwNotifierType As Integer, ByVal hWndNotifier As Integer, ByRef lphRasConn As Integer) As Integer
    Private Overloads Declare Function RasGetEntryDialParams Lib "rasapi32" Alias "RasGetEntryDialParamsA" (ByVal lpszPhonebook As String, ByRef lpRasDialParams As Byte, ByRef blnPasswordRetrieved As Integer) As Integer
    Private Overloads Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef Destination As Byte, ByRef Source As String, ByVal Length As Integer)
    Private Overloads Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef Destination As Byte, ByRef Source As Integer, ByVal Length As Integer)
    Private Declare Function RasGetErrorString Lib "rasapi32" Alias "RasGetErrorStringA" (ByVal uErrorValue As Integer, ByVal lpszErrorString As String, ByRef cBufSize As Integer) As Integer
    Private Overloads Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" (ByVal dwFlags As Integer, ByRef lpSource As Integer, ByVal dwMessageId As Integer, ByVal dwLanguageId As Integer, ByVal lpBuffer As String, ByVal nSize As Integer, ByRef Arguments As Integer) As Integer
    Private Const WM_RASDIALEVENT As Integer = &HCCCD

    Public Structure VBRasDialParams
        Dim EntryName As String
        Dim PhoneNumber As String
        Dim CallbackNumber As String
        Dim UserName As String
        Dim Password As String
        Dim Domain As String
        Dim SubEntryIndex As Integer
        Dim RasDialFunc2CallbackId As Integer
    End Structure
    Public Enum RASCONNSTATE
        RASCS_OpenPort = &H0
        RASCS_PortOpened = &H1
        RASCS_ConnectDevice = &H2
        RASCS_DeviceConnected = &H3
        RASCS_AllDevicesConnected = &H4
        RASCS_Authenticate = &H5
        RASCS_AuthNotify = &H6
        RASCS_AuthRetry = &H7
        RASCS_AuthCallback = &H8
        RASCS_AuthChangePassword = &H9
        RASCS_AuthProject = &HA
        RASCS_AuthLinkSpeed = &HB
        RASCS_AuthAck = &HC
        RASCS_ReAuthenticate = &HD
        RASCS_Authenticated = &HE
        RASCS_PrepareForCallback = &HF
        RASCS_WaitForModemReset = &H10
        RASCS_WaitForCallback = &H11
        RASCS_Projected = &H12
        RASCS_StartAuthentication = &H13
        RASCS_CallbackComplete = &H14
        RASCS_LogonNetwork = &H15
        RASCS_SubEntryConnected = &H16
        RASCS_SubEntryDisconnected = &H17
        RASCS_Interactive = &H1000
        RASCS_RetryAuthentication = &H1001
        RASCS_CallbackSetByCaller = &H1002
        RASCS_PasswordExpired = &H1003
        RASCS_InvokeEapUI = &H1004
        RASCS_Connected = &H2000
        RASCS_Disconnected = &H2001
    End Enum

    '\\-------------------------------------------------------------------------------------
    Public Function VBRasDial(ByRef hRasConn As Integer, ByRef sEntry As String) As Integer
        On Error Resume Next
        Dim DialParams As VBRasDialParams
        Dim 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
        Dim ByVal0 As Integer = 0
        VBRasDial = RasDial(0, vbNullString, DialParamsB(0), &HFFFFFFFF, f.Handle.ToInt32, hRasConn)
    End Function
    Public Function VBRasHangUp(ByRef hRasConn As Integer) As Integer
        On Error Resume Next
        RasHangUp(hRasConn)
        hRasConn = 0
    End Function
    Private Function GetAddress(ByVal lngaddress As Integer)
        GetAddress = lngaddress
    End Function
    '\\-------------------------------------------------------------------------------------

    'Получение параметров соединения
    Public Function VBRasGetEntryDialParams(ByRef bytesOut() As Byte, ByRef strPhonebook As String, ByRef strEntryName As String, Optional ByRef blnPasswordRetrieved As Boolean = False) As Integer
        On Error Resume Next
        Dim blnPsswrd As Integer
        Dim bLens As Object
        Dim lngLen As Integer, ras_i As Integer

        bLens = New Integer() {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

    Private Sub CopyStringToByte(ByRef bPos As Byte, ByRef strToCopy As String, ByRef lngMaxLen As Integer)
        On Error Resume Next
        Dim lngLen As Integer
        lngLen = Len(strToCopy)
        If lngLen = 0 Then
            Exit Sub
        ElseIf lngLen > lngMaxLen Then
            lngLen = lngMaxLen
        End If
        Dim ByValstrToCopy As String = strToCopy
        CopyMemory(bPos, ByValstrToCopy, lngLen)
        'CopyMemory(bPos, strToCopy, lngLen)
    End Sub

    Private Function VBRASErrorHandler(ByRef lngErr As Integer) As String
        On Error Resume Next
        Dim strError As String, ras_i As Integer
        'strError = String(512, 0)
        'strError = Space(512)
        strError = New String(Chr(0), 512)

        If lngErr > 600 Then
            Dim Int512 As Integer = 512
            RasGetErrorString(lngErr, strError, Int512)
        Else
            Dim ByVal01 As Integer = 0
            Dim ByVal02 As Integer = 0
            Dim ByVal03 As Integer = 0
            Dim Int0 As Integer = 0
            FormatMessage(&H1000, ByVal01, lngErr, Int0, strError, 512, ByVal03)
        End If
        ras_i = InStr(strError, vbNullChar)
        If ras_i > 1 Then VBRASErrorHandler = Left(strError, ras_i - 1)
        ras_i = InStr(strError, vbCrLf)
        If ras_i > 1 Then VBRASErrorHandler = Left(strError, ras_i - 1)
    End Function

    Public Function RasDialFunc1(ByVal hRasCon As Integer, ByVal unMsg As Integer, ByVal RascOnState As Integer, ByVal dwError As Integer, ByRef dwExtendedError As Integer) As Integer
        On Error Resume Next
        Dim s As String
        If unMsg = RegisterWindowMessage("RASDIALEVENT") Then
            Select Case RascOnState
                Case Is = RASCONNSTATE.RASCS_OpenPort : s = "Port is about to be opened..."
                Case Is = RASCONNSTATE.RASCS_PortOpened : s = "Port has been opened..."

                Case Is = RASCONNSTATE.RASCS_ConnectDevice : s = "A device is about to be connected..."
                Case Is = RASCONNSTATE.RASCS_DeviceConnected : s = "A device has connected successfully..."
                Case Is = RASCONNSTATE.RASCS_AllDevicesConnected : s = "All devices in the device chain have successfully connected..."

                Case Is = RASCONNSTATE.RASCS_StartAuthentication : s = "User authentication is being initiated or retried..."
                Case Is = RASCONNSTATE.RASCS_Authenticate : s = "The authentication process is starting..."
                Case Is = RASCONNSTATE.RASCS_AuthNotify : s = "An authentication event has occurred..."
                Case Is = RASCONNSTATE.RASCS_AuthRetry : s = "The client has requested another validation attempt with a new user name/password/domain..."
                Case Is = RASCONNSTATE.RASCS_AuthCallback : s = "The remote access server has requested a callback number..."
                Case Is = RASCONNSTATE.RASCS_AuthChangePassword : s = "The client has requested to change the password on the account..."
                Case Is = RASCONNSTATE.RASCS_AuthProject : s = "The projection phase is starting..."
                Case Is = RASCONNSTATE.RASCS_AuthLinkSpeed : s = "The link-speed calculation phase is starting..."
                Case Is = RASCONNSTATE.RASCS_AuthAck : s = "An authentication request is being acknowledged..."
                Case Is = RASCONNSTATE.RASCS_ReAuthenticate : s = "Reauthentication (after callback) is starting..."
                Case Is = RASCONNSTATE.RASCS_Authenticated : s = "The client has successfully completed authentication..."

                Case Is = RASCONNSTATE.RASCS_PrepareForCallback : s = "The line is about to disconnect in preparation for callback..."
                Case Is = RASCONNSTATE.RASCS_WaitForCallback : s = "The client is waiting for an incoming call from the remote access server..."
                Case Is = RASCONNSTATE.RASCS_CallbackComplete : s = "Client has been called back and is about to resume authentication..."

                Case Is = RASCONNSTATE.RASCS_WaitForModemReset : s = "The client is delaying in order to give the modem time to reset itself in preparation for callback..."
                Case Is = RASCONNSTATE.RASCS_Projected : s = "Projection result information is available..."
                Case Is = RASCONNSTATE.RASCS_LogonNetwork : s = "Client is logging on to the network..."

                Case Is = RASCONNSTATE.RASCS_Interactive : s = "Terminal state supported by RASPHONE.EXE..."
                Case Is = RASCONNSTATE.RASCS_RetryAuthentication : s = "Retry authentication state supported by RASPHONE.EXE..."
                Case Is = RASCONNSTATE.RASCS_CallbackSetByCaller : s = "Callback state supported by RASPHONE.EXE..."
                Case Is = RASCONNSTATE.RASCS_PasswordExpired : s = "Change password state supported by RASPHONE.EXE..."

                Case Is = RASCONNSTATE.RASCS_Connected : s = "Connected..."
                Case Is = RASCONNSTATE.RASCS_Disconnected : s = "Disconnected..."

                Case Is = RASCONNSTATE.RASCS_SubEntryConnected : s = "Subentry has been connected during the dialing process"
                Case Is = RASCONNSTATE.RASCS_SubEntryDisconnected : s = "Subentry has been disconnected during the dialing process"
            End Select

            f.Text = s & " _ " & VBRASErrorHandler(dwError) & " _ " & dwError
        End If
        RasDialFunc1 = CallWindowProc(OldWndProc, hRasCon, unMsg, RascOnState, dwError)
    End Function

    Public Sub SetRasDialLog(ByRef hwnd As Integer)
        On Error Resume Next
        OldWndProc = SetWindowLong(hwnd, -4, AddressOf RasDialFunc1)
        lngHandle = hwnd
    End Sub

    Public Sub DelRasDialLog()
        On Error Resume Next
        SetWindowLong(lngHandle, -4, OldWndProc)
    End Sub

End Class

код формы:

    Dim r As New clsRasDial
    Dim hRas As Integer
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        MsgBox(r.VBRasDial(hRas, "grsu"))
    End Sub
    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
        Call r.VBRasHangUp(hRas)
    End Sub

Ошибка:

r.VBRasDial(hRas, "grsu") <> 0

Что не так?
Ответить

Ответы Всего ответов: 7

Номер ответа: 1 Автор ответа: mich ICQ: 261800349 Вопросов: 19 Ответов: 148	Web-сайт: belkyokushin.net Профиль \| \| #1	Добавлено: 02.04.06 00:41
	Могу и оригинальный код написать, если Sne не против. Ответить

Номер ответа: 2 Автор ответа: sne Разработчик Offline Client ICQ: 233286456 Вопросов: 34 Ответов: 5445	Web-сайт: hw.t-k.ru Профиль \| \| #2	Добавлено: 02.04.06 10:41
	ну а мне-то что ? Пиши конечно Ответить

Номер ответа: 3 Автор ответа: mich ICQ: 261800349 Вопросов: 19 Ответов: 148	Web-сайт: belkyokushin.net Профиль \| \| #3	Добавлено: 03.04.06 23:55
	А как насчет желания помочь? Ответить

Номер ответа: 4 Автор ответа: sne Разработчик Offline Client ICQ: 233286456 Вопросов: 34 Ответов: 5445	Web-сайт: hw.t-k.ru Профиль \| \| #4	Добавлено: 04.04.06 23:45
	Никакого Ибо времени нема... Ответить

Номер ответа: 5 Автор ответа: mich ICQ: 261800349 Вопросов: 19 Ответов: 148	Web-сайт: belkyokushin.net Профиль \| \| #5	Добавлено: 05.04.06 10:45
	... пиво, девки и селЁдка Ответить

Номер ответа: 6 Автор ответа: sne Разработчик Offline Client ICQ: 233286456 Вопросов: 34 Ответов: 5445	Web-сайт: hw.t-k.ru Профиль \| \| #6	Добавлено: 06.04.06 02:11
	ну... ЗЫ Я похож на фаната точки !? Ответить

Номер ответа: 7 Автор ответа: mich ICQ: 261800349 Вопросов: 19 Ответов: 148	Web-сайт: belkyokushin.net Профиль \| \| #7	Добавлено: 06.04.06 13:04
	неа, а вот на фоната форума похож немного Ответить

Страница: 1 |