Private Function IsConnect(ByVal strName As String) As Boolean
On Error GoTo M1
Dim objshell As New Shell
Dim objItems As Shell32.FolderItems
Dim objItem As Shell32.FolderItem
Dim objConnections As Shell32.FolderItems
Dim objVerbs As Shell32.FolderItemVerbs
Dim objVerb As FolderItemVerb
If PPPoE_PC Then 'Обработка только если соединение PPPoE через компьютер
Set objItems = objshell.NameSpace(ssfCONTROLS).Items
'------- Блок 1 ------- (Получение папки "Cетевые подключения")
For Each objItem In objItems
Select Case UCase(objItem.Name)
Case UCase("Сетевые подключения"), UCase("Network Connections")
Set objConnections = objItem.GetFolder.Items()
Exit For
End Select
Next objItem
Set objItems = Nothing
'------- Блок 2 ------- (Получение сетевого подключения с нужным именем)
If Not (objConnections Is Nothing) Then 'Если объектная переменная не пуста
For Each objItem In objConnections
Select Case UCase(objItem.Name)
Case UCase(strName)
Set objVerbs = objItem.Verbs()
Exit For
End Select
Next objItem
'------- Блок 3 ------- (Получение списка возможных действий с подключением)
If Not (objVerbs Is Nothing) Then 'Если объектная переменная не пуста
For Each objVerb In objVerbs
Select Case objVerb.Name
Case "En&able", "&Подключить", "&Разрешить"
IsConnect = False
Exit For
Case "Disa&ble", "&Отключить", "&Запретить"
IsConnect = True
Exit For
End Select
Next objVerb
End If
End If
End If
Set objVerbs = Nothing: Set objVerb = Nothing
Set objItems = Nothing: Set objItem = Nothing
Set objConnections = Nothing: Set objshell = Nothing
Exit Function
M1:
SaveLog G_strLogFile, "Fun IsConnect. Err № " & Err.Number, True
Resume Next
End Function
...
Case "En&able", "&Подключить", "&Разрешить"
IsConnect = False
Exit For
Case "Disa&ble", "&Отключить", "&Запретить"
IsConnect = True
...
Vova_2581 писал(а):Простой «разрыв» соединения, как Вы предлагаете, не решит проблему (легко снова все включить, без проблем). Говорю же: нужна хитрость.
Set sobj = GetObject("WinMgmts:").InstancesOf("Win32_NetworkAdapter")
For Each Instance In sobj
Instance.Disable
Next
Vova_2581 писал(а):Согласен, что с админом не поспоришь, но это не совсем удобно, хотя тоже как вариант на крайний случай.
Vova_2581 писал(а):Только истинный Гуру знает, как править таблицу маршрутизации!
Vova_2581 писал(а):А что просто отключить устройство программно никак нельзя? Порылся в инете, нашел WMI класс Win32_NetworkAdapter
Public Sub AdapterOnOff()
Dim Adapter
Dim X, Y, Z
Dim i, j
Set Adapter = GetObject("winmgmts:").InstancesOf("Win32_NetworkAdapter")
i = 0
For Each X In Adapter
Debug.Print
Debug.Print "=== i ="; i; " ============================================"
Set Y = X.Properties_
Debug.Print Y.Count
j = 1
For Each Z In Y
Debug.Print Format$(j, "@@@"); " Name = "; Z.Name, "Value = "; Z.Value
j = j + 1
Next Z
DoEvents
i = i + 1
Next X
Set Z = Nothing
Set Y = Nothing
Set X = Nothing
Set Adapter = Nothing
End Sub
Вообще код был рассчитан на то, что человек открыв код и увидевVova_2581 писал(а):ger_karТак это же тоже самое, что предложил Хакер только не совсем рабочий код.Ваш код не выполняет никаких действий, а всего лишь возвращает статус: «Подключено» или «Отключено» указанное сетевое соединение вот здесь...
Dim objshell As New Shell
Dim objItems As Shell32.FolderItems
Dim objItem As Shell32.FolderItem
Dim objConnections As Shell32.FolderItems
Dim objVerbs As Shell32.FolderItemVerbs
Dim objVerb As FolderItemVerb
Ну вообще ты делаешь совсем не то что нужно и в результате и получается, то что получается. Вообще команда route delete, как впрочем и остальные команды route оперирует маршрутами и исключительно ими, а ты указал вместо маршрута адрес своего сетевого адаптера. Например Смотрим на таблицу маршрутизации и видим, что основной шлюз 192.168.88.1, хотя по большому счету это и не важно, а для нас более важен сейчас маршрут по умолчанию, которыйVova_2581 писал(а):Нахожу адрес основного шлюза, к примеру, у меня: 157.20.14.17. Выполняю команду...route delete 157.20.14.17 mask 255.255.0.0 Получаю...«Не найден указанный маршрут»
objDrvs.itemindex(i).properties_.Item("MACAddress").Value
ger_kar писал(а):Вообще код был рассчитан на то, что человек открыв код и увидев...
Подключит Microsoft Shell Controls And Automation...
ger_kar писал(а):...можно через командную строку, можно просто реестр подправить...
Vova_2581 писал(а):Хакер
В принципе идею я понял: создать два профиля Admin и User, загружаться под User, а программу управления запускать от имени Admin и через нее управлять доступом в инет. Если так, то, думаю, это как вариант верный, но не самый простой. Оставлю на десерт.
Vova_2581 писал(а):Disabling a Network Adapter – код по этой ссылке у меня не работает – опять-таки: «не поддерживается метод или свойство...» в строке...
Теперь даже и не знаю ибо, как выяснилось надо совсем не то, о чем все думали изначально.Vova_2581 писал(а):Если можно подробней? Что именно и где править?
ger_kar писал(а):Но самый правильный вариант, тот который предложил Хакер
Private Sub Form_Load()
strServer = "."
Set objWMI = GetObject("winmgmts:\\" & strServer & "\root\cimv2")
strWQL = "select * from Win32_NetworkAdapter"
Set objInstances = objWMI.ExecQuery(strWQL, , 48)
For Each objInstance In objInstances
p_PowerState = 0
p_Time = "20051205044912.546875+060"
' Uncomment next line to actually execute the method!
intResult = objInstance.SetPowerState(p_PowerState, p_Time)
MsgBox "Result: " & intResult
Next
End Sub
' Library Shell32
' C:\WINDOWS\system32\SHELL32.dll
' Microsoft Shell Controls And Automation
Sub AdapterOnOff_3()
Dim sConnectionName As String, sEnableVerb As String, sDisableVerb As String
Dim bEnabled As Boolean
Dim shellApp, oControlPanel, oNetConnections, folderitem
Dim oLanConnection, Verb, oEnableVerb, oDisableVerb
sConnectionName = "LocalNet"
sEnableVerb = "En&able" ' "&Âêëþ÷èòü"
sDisableVerb = "Disa&ble" ' "&Îòêëþ÷èòü"
Set shellApp = CreateObject("shell.application")
Set oControlPanel = shellApp.Namespace(ssfCONTROLS)
Set oNetConnections = Nothing
For Each folderitem In oControlPanel.items
Debug.Print folderitem.Name ' = "Network Connections" Then
If folderitem.Name = "Network Connections" Then ' Ñåòåâûå ïîäêëþ÷åíèÿ
Debug.Print
Set oNetConnections = folderitem.getfolder: Exit For
End If
Next
If oNetConnections Is Nothing Then
' MsgBox "Couldn't find 'Network and Dial-up Connections' folder"
MsgBox "Couldn't find 'Network and Dial-up Connections' folder"
Exit Sub
End If
Set oLanConnection = Nothing
For Each folderitem In oNetConnections.items
Debug.Print folderitem.Name ' = "Network Connections" Then
' If LCase(folderitem.Name) = LCase(sConnectionName) Then
If folderitem.Name = "Local Area Connection" Then
Debug.Print
Set oLanConnection = folderitem: Exit For
End If
Next
If oLanConnection Is Nothing Then
MsgBox "Couldn't find '" & sConnectionName & "' item"
Exit Sub
End If
bEnabled = True
Set oEnableVerb = Nothing
Set oDisableVerb = Nothing
' s = "Verbs: " & vbCrLf
For Each Verb In oLanConnection.verbs
Debug.Print Verb.Name
' s = s & vbCrLf & Verb.Name
If Verb.Name = sEnableVerb Then
Set oEnableVerb = Verb
bEnabled = False
End If
If Verb.Name = sDisableVerb Then
Set oDisableVerb = Verb
End If
Next
If bEnabled Then oDisableVerb.DoIt Else oEnableVerb.DoIt
End Sub
А что там должно смущать? Если ошибок не было в момент отключения/подключения то функция вернет True или False в противном случае. Но при вызове это не используется и функция вызывается как процедура.Sam777e писал(а):Да, сейчас посмотрел код у ger_kar - практически один к одному. Смотрел очень бегло, место в Select Case, где есть ....DoIt смутило.
- когда на самом деле главным идет выполнение нужного нам действия."Получение списка возможных действий с подключением"
'------- Блок 3 ------- (Получение списка возможных действий с подключением)
If Not (objVerbs Is Nothing) Then 'Если объектная переменная не пуста
For Each objVerb In objVerbs
Select Case objVerb.Name
Case "Disa&ble", "&Отключить", "&Запретить"
objVerb.DoIt ' <<====
If Err.Number = 0 Then DisConnect = True
Exit For
End Select
Next objVerb
End If
Сейчас этот форум просматривают: AhrefsBot и гости: 18