回 帖 发 新 帖 刷新版面

主题:[讨论]愁死我了..没牛人解答么?

VB启动或停止一个驱动的语句.....比如我想做个从驱动断网的程序.....按F8....就停用MS TCP Loopback interface和物理网卡的驱动.再按下F8..就都又启动了....就是这样!希望牛人给出详细代码...额感谢哦!
[em10][em10]

回复列表 (共3个回复)

沙发

Option Explicit

Private Const NetConnect = &H31

Private Sub Command1_Click() '停用本地连接
    Dim blnRelust As Boolean
    '把 本地连接换成你要控制的本地连接的名字
    blnRelust = ExcNetLinkMenu("本地连接", "停用(&B)")
    'xp
    If blnRelust Then
        Debug.Print "停用成功"
    Else
       blnRelust = ExcNetLinkMenu("本地连接", "禁用(&B)")
    End If
    If blnRelust Then
       Debug.Print "停用成功"
    Else
      Debug.Print "停用失败"
    End If
End Sub

Private Sub command2_Click() '启用本地连接
'把 本地连接换成你要控制的本地连接的名字
    Dim blnRelust As Boolean
    blnRelust = ExcNetLinkMenu("本地连接", "启用(&A)")
    If blnRelust Then
        Debug.Print "启用成功"
    Else
        Debug.Print "启用失败"
    End If
End Sub

'首先引用Microsoft Shell Controls And Automation
'先找到“网络连接”这个虚拟文件夹,然后找到要控制的本地连接对应的folderitem,然后枚举verb,找到需要的verb后,调用verb的DoIt方法

Private Function ExcNetLinkMenu(ByVal AdapterName As String, ByVal MenuName As String) As Boolean
    Dim objShell As New Shell32.Shell
    Dim objFolder As Shell32.Folder
    Dim objFolderItem As Shell32.FolderItem
    Dim objShellFolderItem As ShellFolderItem
    Dim objFolderItemVerb As Shell32.FolderItemVerb
    Dim blnRelust As Boolean
    On Error Resume Next
    Set objFolder = objShell.NameSpace(NetConnect)
    If ObjPtr(objFolder) = 0 Then
        ExcNetLinkMenu = False
        GoTo Exitfunction
    End If
    For Each objFolderItem In objFolder.Items '遍历网络连接文件夹集合
        If objFolderItem.Name = AdapterName Then
            Set objShellFolderItem = objFolderItem
            blnRelust = True
            Exit For
        End If
    Next
    If blnRelust = False Then
        ExcNetLinkMenu = False
        GoTo Exitfunction
    End If
    For Each objFolderItemVerb In objShellFolderItem.Verbs '遍历本地连接的右键菜单
        If objFolderItemVerb.Name = MenuName Then
            objFolderItemVerb.DoIt
            ExcNetLinkMenu = True
            Exit For
        End If
    Next
    If blnRelust = False Then ExcNetLinkMenu = False
Exitfunction:
    Set objShell = Nothing
    Set objFolder = Nothing
    Set objFolderItem = Nothing
    Set objShellFolderItem = Nothing
    Set objFolderItemVerb = Nothing
End Function

板凳

你很厉害......

3 楼

厉害厉害...

我来回复

您尚未登录,请登录后再回复。点此登录或注册