How to auto close VBScript thousands of MsgBox's - windows

I have a rogue vbscript that went a little crazy tracing output and now I have thousands of message boxes to close. I can hold down the Enter key and close lots of them but that still takes several minutes. I could reboot but then I have to open all my apps again. Is there a quick way to auto close all the message boxes. I tried looking in task manager but it appears that the process that spawned the boxes has long sinced finished. Any ideas?

Not sure how you can have orphaned msgbox windows, you should still have cscript.exe or wscript.exe in your running processes list. The following should terminate the underlying process and close your msgboxes:
strComputer = "."
strProcessToKill = "wscript.exe"
SET objWMIService = GETOBJECT("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" _
& strComputer & "\root\cimv2")
SET colProcess = objWMIService.ExecQuery _
("Select * from Win32_Process Where Name = '" & strProcessToKill & "'")
FOR EACH objProcess in colProcess
objProcess.Terminate()
NEXT
Obviously, change wscript.exe. to cscript.exe if that's what you're using.

Always start your vbscript with cscript.exe instead of wscript.exe. cscript outputs to the console, not the GUI. Alternatively, you could use an application such as Push The Freakin' Button to automate the button clicks.
If you're using explicit MsgBox calls, then using cscript won't help you. To use cscript as a solution, you would need to change MsgBox to Wscript.Echo calls.

This wont help your immediate problem, but you may want to change your default script host to Cscript, which will prevent this problem in the future. See: this technet article.

Public Class Form1
Private m_Title As String
'Windows API
Private Declare Function PostMessage Lib "user32" _
Alias "PostMessageA" (ByVal hWnd As Int32, _
ByVal wMsg As Int32, _
ByVal wParam As Int32, _
ByVal lParam As Int32) As Int32
Declare Function SendMessage Lib "USER32" _
Alias "SendMessageA" (ByVal hWnd As Int32, _
ByVal Msg As Int32, _
ByVal wParam As Int32, _
ByVal lParam As Int32) As Int32
Private Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As Int32
Private Const WM_CLOSE As Int32 = &H10
Private Sub Button1_Click(ByVal sender As System.Object, _
ByVal e As System.EventArgs) _
Handles Button1.Click
m_Title = "Auto Close Msg"
Me.Timer1.Interval = 2000 'timer1 placed on form
Me.Timer1.Start()
MsgBox("Auto close in 2 seconds", MsgBoxStyle.OkOnly, m_Title)
End Sub
Private Sub CloseMSGBOX()
'Use Windows API to find and close the message box
'
'http://msdn.microsoft.com/en-us/library/…
'#32770 The class for a dialog box.
'http://msdn.microsoft.com/en-us/library/…
'
'http://msdn.microsoft.com/en-us/library/…
'
Dim hWnd, retval As Int32
Dim WinTitle As String
WinTitle = m_Title '<- Title of Window
hWnd = FindWindow("#32770", WinTitle) 'Get the msgBox handle
retval = PostMessage(hWnd, WM_CLOSE, 0, 0) ' Close the msgBox
End Sub
Private Sub Timer1_Tick(ByVal sender As System.Object, _
ByVal e As System.EventArgs) _
Handles Timer1.Tick
CloseMSGBOX()
End Sub
End Class
I found this code here

To close all the windows and stop all processes in one go, why not just open a command prompt window and type:
TASKKILL /F /IM cmd.exe /T
or
TASKKILL /F /IM wscript.exe /T
This will immediately terminate all cmd.exe or wscript.exe processes... If it has to be within a script, you can call it like WshShell.Run "TASKKILL /F /IM cmd.exe /T"
This is much more simpler and efficient...

Related

Issue creating new process cmd.exe, opens and then closes immediately VB6/Windows 10

When i run the following code to create a cmd.exe process in windows 10, the console application opens and then closes immediately. In windows 7 this is working fine.
If i run calc.exe, this process does not closes immediately, this just happens with cmd.exe.
Const NORMAL_PRIORITY_CLASS = &H20&
Dim lSuccess As Long
Dim sApplicationName As String
Dim sCommandLine As String
Dim wCurrentDirectory As String
Dim pInfo As PROCESS_INFORMATION
Dim sInfo As STARTUPINFO
sApplicationName = "C:\Windows\system32\cmd.exe"
sCommandLine = ""
wCurrentDirectory = "C:\Windows\system32"
lSuccess = CreateProcess(sApplicationName, _
sCommandLine, _
ByVal 0&, _
ByVal 0&, _
0&, _
NORMAL_PRIORITY_CLASS, _
ByVal 0&, _
wCurrentDirectory, _
sInfo, _
pInfo)
EDIT:
After some debug i have found the problem, when its invoked SetParent function (after Create Process) the cmd.exe closes, but not calc.exe.
This SetParent function is declared in this way
Public Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
hWndChild is the window handle ID of cmd.exe or calc.exe, and hWndNewParent is the window handle ID of the parent in this case the application that (indirectly) runs this code.

Is there a way to count all open windows with VBScript?

I'm wondering if it is possible to count the amount of windows open at a given time with vbscript. I already am familiar with the shell.application object and can count Windows Explorer instances, but I would like to count every window, minimized or maximized, no matter what it is.
I have also thought about counting all running tasks, but I would need to somehow distinguish between background and foreground tasks for that to work.
function fnShellWindowsCountVB()
dim objShell
dim objShellWindows
set objShell = CreateObject("shell.application")
set objShellWindows = objshell.Windows
if (not objShellWindows is nothing) then
dim nCount
nCount = objShellWindows.Count
msgBox nCount
end if
set objShellWindows = nothing
set objShell = nothing
end function
fnShellWindowsCountVB()
'only counts explorer.exe windows
Any insight is appreciated.
No you can't with VBScript.
You have to make API calls to do anything with a window.
VB.Net can make API calls and is built into Windows like VBScript.
This is from https://winsourcecode.blogspot.com/2019/05/winlistexe-list-open-windows-and-their.html
It lists all open windows which you will have a few hundred of. Possibly you are only interested in top level windows.
EG Notepad is 5 windows. 1 x top level, 1 x Edit control window, 1 x statusbar window, and two standard windows that all program get automatically to handle entering Chinese text etc.
WinList.exe list the open windows and their child windows' Window Title, Window Class, and the EXE file
Note you must run as admin to access information about elevated windows.
REM WinList.bat
REM This file compiles WinList.vb to WinList.exe
REM WinList.exe list the open windows and their child windows' Window Title, Window Class, and the EXE file that created the window.
REM To use type WinList in a command prompt
C:\Windows\Microsoft.NET\Framework\v4.0.30319\vbc "%~dp0\WinList.vb" /out:"%~dp0\WinList.exe" /target:exe
Pause
---------------------------------------------------------------------------------
'WinList.vb
imports System.Runtime.InteropServices
Public Module WinList
Public Declare Function GetTopWindow Lib "user32" (ByVal hwnd As IntPtr) As IntPtr
Public Declare Function GetWindow Lib "user32" (ByVal hwnd As IntPtr, ByVal wCmd As Integer) As IntPtr
Public Declare UNICODE Function GetWindowModuleFileNameW Lib "user32" (ByVal hwnd As IntPtr, ByVal WinModule As String, StringLength As Integer) As Integer
Public Declare UNICODE Function GetWindowTextW Lib "user32" (ByVal hwnd As IntPtr, ByVal lpString As String, ByVal cch As Integer) As Integer
Public Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As IntPtr, ByRef lpdwProcessId As IntPtr) As IntPtr
Public Declare UNICODE Function GetClassNameW Lib "user32" (ByVal hwnd As IntPtr, ByVal lpClassName As String, ByVal nMaxCount As Integer) As Integer
Public Declare Function IsWindowUnicode Lib "user32" (ByVal hwnd As IntPtr) As Boolean
Public Const GW_CHILD = 5
Public Const GW_HWNDNEXT = 2
Public Sub Main ()
Dim WindowChain as Integer
WindowChain = 0
Dim hwnd As IntPtr
hwnd = GetTopWindow(0)
If hwnd <> 0 Then
AddChildWindows(hwnd, 0)
End If
End Sub
Private Sub AddChildWindows(ByVal hwndParent As IntPtr, ByVal Level As Integer)
Dim objWMIService As Object
Dim colItems As Object
Dim TempStr As String
Dim WT As String, CN As String, Length As Integer, hwnd As IntPtr, TID As IntPtr, PID As IntPtr, MN As String, Parenthwnd As IntPtr
Static Order As Integer
Static FirstTime As Integer
Parenthwnd = hwndParent
If Level = 0 Then
hwnd = hwndParent
Else
hwnd = GetWindow(hwndParent, GW_CHILD)
End If
Do While hwnd <> 0
WT = Space(512)
Length = GetWindowTextW(hwnd, WT, 508)
WT = Left$(WT, Length)
If WT = "" Then WT = Chr(171) & "No Window Text" & Chr(187)
CN = Space(512)
Length = GetClassNameW(hwnd, CN, 508)
CN = Left$(CN, Length)
If CN = "" Then CN = "Error=" & Err.LastDllError
MN = ""
TID = GetWindowThreadProcessId(hwnd, PID)
objWMIService = GetObject("winmgmts:\\.\root\cimv2")
colItems = objWMIService.ExecQuery("Select * From Win32_Process where ProcessID=" & CStr(PID))
For Each objItem in colItems
MN = objItem.name
Next
Dim Unicode as Boolean
Unicode = IsWindowUnicode(hwnd)
Order = Order + 1
If FirstTime = 0 Then
Console.writeline("Window Text " & "Class Name " & vbTab & "Unicode" & vbtab & "HWnd" & vbTab & "ParentHWnd" & vbTab & "ProcessID" & vbTab & "ThreadID" & vbTab & "Process Name" )
FirstTime = 1
End If
TempStr = vbCrLf & Space(Level * 3) & WT
If 30 - len(TempStr) > -1 then
TempStr = TempStr & space(30 - len(TempStr))
End If
TempStr = TempStr & " " & CN
If 55 - len(TempStr) > -1 then
TempStr = TempStr & space(55 - len(TempStr))
End If
Console.write(TempStr & vbtab & Unicode & vbTab & CStr(hwnd) & vbTab & CStr(Parenthwnd) & vbTab & CStr(PID) & vbTab & CStr(TID) & vbTab & MN )
AddChildWindows(hwnd, Level + 1)
hwnd = GetWindow(hwnd, GW_HWNDNEXT)
Loop
End Sub
End Module

Get output from command line in VB6

i am using this .Cls file and a command using 7zip to extract specific file from a zip.
my single file gets extracted how ever i need to add if statement to se if my file was found so that i can exit sub it can this piece of code be modifed to add own code
DOSOutputs.cls
Option Explicit
Private Declare Function PeekMessage Lib "user32" Alias "PeekMessageA" (lpMsg As MsgType, ByVal hWnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long, ByVal wRemoveMsg As Long) As Long
Private Declare Function TranslateMessage Lib "user32" (ByRef lpMsg As Any) As Long
Private Declare Function DispatchMessage Lib "user32" Alias "DispatchMessageW" (ByRef lpMsg As Any) As Long
Private Type POINTAPI
x As Long
Y As Long
End Type
Private Type MsgType
hWnd As Long
message As Long
wParam As Long
lParam As Long
Time As Long
pt As POINTAPI
End Type
Private Const PM_NOREMOVE As Long = 0&
Private Const PM_REMOVE As Long = 1&
'
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
'The CreatePipe function creates an anonymous pipe,
'and returns handles to the read and write ends of the pipe.
Private Declare Function CreatePipe Lib "kernel32" ( _
phReadPipe As Long, _
phWritePipe As Long, _
lpPipeAttributes As Any, _
ByVal nSize As Long) As Long
'Used to read the the pipe filled by the process create
'with the CretaProcessA function
Private Declare Function ReadFile Lib "kernel32" ( _
ByVal hFile As Long, _
ByVal lpBuffer As String, _
ByVal nNumberOfBytesToRead As Long, _
lpNumberOfBytesRead As Long, _
ByVal lpOverlapped As Any) As Long
'Structure used by the CreateProcessA function
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
'Structure used by the CreateProcessA function
Private Type STARTUPINFO
cb As Long
lpReserved As Long
lpDesktop As Long
lpTitle As Long
dwX As Long
dwY As Long
dwXSize As Long
dwYSize As Long
dwXCountChars As Long
dwYCountChars As Long
dwFillAttribute As Long
dwFlags As Long
wShowWindow As Integer
cbReserved2 As Integer
lpReserved2 As Long
hStdInput As Long
hStdOutput As Long
hStdError As Long
End Type
'Structure used by the CreateProcessA function
Private Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessID As Long
dwThreadID As Long
End Type
'This function launch the the commend and return the relative process
'into the PRECESS_INFORMATION structure
Private Declare Function CreateProcessA Lib "kernel32" ( _
ByVal lpApplicationName As Long, _
ByVal lpCommandLine As String, _
lpProcessAttributes As SECURITY_ATTRIBUTES, _
lpThreadAttributes As SECURITY_ATTRIBUTES, _
ByVal bInheritHandles As Long, _
ByVal dwCreationFlags As Long, _
ByVal lpEnvironment As Long, _
ByVal lpCurrentDirectory As Long, _
lpStartupInfo As STARTUPINFO, _
lpProcessInformation As PROCESS_INFORMATION) As Long
'Close opened handle
Private Declare Function CloseHandle Lib "kernel32" ( _
ByVal hHandle As Long) As Long
'Consts for the above functions
Private Const NORMAL_PRIORITY_CLASS = &H20&
Private Const STARTF_USESTDHANDLES = &H100&
Private Const STARTF_USESHOWWINDOW = &H1
Private mCommand As String 'Private variable for the CommandLine property
Private mOutputs As String 'Private variable for the ReadOnly Outputs property
'Event that notify the temporary buffer to the object
Public Event ReceiveOutputs(CommandOutputs As String)
'This property set and get the DOS command line
'It's possible to set this property directly from the
'parameter of the ExecuteCommand method
Public Property Let CommandLine(DOSCommand As String)
mCommand = DOSCommand
End Property
Public Property Get CommandLine() As String
CommandLine = mCommand
End Property
'This property ReadOnly get the complete output after
'a command execution
Public Property Get Outputs()
Outputs = mOutputs
End Property
Public Function ExecuteCommand(Optional CommandLine As String) As String
Dim proc As PROCESS_INFORMATION 'Process info filled by CreateProcessA
Dim ret As Long 'long variable for get the return value of the
'API functions
Dim start As STARTUPINFO 'StartUp Info passed to the CreateProceeeA
'function
Dim sa As SECURITY_ATTRIBUTES 'Security Attributes passeed to the
'CreateProcessA function
Dim hReadPipe As Long 'Read Pipe handle created by CreatePipe
Dim hWritePipe As Long 'Write Pite handle created by CreatePipe
Dim lngBytesread As Long 'Amount of byte read from the Read Pipe handle
Dim strBuff As String * 256 'String buffer reading the Pipe
'if the parameter is not empty update the CommandLine property
If Len(CommandLine) > 0 Then
mCommand = CommandLine
End If
'if the command line is empty then exit whit a error message
If Len(mCommand) = 0 Then
MsgBox "Command Line empty", vbCritical
Exit Function
End If
'Create the Pipe
sa.nLength = Len(sa)
sa.bInheritHandle = 1&
sa.lpSecurityDescriptor = 0&
ret = CreatePipe(hReadPipe, hWritePipe, sa, 0)
If ret = 0 Then
'If an error occur during the Pipe creation exit
MsgBox "CreatePipe failed. Error: " & Err.LastDllError, vbCritical
Exit Function
End If
'Launch the command line application
start.cb = Len(start)
start.dwFlags = STARTF_USESTDHANDLES Or STARTF_USESHOWWINDOW
'set the StdOutput and the StdError output to the same Write Pipe handle
start.hStdOutput = hWritePipe
start.hStdError = hWritePipe
'Execute the command
ret& = CreateProcessA(0&, mCommand, sa, sa, 1&, _
NORMAL_PRIORITY_CLASS, 0&, 0&, start, proc)
If ret <> 1 Then
'if the command is not found ....
MsgBox "File or command not found", vbCritical
Exit Function
End If
'Now We can ... must close the hWritePipe
ret = CloseHandle(hWritePipe)
mOutputs = ""
'Read the ReadPipe handle
Do
ret = ReadFile(hReadPipe, strBuff, 256, lngBytesread, 0&)
mOutputs = mOutputs & Left(strBuff, lngBytesread)
'Send data to the object via ReceiveOutputs event
RaiseEvent ReceiveOutputs(Left(strBuff, lngBytesread))
'Pause 0.02
FastDoEvents
Loop While ret <> 0
'Close the opened handles
ret = CloseHandle(proc.hProcess)
ret = CloseHandle(proc.hThread)
ret = CloseHandle(hReadPipe)
'Return the Outputs property with the entire DOS output
ExecuteCommand = mOutputs
End Function
Public Sub FastDoEvents()
Dim uMsg As MsgType
'
Do While PeekMessage(uMsg, 0&, 0&, 0&, PM_REMOVE) ' Reads and deletes message from queue.
TranslateMessage uMsg ' Translates virtual-key messages into character messages.
DispatchMessage uMsg ' Dispatches a message to a window procedure.
Loop
End Sub
form1
Private WithEvents objDOS As DOSOutputs
Private Sub Form_Load()
Set objDOS = New DOSOutputs
End Sub
button command
Private Sub Command22_Click()
On Error Resume Next
On Error GoTo errore
objDOS.CommandLine = text6.text
objDOS.ExecuteCommand
'If objDOS.Outputs = "41_gfx7.rom " Then
'Text1.Text = Text1.Text & objDOS.Outputs & vbNewLine
'End If
Exit Sub
errore:
MsgBox (Err.Description & " - " & Err.Source & " - " & CStr(Err.Number))
End Sub
text6.text has
"C:\Program Files (x86)\7-Zip\7z" x "C:\Users\sarah\Downloads\MAME\MAME_2010_full_nonmerged_romsets\roms\*.zip" -o"C:\Users\sarah\Desktop\rom test\New folder (2)\" *41_gfx7.rom -y
so now am trying to get the status from output using if statement to se if 41_gfx7.rom was found so that i can exit the scan or sub as there is no need to scan further.
or maybe if you can help add better one it will be great,once the string is found exit sub it
Private Sub Command1_Click()
Dim objShell As New WshShell
Dim objExecObject As WshExec
Dim strText As String
Set objExecObject = objShell.Exec(Text6.Text)
Do While Not objExecObject.StdOut.AtEndOfStream
strText = objExecObject.StdOut.ReadLine()
If InStr(strText, "Reply") > 0 Then
Debug.Print "Reply received: " & strText
Exit Do
End If
Loop
End Sub
text6 is my command
ok update
"C:\Program Files (x86)\7-Zip\7z" x "C:\Users\sarah\Downloads\MAME\MAME_2010_full_nonmerged_romsets\roms\*.zip" -o"C:\Users\sarah\Desktop\rom test\New folder (2)\" *41_gfx7.rom -y
i need to add list to this command according to https://sevenzip.osdn.jp/chm/cmdline/commands/list.htm so that file names gets displayed in output data
The following Microsoft article describes two methods that read the output of a command: WSH: Running Programs
The simplest uses the StdOut property of the WshExec object:
Set objShell = WScript.CreateObject("WScript.Shell")
Set objExecObject = objShell.Exec("cmd /c ping -n 3 -w 1000 157.59.0.1")
Do While Not objExecObject.StdOut.AtEndOfStream
strText = objExecObject.StdOut.ReadLine()
If Instr(strText, "Reply") > 0 Then
Wscript.Echo "Reply received."
Exit Do
End If
Loop
You can replace the ping command here with your 7z command and read StdOut to see what your command returned.
Since you are doing this in VB6, you can add a reference (Projects menu > References) to Windows Script Host Object Model library and instantiate the objects with the proper types directly:
Dim objShell As New WshShell
Dim objExecObject As WshExec
Dim strText As String
Set objExecObject = objShell.Exec("cmd /c ping -n 3 -w 1000 127.0.0.1")
Do While Not objExecObject.StdOut.AtEndOfStream
strText = objExecObject.StdOut.ReadLine()
If InStr(strText, "Reply") > 0 Then
Debug.Print "Reply received: " & strText
Exit Do
End If
Loop
With this approach you don't need the DOSCommand.cls, you can simply use the WshShell object for all your operations.
Your Command22_Click would look like this:
Private Sub Command22_Click()
On Error GoTo errore
Dim objShell As New WshShell
Dim objExecObject As WshExec
Dim strText As String
Set objExecObject = objShell.Exec(text6.Text)
Do While Not objExecObject.StdOut.AtEndOfStream
strText = objExecObject.StdOut.ReadLine()
' Parse the text your 7z command returned here
If InStr(strText, "41_gfx7.rom") > 0 Then
Text1.Text = Text1.Text & strText & vbCrLf
Exit Do
End If
Loop
Exit Sub
errore:
MsgBox (Err.Description & " - " & Err.Source & " - " & CStr(Err.Number))
End Sub

Process monitor / dispatcher in VB6

I need to write a little application in VB6 to run instances of another VB6 application and keep an eye on the running processes, but I don't have any idea how to get process information in VB6. I can see some of what I need with the tasklist utility but I don't really know how create processes (specifying the process or application name if possible) and fetching information about processes from the operating system.
This application is to run on a Windows XP machine.
Does anyone know of a get-you-started tutorial or helpful web page for this sort of thing?
There are numerous Windows API functions you can use to do this. I'd start with looking at EnumProcesses (VB6 example and declaration here) which can be used to gather information about all running processes. You can also use OpenProcess
to start interrogating Windows about a particular process (another VB6 example).
There is also a fairly nice example on MSDN.
And of course, there is CreateProcess (AllApi link) or ShellExecute (AllApi) for spawning processes - the former gives you more control over the creation of the process, while the latter is a much simpler call.
There was another question posted about this a while back with some example code.
Another possible approach would be to use WMI (some useful snippets to adapt).
Finally, here are some tutorials that show you how to do it (I'd recommend trying it yourself first though :):
Getting Process Information using PSAPI
Another EnumProcesses/OpenProcess implementation
WMI-based demonstration
Here are some related questions although you probably already saw them when you searched this site before posting:
Monitoring processes to see if they've crashed in vb6
How can I execute a .bat file but wait until its done running before moving on?
How To Enumerate Processes From VB 6 on Win 2003?
Since you say the other application is ** also VB6**, it would be easier to make the other application into an ActiveX exe. Then you can get references to objects in the other application direct from your first application. COM solves it all for you.
Here's Microsoft's tutorial on the subject - you can download the code too.
Or here's another answer where I've written about this
You don't need to go spelunking for processes just to get a handle to child processes that you spawn. The VB6 Shell() function returns a Process ID you can use to call OpenProcess with. CreateProcess gives you the handle directly.
Ok, here is a super-stripped-down example of a program in VB6 to spawn and monitor programs. The example is coded to start and repeatedly restart 3 copies of the command shell (trivial sample child program). It is also written to kill any running children when it is terminated, and there are better alternatives to use in most cases. See A Safer Alternative to TerminateProcess().
This demo also reports back the exit code of each process that quits. You could enter exit 1234 or somesuch to see this in action.
To create the demo open a new VB6 Project with a Form. Add a multiline TextBox Text1 and a Timer Timer1 (which is used to poll the children for completion). Paste this code into the Form:
Option Explicit
Private Const SYNCHRONIZE = &H100000
Private Const PROCESS_QUERY_INFORMATION = &H400&
Private Const PROCESS_TERMINATE = &H1&
Private Const WAIT_OBJECT_0 = 0
Private Const INVALID_HANDLE = -1
Private Const DEAD_HANDLE = -2
Private Declare Function CloseHandle Lib "kernel32" ( _
ByVal hObject As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" ( _
ByVal hProcess As Long, _
ByRef lpExitCode 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 TerminateProcess Lib "kernel32" ( _
ByVal hProcess As Long, _
ByVal uExitCode As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" ( _
ByVal hHandle As Long, _
ByVal dwMilliseconds As Long) As Long
Private Tasks() As String
Private Handles() As Long
Private Sub Form_Load()
Dim I As Integer
'We'll run 3 copies of the command shell as an example.
ReDim Tasks(2)
ReDim Handles(2)
For I = 0 To 2
Tasks(I) = Environ$("COMSPEC") & " /k ""#ECHO I am #" & CStr(I) & """"
Handles(I) = INVALID_HANDLE
Next
Timer1.Interval = 100
Timer1.Enabled = True
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Dim I As Integer
Timer1.Enabled = False
DoEvents
For I = 0 To UBound(Tasks)
If Handles(I) <> INVALID_HANDLE And Handles(I) <> DEAD_HANDLE Then
TerminateProcess Handles(I), 666
CloseHandle Handles(I)
Handles(I) = DEAD_HANDLE
End If
Next
End Sub
Private Sub Timer1_Timer()
Dim I As Integer
Dim ExitCode As Long
Dim Pid As Long
Timer1.Enabled = False
For I = 0 To UBound(Tasks)
If Handles(I) <> INVALID_HANDLE Then
If WaitForSingleObject(Handles(I), 0) = WAIT_OBJECT_0 Then
If GetExitCodeProcess(Handles(I), ExitCode) <> 0 Then
Text1.SelText = "Task " & CStr(I) & " terminated, " _
& "exit code: " & CStr(ExitCode) _
& ", restarting task." _
& vbNewLine
Else
Text1.SelText = "Task " & CStr(I) & " terminated, " _
& "failed to retrieve exit code, error " _
& CStr(Err.LastDllError) _
& ", restarting task." _
& vbNewLine
End If
CloseHandle Handles(I)
Handles(I) = INVALID_HANDLE
End If
End If
If Handles(I) = INVALID_HANDLE Then
Pid = Shell(Tasks(I), vbNormalFocus)
If Pid <> 0 Then
Handles(I) = OpenProcess(SYNCHRONIZE _
Or PROCESS_QUERY_INFORMATION _
Or PROCESS_TERMINATE, 0, Pid)
If Handles(I) <> 0 Then
Text1.SelText = "Task " & CStr(I) & " started." _
& vbNewLine
Else
Text1.SelText = "Task " & CStr(I) _
& ", failed to open child process." _
& vbNewLine
Handles(I) = DEAD_HANDLE
End If
Else
Text1.SelText = "Task " & CStr(I) _
& ", failed to Shell child process." _
& vbNewLine
Handles(I) = DEAD_HANDLE
End If
End If
Next
Timer1.Enabled = True
End Sub
Hopefully this helps answer the question.
something more simple will use sockets.
Launch you app server and on your client implements the communication against your server. With that you will provide intercommunication.
well i say. because i dont be what you try do
Sorry it only apply if your clients are done in house i you have the option of added changes

End Process from Task Manager using VB 6 Code

I need to kill an application roughly so I can get phantom subscriber of that application in my database (this can not be produced by closing the application). Manually, if we kill the application from Task Manager, the phantom subscriber will be exist. Now I need to do it automatically in VB 6 code. Help! Thanks.
There are two ways:
Send WM_CLOSE to the target application if it has a window (hidden/visible). Task Manager's "End Task" uses this method. Most of the applications handle WM_CLOSE and terminate gracefully.
Use TerminateProcess API to kill forcefully - Task Manager's "End Process" uses this method. This API forcefully kills the process.
An example can be found here:
VB Helper: HowTo: Terminate a process immediately
Use vb6.0 TaskKill
Private Sub Command1_Click()
Shell "taskkill.exe /f /t /im Application.exe"
End Sub
Call ShellExecute with the TaskKill command
TASKKILL [/S system [/U username [/P
[password]]]]
{ [/FI filter] [/PID processid | /IM imagename] } [/T] [/F]
Description:
This tool is used to terminate tasks by process id (PID) or image
name.
Shell "taskkill.exe /f /t /im processname.exe"
This forces (/f) the terminatation of the process with the image name (/im) of processname.exe, and any child processes which were started by it (/t). You may not need all these switches. See the taskkill command help for more information (type the following at the command line):
taskkill/?
Karl Peterson's excellent archive of VB6 code has high quality sample code and full explanations using both WM_CLOSE and TerminateProcess. Accept no substitutes!
One pitfall you might see in a lot of code out there is that sending WM_CLOSE to a single window handle you have isn't sufficient - most applications comprise numerous windows. The answer as implemented in Karl's code: Find all the top-level windows belonging to this application and send the message to each.
Option Explicit
Private Declare Function IsWindow Lib "user32" (ByVal hWnd 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 TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Const PROCESS_ALL_ACCESS = &H1F0FFF
Private Target As String
'---------------------------------------------------------------------------------------
' Creation Date : 24/10/2005 09:03
' Created By : Jason Bruwer
' Purpose : Returns the windows handle of a window if you know the name
' : E.g.
' Microsoft Word
' Microsoft Excel
' Microsoft PowerPoint
' Adobe Reader
' Updated By : [Initials] - [Date] - [Changes]
'---------------------------------------------------------------------------------------
Public Function GetWindowsHandle(WindowName As String, hWindow As Long) As Boolean
On Error GoTo Errors
' Get the target's window handle.
hWindow = FindWindow(vbNullString, WindowName)
If hWindow = 0 Then GoTo Cheers
GetWindowsHandle = True
Cheers:
Exit Function
Errors:
frmMain.LogErrorAcrossUsingRBT ("GetWindowsHandle")
GoTo Cheers
End Function
'---------------------------------------------------------------------------------------
' Creation Date : 24/10/2005 09:03
' Created By : Jason Bruwer
' Purpose : Enumerates all the currently open windows and searches for an application
' with the specified name.
' Updated By : [Initials] - [Date] - [Changes]
'---------------------------------------------------------------------------------------
Public Function TerminateTask(app_name As String) As Boolean
On Error GoTo Errors
Target = UCase(app_name)
EnumWindows AddressOf EnumCallback, 0
TerminateTask = True
Cheers:
Exit Function
Errors:
frmMain.LogErrorAcrossUsingRBT ("TerminateTask")
GoTo Cheers
End Function
'---------------------------------------------------------------------------------------
' Creation Date : 24/10/2005 09:04
' Created By : Jason Bruwer
' Purpose : Checks to see if this is the window we are looking for and then trys
' to kill the application
' Updated By : [Initials] - [Date] - [Changes]
'---------------------------------------------------------------------------------------
Public Function EnumCallback(ByVal app_hWnd As Long, ByVal param As Long) As Long
Dim buf As String * 256
Dim title As String
Dim length As Long
' Get the window's title.
length = GetWindowText(app_hWnd, buf, Len(buf))
title = Left$(buf, length)
'If title <> "" Then Debug.Print title
' See if this is the target window.
If InStr(UCase(title), Target) <> 0 Then
' Kill the window.
If Not KillProcess(app_hWnd) Then Exit Function
End If
' Continue searching.
EnumCallback = 1
End Function
'---------------------------------------------------------------------------------------
' Creation Date : 24/10/2005 09:06
' Created By : Jason Bruwer
' Purpose : Trys to kill an application by using its windows handle
' Updated By : [Initials] - [Date] - [Changes]
'---------------------------------------------------------------------------------------
Public Function KillProcess(hWindow As Long) As Boolean
Dim RetrunValue As Long
Dim ProcessValue As Long
Dim ProcessValueID As Long
Dim ThreadID As Long
On Error GoTo Errors
If (IsWindow(hWindow) <> 0) Then
ThreadID = GetWindowThreadProcessId(hWindow, ProcessValueID)
If (ProcessValueID <> 0) Then
App.LogEvent "Warning...killing orphan process..."
ProcessValue = OpenProcess(PROCESS_ALL_ACCESS, CLng(0), ProcessValueID)
RetrunValue = TerminateProcess(ProcessValue, CLng(0))
CloseHandle ProcessValueID
End If
End If
KillProcess = True
Cheers:
Exit Function
Errors:
frmMain.LogErrorAcrossUsingRBT ("KillProcess")
GoTo Cheers
End Function
Here is my code in vb6 to kill process by name
It works for me
Private Sub TerminateProcess(ProcessName As String)
Dim Process As Object
For Each Process In GetObject("winmgmts:").ExecQuery("Select Name from Win32_Process Where Name = '" & ProcessName & "'")
Process.Terminate
Next
End Sub
Doing this through VB6 Internal ways ...
Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long
Public Sub KillProcess(ByVal processName As String)
Set oWMI = GetObject("winmgmts:")
Set oServices = oWMI.InstancesOf("win32_process")
For Each oService In oServices
servicename = LCase(Trim(CStr(oService.Name) & ""))
If InStr(1, servicename, LCase(processName), vbTextCompare) > 0 Then
oService.Terminate
End If
Next
End Sub
...and just use it as follow:
killProcess("notepad.exe")
Second option: [ by SHELL external ways... ]
Shell "taskkill.exe /f /t /im notepad.exe"

Resources