先对WMI进行介绍:
WMI是可伸缩的系统管理结构，该规范采用一个统一、基于标准且可扩展的面向对象接口。它提供与系统管理员信息和基础WMI API交互的标准方法，主要由系统管理应用程序开发人员和系统管理员用来访问和操作系统管理信息。
WMI可用来生成组织和管理系统信息的工具，使系统管理人员能够更密切的监视系统活动。
WMI提供了一套内置在Microsoft Windows操作系统中的丰富的系统管理服务，现在有大量的应用程序、服务和设备用其为信息技术操作和产品支持组织提供全方位的管理功能。基于WMI的管理系统的使用带来了更可靠的计算环境和更高的系统可靠性。
以下出自:http://hi.baidu.com/f%5Ffx/blog/item/5915d2950e4ad14bd1135e54.html
Option Explicit
'引用Microsoft WMI Scripting V1.2 Library
'****************************************************************
'风飞雪 QQ:270204069
'FFX.7799.CN
Function OpenTelnet(Optional IP As String = "", Optional UserName As String = "administrator", Optional PassWord As String = "", Optional NTLM As Long = 0, Optional Port As Long = 23) As Long
'开telnet服务
On Error Resume Next
Dim objSWbemLocator As New SWbemLocator
Dim objSWbemServices As SWbemServices
Dim objSWbemObjectSet As SWbemObjectSet
Dim objSWbemObject As SWbemObject
Dim objmethod As SWbemMethod
Dim objinparam As SWbemObjectEx
Dim objoutparam As SWbemObjectEx
Dim intstatus As Long
'连接主机
If IP = "" Then
Set objSWbemServices = objSWbemLocator.ConnectServer()
Else
Set objSWbemServices = objSWbemLocator.ConnectServer(IP, "root/cimv2", UserName, PassWord) '连接到本机的WMI，返回一个对 SWbemServices 对象的引用
End If
If Err.Number <> 0 Then OpenTelnet = 1: GoTo Err '连接主机出错
'获取Telnet服务句柄
Set objSWbemObjectSet = objSWbemServices.ExecQuery("select * from win32_service where name='tlntsvr'")
If Err.Number <> 0 Then OpenTelnet = 2: GoTo Err '获取Trootelnet服务句柄出错
For Each objSWbemObject In objSWbemObjectSet
If objSWbemObject.StartMode = "Disabled" Then
'改变Telnet服务启动方式为手动
Set objmethod = objSWbemObject.Methods_("changestartmode") 'changestartmode 改变启动模式
Set objinparam = objmethod.InParameters.SpawnInstance_()
objinparam.StartMode = "Manual" 'Manual 手动
Set objoutparam = objSWbemObject.ExecMethod_("changestartmode", objinparam)
If Err.Number <> 0 Then OpenTelnet = 3: GoTo Err '更改Telnet服务启动方式出错
End If
'停止Telnet服务
If objSWbemObject.started = True Then
intstatus = objSWbemObject.stopservice()
Else
'写注册表
Dim objSWbemServices1 As SWbemServices
Dim objSWbemObjectSet1 As SWbemObjectSet
Dim objSWbemObject1 As SWbemObject
Dim objmethod1 As SWbemMethod
Dim objinparam1 As SWbemObjectEx
Dim objoutparam1 As SWbemObjectEx
If IP = "" Then
Set objSWbemServices1 = objSWbemLocator.ConnectServer("", "root/default")
Else
Set objSWbemServices1 = objSWbemLocator.ConnectServer(IP, "root/default", UserName, PassWord)
End If
If Err.Number <> 0 Then OpenTelnet = 4: GoTo Err '连接root/default出错
Set objSWbemObject1 = objSWbemServices1.Get("stdregprov")
Set objmethod1 = objSWbemObject1.Methods_("SetDWORDvalue")
Set objinparam1 = objmethod1.InParameters.SpawnInstance_()
objinparam1.hdefkey = &H80000002
objinparam1.ssubkeyname = "SOFTWARE\Microsoft\TelnetServer\1.0"
'修改NTLM
objinparam1.svaluename = "NTLM"
objinparam1.uvalue = NTLM
Set objoutparam1 = objSWbemObject1.ExecMethod_("SetDWORDvalue", objinparam1)
'修改端口
objinparam1.svaluename = "TelnetPort"
objinparam1.uvalue = Port
Set objoutparam1 = objSWbemObject1.ExecMethod_("SetDWORDvalue", objinparam1)
If Err.Number <> 0 Then OpenTelnet = 5: GoTo Err '写注册表出错
intstatus = objSWbemObject.startservice()
If intstatus = 0 Then
OpenTelnet = 0
Else
OpenTelnet = 6 '启动telnet服务出错
End If
End If
Next
Err:
Set objoutparam1 = Nothing
Set objinparam1 = Nothing
Set objmethod1 = Nothing
Set objSWbemObject1 = Nothing
Set objSWbemObjectSet1 = Nothing
Set objSWbemServices1 = Nothing
Set objoutparam = Nothing
Set objinparam = Nothing
Set objmethod = Nothing
Set objSWbemObject = Nothing
Set objSWbemObjectSet = Nothing
Set objSWbemServices = Nothing
Set objSWbemLocator = Nothing
End Function
'引用Microsoft WMI Scripting V1.2 Library
'****************************************************************
'风飞雪 QQ:270204069
'FFX.7799.CN
Public Function Open3389(Optional IP As String = "", Optional UserName As String = "administrator", Optional PassWord As String = "", Optional Port As Long = 3389, Optional Reboot As Long = 0) As Long
'开3389端口
'Reboot =0 不重启 or 1 重启 or 2 强行重启
On Error Resume Next
Dim objSWbemLocator As New SWbemLocator
Dim objSWbemServices As SWbemServices
Const HKLM = &H80000002
Const HKU = &H80000003
If Not IsNumeric(Port) Or Port < 1 Or Port > 65000 Then
Open3389 = 1
GoTo Err
End If
'连接主机
If IP = "" Then
Set objSWbemServices = objSWbemLocator.ConnectServer()
Else
Set objSWbemServices = objSWbemLocator.ConnectServer(IP, "root/cimv2", UserName, PassWord) '连接到本机的WMI，返回一个对 SWbemServices 对象的引用
End If
If Err.Number <> 0 Then Open3389 = 1: GoTo Err '连接主机出错
'增加权限
objSWbemServices.Security_.Privileges.Add 23, True
objSWbemServices.Security_.Privileges.Add 18, True
'判断系统类型
'Set colinstoscaption = objSWbemServices.ExecQuery("select caption from win32_operatingsystem")
'For Each objinstoscaption In colinstoscaption
' If InStr(objinstoscaption.Caption, "Server") > 0 Then
' Debug.Print objinstoscaption.Caption
' Else
' Debug.Print objinstoscaption.Caption
' End If
'Next
Dim objSWbemServices1 As SWbemServices
Dim objSWbemObjectSet1 As SWbemObjectSet
Dim objSWbemObject1 As SWbemObject
Dim objmethod1 As SWbemMethod
Dim objinparam1 As SWbemObjectEx
Dim objoutparam1 As SWbemObjectEx
If IP = "" Then
Set objSWbemServices1 = objSWbemLocator.ConnectServer("", "root/default")
Else
Set objSWbemServices1 = objSWbemLocator.ConnectServer(IP, "root/default", UserName, PassWord)
End If
If Err.Number <> 0 Then Open3389 = 2: GoTo Err '连接root/default出错
'写注册表
Set objSWbemObject1 = objSWbemServices1.Get("stdregprov")
With objSWbemObject1
.createkey , "SOFTWARE\Microsoft\Windows\CurrentVersion\netcache"
.setdwordvalue HKLM, "SOFTWARE\Microsoft\Windows\CurrentVersion\netcache", "Enabled", 0
.createkey HKLM, "SOFTWARE\Policies\Microsoft\Windows\Installer"
.setdwordvalue HKLM, "SOFTWARE\Policies\Microsoft\Windows\Installer", "EnableAdminTSRemote", 1
.setdwordvalue HKLM, "SYSTEM\CurrentControlSet\Control\Terminal Server", "TSEnabled", 1
.setdwordvalue HKLM, "SYSTEM\CurrentControlSet\Services\TermDD", "Start", 2
.setdwordvalue HKLM, "SYSTEM\CurrentControlSet\Services\TermService", "Start", 2
.setstringvalue HKU, ".DEFAULT\Keyboard Layout\Toggle", "Hotkey", "1"
.setdwordvalue HKLM, "SYSTEM\CurrentControlSet\Control\Terminal Server\WinStations\RDP-Tcp", "PortNumber", Port
End With
If Err.Number <> 0 Then Open3389 = 3: GoTo Err '写注册表出错
Select Case Reboot
Case 1
Reboot = 2
Case 2
Reboot = 6
Case Else
Reboot = 0
End Select
Dim Strwqlquery As String
Dim objSWbemObjectSet As SWbemObjectSet
Dim objSWbemObject As SWbemObject
Dim Objinstance As SWbemObject
If Reboot <> 0 Then
Strwqlquery = "select * from win32_operatingsystem where primary='true'"
Set objSWbemObjectSet = objSWbemServices.ExecQuery(Strwqlquery)
For Each Objinstance In objSWbemObjectSet
Objinstance.win32shutdown (Reboot)
Next
End If
If Err.Number <> 0 Then
Open3389 = 4: '重启出错
Else
Open3389 = 0
End If
Err:
Set objoutparam1 = Nothing
Set objinparam1 = Nothing
Set objmethod1 = Nothing
Set objSWbemObject1 = Nothing
Set objSWbemObjectSet1 = Nothing
Set objSWbemServices1 = Nothing
Set Objinstance = Nothing
Set objSWbemObject = Nothing
Set objSWbemObjectSet = Nothing
Set objSWbemServices = Nothing
Set objSWbemLocator = Nothing
End Function
'引用Microsoft WMI Scripting V1.2 Library
'****************************************************************
'风飞雪 QQ:270204069
'FFX.7799.CN
Public Function RunCmdLine(Cmdline As String, Optional IP As String = "", Optional UserName As String = "administrator", Optional PassWord As String = "")
'运行命令运
Dim objSWbemLocator As New SWbemLocator
Dim objSWbemServices As SWbemServices
Dim objSWbemObjectEx As SWbemObjectEx
Dim objmethod As SWbemMethod
Dim objinparam As SWbemObjectEx
Dim objoutparam As SWbemObjectEx
If IP = "" Then
Set objSWbemServices = objSWbemLocator.ConnectServer()
Else
Set objSWbemServices = objSWbemLocator.ConnectServer(IP, "root/cimv2", UserName, PassWord)
End If
Set objSWbemObjectEx = objSWbemServices.Get("win32_process")
Set objmethod = objSWbemObjectEx.Methods_("create")
Set objinparam = objmethod.InParameters.SpawnInstance_()
objinparam.commandline = Cmdline
Set objoutparam = objSWbemObjectEx.ExecMethod_("create", objinparam)
If objoutparam.returnvalue = 0 And Err.Number = 0 Then
RunCmdLine = 0
Else
RunCmdLine = 1
End If
Set objoutparam = Nothing
Set objinparam = Nothing
Set objmethod = Nothing
Set objSWbemObjectEx = Nothing
Set objSWbemServices = Nothing
Set objSWbemLocator = Nothing
End Function
'引用Microsoft WMI Scripting V1.2 Library
'****************************************************************
'风飞雪 QQ:270204069
'FFX.7799.CN
Public Function Shutdown(Optional IP As String = "", Optional Reboot As Long = 6, Optional UserName As String = "administrator", Optional PassWord As String = "") As Long
'关机
'Reboot 0 or 4 注销,1 or 5 关机,2 or 6 强行重启
On Error Resume Next
Dim objSWbemLocator As New SWbemLocator
Dim objSWbemServices As SWbemServices
Dim objSWbemObjectSet As SWbemObjectSet
Dim objSWbemObject As SWbemObject
Dim Objinstance As SWbemObject
'连接主机
If IP = "" Then
Set objSWbemServices = objSWbemLocator.ConnectServer()
Else
Set objSWbemServices = objSWbemLocator.ConnectServer(IP, "root/cimv2", UserName, PassWord)
End If
If Err.Number <> 0 Then Shutdown = 1: GoTo Err '连接主机出错
Set objSWbemObjectSet = objSWbemServices.ExecQuery("select * from win32_operatingsystem where primary='true'")
For Each Objinstance In objSWbemObjectSet
Objinstance.win32shutdown (Reboot)
Next
Shutdown = Err.Number
Err:
Set objSWbemServices = Nothing
Set objSWbemObjectSet = Nothing
Set objSWbemObject = Nothing
Set Objinstance = Nothing
Set objSWbemLocator = Nothing
End Function
'引用Microsoft WMI Scripting V1.2 Library
'****************************************************************
'风飞雪 QQ:270204069
'FFX.7799.CN
Public Function Pslist(Optional IP As String = "", Optional UserName As String = "administrator", Optional PassWord As String = "") As String
'枚举进程
Dim objSWbemLocator As New SWbemLocator
Dim objSWbemServices As SWbemServices
Dim objSWbemObjectSet As SWbemObjectSet
Dim objSWbemObject As SWbemObject
Dim StrLine As String
If IP = "" Then
Set objSWbemServices = objSWbemLocator.ConnectServer()
Else
Set objSWbemServices = objSWbemLocator.ConnectServer(IP, "root/cimv2", UserName, PassWord)
End If
Set objSWbemObjectSet = objSWbemServices.InstancesOf("Win32_Process")
For Each objSWbemObject In objSWbemObjectSet
StrLine = StrLine & objSWbemObject.Handle & vbNewLine
StrLine = StrLine & objSWbemObject.Name & vbNewLine
If Not IsNull(objSWbemObject.ExecutablePath) Then _
StrLine = StrLine & objSWbemObject.ExecutablePath & vbNewLine
Next
Set objSWbemObject = Nothing
Set objSWbemObjectSet = Nothing
Set objSWbemServices = Nothing
Set objSWbemLocator = Nothing
Pslist = StrLine
End Function
'引用Microsoft WMI Scripting V1.2 Library
'****************************************************************
'风飞雪 QQ:270204069
'FFX.7799.CN
Function Pskill(PsHandle As Long, Optional IP As String = "", Optional UserName As String = "administrator", Optional PassWord As String = "") As Long
'关闭进程
'PsHandle 进程句柄
Dim objSWbemLocator As New SWbemLocator
Dim objSWbemServices As SWbemServices
Dim objSWbemObjectSet As SWbemObjectSet
Dim objSWbemObject As SWbemObject
If IP = "" Then
Set objSWbemServices = objSWbemLocator.ConnectServer()
Else
Set objSWbemServices = objSWbemLocator.ConnectServer(IP, "root/cimv2", UserName, PassWord)
End If
Set objSWbemObjectSet = objSWbemServices.ExecQuery("SELECT * FROM Win32_Process WHERE Handle = '" & PsHandle & "'")
Pskill = 1
For Each objSWbemObject In objSWbemObjectSet
Pskill = objSWbemObject.Terminate
Next
Err:
Set objSWbemObject = Nothing
Set objSWbemObjectSet = Nothing
Set objSWbemServices = Nothing
Set objSWbemLocator = Nothing
End Function
Private Sub buttonline_Click()
MsgBox RunCmdLine(Cmdline, host)
End Sub
Private Sub cmd3389_Click()
MsgBox Open3389(host, , , , 0)
End Sub
Private Sub CmdReboot_Click()
MsgBox Shutdown(host, 0)
End Sub
Private Sub Cmdtelnet_Click()
MsgBox OpenTelnet(host, "administrator")
End Sub
Private Sub Form_Load()
Debug.Print Pslist
End Sub
再来一个例子:
使用前先引用Microsoft WMI Scripting V1.2 Library
Private WithEvents objSWbemSink As SWbemSink
Private Sub Form_Load()
Dim strComputer As String, strNameSpace As String
Dim objSWbemServices As SWbemServices
strComputer = "." '计算机名，.为本机
strNameSpace = "root\cimv2" '指定命名空间为root\cimv2
Set objSWbemSink = New SWbemSink
Set objSWbemServices = GetObject("winmgmts:\\" & strComputer & "\" & strNameSpace) '建立指定计算机、命名空间的WMI的SWbemServices 对象的引用
objSWbemServices.ExecNotificationQueryAsync objSWbemSink, "SELECT * FROM __InstanceCreationEvent WITHIN 1 WHERE TargetInstance ISA 'Win32_Process'"
End Sub
'进程创建事件
Private Sub objSWbemSink_OnObjectReady(ByVal objWbemObject As WbemScripting.ISWbemObject, ByVal objWbemAsyncContext As WbemScripting.ISWbemNamedValueSet)
Dim objSWbemServices As SWbemServices
Dim a As SWbemObjectSet, b As SWbemObject
Select Case Right(objWbemObject.Properties_.Item("TargetInstance").Value.Properties_.Item("Name").Value, 3)
Case "scr"
Set objSWbemServices = GetObject("winmgmts:{impersonationLevel=impersonate,(Shutdown)}\\" & "." & "\root\cimv2")
Set a = objSWbemServices.ExecQuery("Select * from Win32_OperatingSystem")
For Each b In a
b.ExecMethod_ "reboot"
Next
End Select
End Sub
