Visual Basic, .NET, ASP, VBScript
Новости | Примеры | Библиотека кодов | НеЧаВо | VBA | Справочник по VB | Справочник по WinAPI | ActiveX контролы | Статьи по VB | Мастерская разработчика | Форум VBNet | Яndex bar! | Голосование | Полезные программы | Магазин VBNet | Рассылка | Конкурсы | Юмор | Чат | Реклама на VBNet | Автора! | Ссылки | Бета-тестирование | Послать пример на сайт
 

   
   
     

Форум - Общий форум

Страница: 1 | 2 |

 

  Вопрос: Conneting Добавлено: 17.10.04 18:48  

Автор вопроса:  someone | Web-сайт: 123
Необходимо вызвать окно "Подключение удаленного доступа". Как это сделать НЕ ИМЕЯ сведений про интернет данные пользователя, либо узнавая их на ходу?

Ответить

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

Номер ответа: 1
Автор ответа:
 HACKER


 

Разработчик Offline Client

Вопросов: 236
Ответов: 8362
  Профиль | | #1 Добавлено: 17.10.04 22:13
Так всётаки надо знать имя соединения, или посмотреть его в реестре на ходу :)

Ответить

Номер ответа: 2
Автор ответа:
 mc-black



ICQ: 308-534-060 

Вопросов: 20
Ответов: 1860
  Web-сайт: mc-black.narod.ru/dzp.htm
 Профиль | | #2 		Добавлено: 17.10.04 23:12
Да именно, надо взять в реестре все соединения, которые имеются и вывести в ComboBox какой-нибудь, так во многих программах делают. The Bat!, например... Где ключик лежит - меня не спрашивайте.. самим надо уметь искать :)

Ответить

Номер ответа: 3
Автор ответа:
 DaSharm



ICQ: 780477 

Вопросов: 72
Ответов: 1297
  Web-сайт: dasharm.com
 Профиль | | #3 		Добавлено: 18.10.04 18:22
use shell functions:

rasphone /?
rasdial /?

Ответить

Номер ответа: 4
Автор ответа:
 someone



Вопросов: 215
Ответов: 1596
  Web-сайт: 123
 Профиль | | #4 		Добавлено: 18.10.04 20:32
2DaSharm: поконкретнее, плиз
2Hacker: ну дык а не знаешь, где исходняк?
2Admins: в Библ. кодов неправильный код, он вызывает окно статистики текущего соединения
http://vbnet.ru/faq/showtopic.asp?id=67

Ответить

Номер ответа: 5
Автор ответа:
 Alexandrus



ICQ: 496782368 

Вопросов: 18
Ответов: 312
  Web-сайт: starsorion.com
 Профиль | | #5 		Добавлено: 18.10.04 22:11
Да нет , код там как раз правильный , и делает он то ,что делает и делает правильно ! И нечего пенять ...
А звонилка там тоже есть ,и ее тоже sne написал и звонит и перечисляет соединения !

С ув. Alex

Ответить

Номер ответа: 6
Автор ответа:
 HACKER


 

Разработчик Offline Client

Вопросов: 236
Ответов: 8362
  Профиль | | #6 Добавлено: 18.10.04 23:02
2 Empro

Исходяк... я сам как вспомню скоко мороки... я тож всех задрачивал... потом прикинь на 80% написать звонилку, а потом у меня крах всего на свете... и короче все пропало :( Я токо помню шо мне sne модуль прикольный давал, там вообше в с ним всё элементарно, ну да ладно, рознылся я что-то... вот впринципе то что тебе нужно:

1) На форме контролы:

lstConnections (лист там где будет список соединений)
3 батона, cmdConnect, cmdCheck, cmdDisconnect
и типа строка состояния txtStatus

2) Это в код формы:

Option Explicit
'
' Instance of the WinInet class.
'
Private WithEvents fInet As WinInet
Private Sub cmdCheck_Click()
    '
    ' Check the connection status.
    '
    If fInet.Connected Then
        Call pAddToStatus("Internet connection active.";)
    Else
        Call pAddToStatus("No active internet connection.";)
    End If
End Sub
Private Sub cmdConnect_Click()
Dim lngResult As Long
    
    With lstConnections
    
    If .ListIndex = -1 Then
        Call MsgBox("Please select a DUN connection to use.", vbExclamation, "WinInet Demo";)
    Else
        lngResult = fInet.StartDUN(Me.hWnd, .List(.ListIndex))
        
        If lngResult = 0 Then
            Call pAddToStatus("Connection to " & .List(.ListIndex) & " established.";)
        Else
            If lngResult = -1 Then
                Call pAddToStatus("Already connected.";)
            Else
                Call pAddToStatus("Error " & lngResult & " attempting to connect to " & .List(.ListIndex))
            End If
        End If
    End If
    
    End With
End Sub
Private Sub cmdDisconnect_Click()
Dim lngResult As Long
    
    lngResult = fInet.HangUp
    
    If lngResult = 0 Then
        Call pAddToStatus("Connection terminated.";)
    Else
        If lngResult = -1 Then
            Call pAddToStatus("No existing connection.";)
        Else
            Call pAddToStatus("Unable to terminate connection, error: " & lngResult)
        End If
    End If
End Sub
Private Sub fInet_ConnectionClosed()
    '
    ' This event does not "monitor" the connection status.
    ' It is only fired when the .HangUp method is invoked.
    '
    Call pAddToStatus("Connection closed event fired.";)
    
End Sub
Private Sub fInet_ConnectionMade()
    '
    ' This event does not "monitor" the connection status.
    ' It is fired when a successfull connection is made via
    ' the .StartDUN method.
    '
    Call pAddToStatus("Connection made event fired.";)
    
End Sub
Private Sub Form_Load()
Dim strDuns() As String
Dim lngIndex As Long
    '
    ' Initialize the WinInet class
    '
    On Error Resume Next
    Set fInet = New WinInet

    '
    ' Get list of DUNs on the system.
    '
    Call fInet.ListDUNs(strDuns)
    
    '
    ' Add them to the listbox.
    '
    lstConnections.Clear
    
    For lngIndex = 0 To UBound(strDuns)
        lstConnections.AddItem strDuns(lngIndex)
    Next
    
    txtStatus.Text = "Class initialized." & vbCrLf
End Sub
Private Sub pAddToStatus(ByVal strText As String)
    '
    ' Add the text to the textbox and
    ' scroll it into view if necessary.
    '
    With txtStatus
        .Text = .Text & strText & vbCrLf
        .SelStart = Len(.Text)
        .SelLength = 0
    End With
End Sub
Private Sub Form_Unload(Cancel As Integer)
    '
    ' Clear reference to class.
    '
    Set fInet = Nothing
    Set frmMain = Nothing
End Sub

'===================================
2) Это в класс WinInet

Option Explicit

' Private variables
Private mlConnectionNumber As Long
Private mbDisconnectOnTerminate As Boolean

' Used to list the DUN connections
Private Type RAS_ENTRIES
    dwSize As Long
    szEntryname(256) As Byte
End Type

Private Declare Function RasEnumEntriesA Lib "rasapi32.dll" _
    ;(ByVal reserved As String, ByVal lpszPhonebook As String, _
    lprasentryname As Any, lpcb As Long, lpcEntries As Long) As Long

' For the fActiveConnection function
Private Const HKEY_LOCAL_MACHINE As Long = &H80000002
Private Declare Function RegCloseKey Lib "advapi32.dll" _
    ;(ByVal hKey As Long) As Long
    
Private Declare Function RegOpenKey Lib "advapi32.dll" _
    Alias "RegOpenKeyA" (ByVal hKey As Long, _
    ByVal sSubKey As String, hKey As Long) As Long
    
Private Declare Function RegQueryValueEx Lib "advapi32.dll" _
    Alias "RegQueryValueExA" (ByVal hKey As Long, _
    ByVal sKeyValue As String, ByVal lpReserved As Long, _
    lpType As Long, lpData As Any, nSizeData As Long) As Long

' For Dial and Hangup functions
Private Declare Function InternetDial Lib "wininet.dll" _
    ;(ByVal hWnd As Long, ByVal sConnectoid As String, _
    ByVal dwFlags As Long, lpdwConnection As Long, _
    ByVal dwReserved As Long) As Long
'Returns ERROR_SUCCESS if successfull
' ERROR_INVALID_PARAMETER - one or more parameters are incorrect
' ERROR_NO_CONNECTION - There is a problem with the dial-up connection
' ERROR_USER_DISCONNECTION - The user clicked either the work offline or cancel button on the dialog box
    
Private Declare Function InternetHangUp Lib "wininet.dll" _
    ;(ByVal dwConnection As Long, ByVal dwReserved As Long) As Long
' Returns ERROR_SUCCESS if successfull or an error value otherwise.

' InternetAutodial flags
Private Const INTERNET_AUTODIAL_FORCE_ONLINE = &H1
Private Const INTERNET_AUTODIAL_FORCE_UNATTENDED = &H2
Private Const INTERNET_AUTODIAL_FAILIFSECURITYCHECK = &H4

' InternetDial Flags - must not conflict with InternetAutodial
' flags as they are valid here also.
Private Const INTERNET_DIAL_FORCE_PROMPT = &H2000
Private Const INTERNET_DIAL_SHOW_OFFLINE = &H4000
Private Const INTERNET_DIAL_UNATTENDED = &H8000

' Windows error constants.
Private Const ERROR_SUCCESS As Long = 0&
Private Const ERROR_INVALID_PARAMETER = 87&

' RAS error constants
Private Const RASBASE As Long = 600& 'not sure about this couldn't find raserror.h anywhere on MSDN so
                                     'best-guessed the value based on return code of 631 for cancel button
Private Const ERROR_NO_CONNECTION = (RASBASE + 68&;)
Private Const ERROR_USER_DISCONNECTION = (RASBASE + 31&;)

' Events for this module
Public Event ConnectionMade()
Public Event ConnectionClosed()
Private Sub Class_Initialize()

    mlConnectionNumber = 0&
    mbDisconnectOnTerminate = False
    
End Sub
Private Sub Class_Terminate()

    If mbDisconnectOnTerminate And mlConnectionNumber <> 0 Then
        Call InternetHangUp(mlConnectionNumber, 0&;)
    End If
    
End Sub
Public Property Get Connected() As Boolean

    Connected = fActiveConnection()
    
End Property
Public Property Get DisconnectOnTerminate() As Boolean

    ;DisconnectOnTerminate = mbDisconnectOnTerminate
    
End Property
Public Property Let DisconnectOnTerminate(ByVal bValue As Boolean)

    mbDisconnectOnTerminate = bValue
    
End Property
Public Function HangUp() As Long

    If mlConnectionNumber = 0 Then
        '
        ' No connection from this module.
        '
        HangUp = -1
    Else
        HangUp = InternetHangUp(mlConnectionNumber, 0&;)
        mlConnectionNumber = 0&
        
        RaiseEvent ConnectionClosed
    End If
    
End Function
Public Sub ListDUNs(sDunList() As String)
Dim lngSize As Long
Dim lngEntries As Long
Dim strConName As String
Dim lngIndex As Long
Dim RAS(255) As RAS_ENTRIES
    
    Erase sDunList()
    
    RAS(0).dwSize = 264
    lngSize = 256 * RAS(0).dwSize
    
    Call RasEnumEntriesA(vbNullString, vbNullString, RAS(0), lngSize, lngEntries)
    
    lngEntries = lngEntries - 1
    
    If lngEntries >= 0 Then
        ReDim sDunList(lngEntries)
        
        For lngIndex = 0 To lngEntries
            strConName = StrConv(RAS(lngIndex).szEntryname(), vbUnicode)
            sDunList(lngIndex) = Left$(strConName, InStr(strConName, vbNullChar) - 1)
        Next
    End If
    
End Sub
Public Function StartDUN(hWnd As Long, strDUN As String) As Long
Dim lngResult As Long
    
    If mlConnectionNumber <> 0 And fActiveConnection() Then
        '
        ' Already issued a connection
        '
        StartDUN = -1
    Else
        lngResult = InternetDial(hWnd, strDUN, INTERNET_AUTODIAL_FORCE_UNATTENDED, mlConnectionNumber, 0&;)
        
        If lngResult = ERROR_SUCCESS Then
            RaiseEvent ConnectionMade
        Else
            mlConnectionNumber = 0
        End If
        
        StartDUN = lngResult
        
    End If
End Function

Private Function fActiveConnection() As Boolean
Dim lngKey As Long
Dim lngData As Long
Dim lngSizeData As Long
   
Const sSubKey = "System\CurrentControlSet\Services\RemoteAccess"
Const sKeyValue = "Remote Connection"
    '
    ' Check registry for an active connection.
    '
    fActiveConnection = False
    
    If RegOpenKey(HKEY_LOCAL_MACHINE, sSubKey, lngKey) = ERROR_SUCCESS Then
        lngData = 0&
        lngSizeData = Len(lngData)
        
        If RegQueryValueEx(lngKey, sKeyValue, 0&, 0&, lngData, lngSizeData) = ERROR_SUCCESS Then
            fActiveConnection = lngData <> 0
        End If
        
        Call RegCloseKey(lngKey)
    End If
End Function

'=================================================

И всё :)



Ответить

Номер ответа: 7
Автор ответа:
 HACKER


 

Разработчик Offline Client

Вопросов: 236
Ответов: 8362
  Профиль | | #7 Добавлено: 18.10.04 23:22
Ухты... DaSharm я и незнал, а прикольно прикольно... спасиба!

Ответить

Номер ответа: 8
Автор ответа:
 sne



Разработчик Offline Client

ICQ: 233286456 

Вопросов: 34
Ответов: 5445
  Web-сайт: hw.t-k.ru
 Профиль | | #8 		Добавлено: 19.10.04 12:34
2HACKER, не обольщайся, эти ехе есть только в NT системах :(

Ответить

Номер ответа: 9
Автор ответа:
 someone



Вопросов: 215
Ответов: 1596
  Web-сайт: 123
 Профиль | | #9 		Добавлено: 19.10.04 13:57
2Alexandrus:
делает правильно ! И нечего пенять ...

Ничего подобного. Почитай название кода.
2Hacker спасибо!!!

Ответить

Номер ответа: 10
Автор ответа:
 HACKER


 

Разработчик Offline Client

Вопросов: 236
Ответов: 8362
  Профиль | | #10 Добавлено: 19.10.04 16:17
sne Ну в принципе да, хотя уверен что пройдёт ещё год и хр будет на 50% машин в мире, и ещё 49 на лонгхорне, а остальные 1% там на всёких разных...

Ответить

Номер ответа: 11
Автор ответа:
 someone



Вопросов: 215
Ответов: 1596
  Web-сайт: 123
 Профиль | | #11 		Добавлено: 19.10.04 20:48
2Hacker ты не прав, я считаю надобно процентов 5 уделить 98 винде. я например привык к 98 и нафиг мне не надо "длинный рог" и хр

Ответить

Номер ответа: 12
Автор ответа:
 mc-black



ICQ: 308-534-060 

Вопросов: 20
Ответов: 1860
  Web-сайт: mc-black.narod.ru/dzp.htm
 Профиль | | #12 		Добавлено: 19.10.04 21:55
HACKER, если я не куплю новый комп, я буду одним процентом(Win98SE) :)... И зря ты так, 2k нормальная тож..

Ответить

Номер ответа: 13
Автор ответа:
 someone



Вопросов: 215
Ответов: 1596
  Web-сайт: 123
 Профиль | | #13 		Добавлено: 19.10.04 21:59
а правильно mc-black говорит! мне уже просто привычнее в 98.

Ответить

Номер ответа: 14
Автор ответа:
 HACKER


 

Разработчик Offline Client

Вопросов: 236
Ответов: 8362
  Профиль | | #14 Добавлено: 20.10.04 21:45
Ну пока у меня был пень 600, и 64 озу, как то хр тоже нехотелось ставить, отмазывался прям как вы, типа нафиг оно мне, что я несмогу сделать в 98 что делаю в хр, к 98 привык итп... Потом купил комп новый, жизь заставила, и мне продавец в магазине сказал такую умную вещь (хотя я не считаю продавцов особо умными людми) но всёже, "под новый комп старая ос негодится" соответственно "под старый, новая" поэтому вас можно понять. Но уверен каждый хочет сменить комп на лучше, и вскоре рано или поздно это сделает! И уверен на все 98% что при покупке нового компа на старой винде просидит недолго, в итоги всёравно перейдёт хотябы на хр !

Ответить

Номер ответа: 15
Автор ответа:
 DaSharm



ICQ: 780477 

Вопросов: 72
Ответов: 1297
  Web-сайт: dasharm.com
 Профиль | | #15 		Добавлено: 20.10.04 23:33
Тема это ХР и 98. Лучше я пока не нашел. Эти 2 ОС на компе, визуал студио и фотошоп - все что нужно для разработчика софта!

Ответить

Страница: 1 | 2 |

Поиск по форуму



© Copyright 2002-2011 VBNet.RU | Пишите нам