单纯的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 GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long | | Const GW_HWNDNEXT = 2COPY |
| | | | | | | 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", "") | | | | | | | | | | DoEvents | | End If | | Next | | Set objWMILocal = Nothing | | Set objWMIObject = Nothing | | Set objWMIObjects = Nothing | | | | | | Exit Sub | | | | | | ErrorHandler: | | | | End Sub | | | | | | 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 | | | | | | test_hwnd = FindWindow(vbNullString, vbNullString) | | | | | | Do While test_hwnd <> 0 | | | | If GetParent(test_hwnd) = 0 Then | | | | | | 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 FunctionCOPY |
|