单纯的VBS不能实现,调用dll/vba支持API才行。
如果是VB/VBA的话,提供一个简单的实例:- Public Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
- Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
- Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
- Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long
- Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
-
- Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
- Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
- 'Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As Long, ByVal lpWindowName As Long) As Long
- Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
- Const GW_HWNDNEXT = 2
复制代码
- '***********************************************************************************************
- ' 檢測及關閉所有Excel進程
- '***********************************************************************************************
- Public Sub chkVM(pVal As Integer)
- On Error GoTo ErrorHandler
-
- Dim nPID As Long
-
- Dim lngHwnd As Long
- Dim strHwnd As String
-
- Dim strCurrXls As String
-
- Dim sBuffer As String
- Dim lBufSize As Long
-
- Dim objWMILocal As SWbemServices
- Dim objWMIObject As SWbemObject
- Dim objWMIObjects As SWbemObjectSet
-
- Set objWMILocal = GetObject("winmgmts:{ImpersonationLevel=impersonate,AuthenticationLevel=pkt,(Shutdown)}!\\.\root\cimv2")
- Set objWMIObjects = objWMILocal.ExecQuery("select * from win32_process", , 48)
- For Each objWMIObject In objWMIObjects
-
- If objWMIObject.Description = "VirtualBox.exe" And objWMIObject.CommandLine Like "*--comment*" Then
-
- lngHwnd = InstanceToWnd(objWMIObject.ProcessId)
-
- ShowWindow lngHwnd, pVal
-
- lBufSize = 255
- sBuffer = String$(lBufSize, " ")
- GetWindowText lngHwnd, sBuffer, lBufSize
- sBuffer = Replace(Trim(sBuffer), Chr(0), "")
-
- SetWindowText lngHwnd, Replace(sBuffer, "- Oracle VM VirtualBox", "")
-
- 'nPID = OpenProcess(IIf(InStr(Environ("OS"), "NT") <> 0, 2035711, 1048576), 0, objWMIObject.ProcessId)
- 'Call TerminateProcess(nPID, 0)
-
- DoEvents
- End If
- Next
- Set objWMILocal = Nothing
- Set objWMIObject = Nothing
- Set objWMIObjects = Nothing
-
- '***********
- Exit Sub
- '***********
-
- ErrorHandler:
-
- End Sub
-
- ' 通過進程ID獲得該進程的視窗控制碼
- Public Function InstanceToWnd(ByVal target_pid As Long) As Long
- Dim test_hwnd As Long
- Dim test_pid As Long
- Dim test_thread_id As Long
-
- Dim sBuffer As String
- Dim lBufSize As Long
-
- InstanceToWnd = 0
- On Error Resume Next
-
- ' 獲得首個handle.
- test_hwnd = FindWindow(vbNullString, vbNullString)
-
- ' 迴圈查找直到找到為給定進程ID的視窗控制碼
- Do While test_hwnd <> 0
- '檢查視窗控制碼是否為頂級視窗
- If GetParent(test_hwnd) = 0 Then
- ' 是頂級窗口
- ' 取該視窗所屬的進程ID
- test_thread_id = GetWindowThreadProcessId(test_hwnd, test_pid)
-
- If test_pid = target_pid Then
- ' 是我們指定進程的視窗,則將該視窗的控制碼返回到函數名,並退出
-
- lBufSize = 255
- sBuffer = String$(lBufSize, " ")
- GetWindowText test_hwnd, sBuffer, lBufSize
- sBuffer = Replace(Trim(sBuffer), Chr(0), "")
- If sBuffer <> "VBoxSharedClipboardClass" And sBuffer <> "VirtualBox" And sBuffer <> "" Then
- InstanceToWnd = test_hwnd
- Exit Do
- End If
- End If
- End If
-
- ' 取下一個視窗的控制碼
- test_hwnd = GetWindow(test_hwnd, GW_HWNDNEXT)
- DoEvents
- Loop
- End Function
复制代码
|