In Vb How TO Send Terminate message To other running Process? - vb6

I want to send Close Messge To Other Running Process
For that i have the name of that process
Not Process ID

Assuming you're using VB 6 (because you didn't specify .NET), you could the following code:
''#Module-level WinAPI Declarations
Private Const PROCESS_ALL_ACCESS = &H1F0FFF
Private Const TH32CS_SNAPPROCESS As Long = 2&
Private Type PROCESSENTRY32
dwSize As Long
cntUsage As Long
th32ProcessID As Long
th32DefaultHeapID As Long
th32ModuleID As Long
cntThreads As Long
th32ParentProcessID As Long
pcPriClassBase As Long
dwFlags As Long
szexeFile As String * 260
End Type
Private Declare Function OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccess As Long, ByVal blnheritHandle As Long, ByVal dwAppProcessId As Long) As Long
Private Declare Function ProcessFirst Lib "kernel32.dll" Alias "Process32First" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function ProcessNext Lib "kernel32.dll" Alias "Process32Next" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function CreateToolhelpSnapshot Lib "kernel32.dll" Alias "CreateToolhelp32Snapshot" (ByVal lFlags As Long, lProcessID As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32.dll" (ByVal ApphProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
''#Public function to actually kill a process, given its name
Public Sub KillProcess(ByVal ProcessName As String)
Dim uProcess As PROCESSENTRY32
Dim RProcessFound As Long
Dim hSnapshot As Long
Dim SzExeName As String
Dim ExitCode As Long
Dim MyProcess As Long
Dim AppKill As Boolean
Dim AppCount As Integer
Dim i As Integer
If LenB(ProcessName) <> 0 Then
AppCount = 0
uProcess.dwSize = Len(uProcess)
hSnapshot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0&)
RProcessFound = ProcessFirst(hSnapshot, uProcess)
Do
i = InStr(1, uProcess.szexeFile, Chr(0))
SzExeName = LCase$(Left$(uProcess.szexeFile, i - 1))
If Right$(SzExeName, Len(ProcessName)) = LCase$(ProcessName) Then
AppCount = AppCount + 1
MyProcess = OpenProcess(PROCESS_ALL_ACCESS, False, uProcess.th32ProcessID)
AppKill = TerminateProcess(MyProcess, ExitCode)
Call CloseHandle(MyProcess)
End If
RProcessFound = ProcessNext(hSnapshot, uProcess)
Loop While RProcessFound
Call CloseHandle(hSnapshot)
End If
End Sub
Basically what this code does is enumerate all currently running processes in order to find the one you want to kill. The CreateToolHelpSnapshot API function returns a snapshot of the processes, and then we loop through this snapshot with the Process32First and Process32Next functions. When it finds a match to the name you specified, it uses the TerminateProcess function to terminate that process and all of its threads. Note that this is untested on post-XP versions of Windows.
If you speak Win32 fluently, see the following MSDN article: Taking a Snapshot and Viewing Processes
Lots of the examples you find on the Internet (i.e., option one, option two) use EnumWindows to send a WM_CLOSE message to the windows associated with a particular process. The advantage of this is that it asks nicely—sending the WM_CLOSE message gives the process a chance to save any data and exit gracefully. TerminateProcess, as used in the above example, is not so nice—it's an instant buzz-kill. But it will allow you to end processes that don't own any windows. You didn't mention if this was a requirement in the question.
(Honestly, there isn't enough detail in the question for me to have any business trying to answer this question, but I'm procrastinating. If you need anything else, please edit your question to include more details and add a comment to let me know...)

Related

How do I declare multiple flags in PlaySound function statement in VB6?

I am writing a VB6 program and need some help with the syntax of the PlaySound function declaration. I have written the attached snippet and it succeeds in playing Tada.wav but does not reflect all the flags.
Can I have more than one dwFlag, or am I limited to just one ?
I would like dwFlags to include SND_ASYNC, SND_FILENAME and SND_LOOP.
Here is the code I have tried so far:
Dim RetVal As Variant
Private Const SND_ASYNC As Long = &H80
Private Const SND_FILENAME As Long = &H20000
Private Const SND_LOOP As Long = &H8
Private Declare Function PlaySound Lib "winmm.dll" Alias _
"PlaySoundA" (ByVal lpszName As String, ByVal hModule As Long, _
ByVal dwFlags As Long) As Long
Private Sub Command3_Click()
RetVal = PlaySound("C:\Program Files\#VickEdu\Vocab!\Tada.wav",_
0&,_
SND_FILENAME Or SND_ASYNC Or SND_LOOP)
End Sub
Private Sub Command4_Click()
RetVal = PlaySound("C:\Program Files\#VickEdu\Vocab!\Tada.wav",_
0&, _
SND_FILENAME & SND_ASYNC & SND_LOOP)
End Sub
The way you've done it in your Command3 handler is correct (using Or).
Your issue is that you've defined the wrong value for SND_ASYNC. Change:
Private Const SND_ASYNC As Long = &H80
to:
Private Const SND_ASYNC As Long = &H1
Many thanks for your generosity in responding. After reading your remarks I encountered some additional information on my question at the following link http://www.vb6.us/tutorials/playsound-api.
It stated: "The only "gotcha" with Playsound is the creation of dwFlag. It is possible to add too many flags, which will result in an overflow error."
It then went on to give a useful discussion of the meaning of the available flags.

Wait for shelled process and all child processes

Apologies is this has already been answered, I cannot find it. I have a requirement to launch an external process from a vb6 app and wait for that process to finish before continuing. Simple enough. However the process I need to launch in turn launches a child process then exits. I need to wait for the child process to complete (and and other child processes)
Existing code:
Private Const WAIT_INFINITE = -1&
Private Const SYNCHRONIZE = &H100000
Private Declare Function OpenProcess Lib "kernel32" _
(ByVal dwDesiredAccess As Long, _
ByVal bInheritHandle As Long, _
ByVal dwProcessId As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" _
(ByVal hHandle As Long, _
ByVal dwMilliseconds As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" _
(ByVal hObject As Long) As Long
Public Sub ShellProcess(strProcess As String, Optional blnWait As Boolean = False)
Dim hProc As Long
Dim taskId As Long
Dim cmdline As String
cmdline = strProcess
taskId = Shell(cmdline, vbNormalFocus)
If blnWait = True Then
hProc = OpenProcess(SYNCHRONIZE, True, taskId)
Call WaitForSingleObject(hProc, WAIT_INFINITE)
CloseHandle hProc
End If
MsgBox "The shelled app has ended."
End Sub
I have managed to do this in c# sometime ago but now have only vb6 to work with.

How to wait for a shell process to finish before executing further code in VB6

I have a small VB6 app in which I use the Shell command to execute a program. I am storing the output of the program in a file. I am then reading this file and putting the output on the screen using a msgbox in VB6.
This is what my code looks like now:
sCommand = "\evaluate.exe<test.txt "
Shell ("cmd.exe /c" & App.Path & sCommand)
MsgBox Text2String(App.Path & "\experiments\" & genname & "\freq")
The problem is that the output which the VB program is printing using the msgbox is the old state of the file. Is there some way to hold the execution of the VB code until my shell command program finishes so that I get the correct state of the output file and not a previous state?
The secret sauce needed to do this is the WaitForSingleObject function, which blocks execution of your application's process until the specified process completes (or times out). It's part of the Windows API, easily called from a VB 6 application after adding the appropriate declaration to your code.
That declaration would look something like this:
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle _
As Long, ByVal dwMilliseconds As Long) As Long
It takes two parameters: a handle to the process that you want to wait on, and the time-out interval (in milliseconds) that indicates the maximum amount of time that you want to wait. If you do not specify a time-out interval (a value of zero), the function does not wait and returns immediately. If you specify an infinite time-out interval, the function returns only when the process signals that it has completed.
Armed with that knowledge, the only task that remains is figuring out how to get a handle to the process that you started. That turns out to be pretty simple, and can be accomplished a number of different ways:
One possibility (and the way I'd do it) is by using the ShellExecuteEx function, also from the Windows API, as a drop-in replacement for the Shell function that is built into VB 6. This version is far more versatile and powerful, yet just as easily called using the appropriate declaration.
It returns a handle to the process that it creates. All you have to do is pass that handle to the WaitForSingleObject function as the hHandle parameter, and you're in business. Execution of your application will be blocked (suspended) until the process that you've called terminates.
Another possibility is to use the CreateProcess function (once again, from the Windows API). This function creates a new process and its primary thread in the same security context as the calling process (i.e., your VB 6 application).
Microsoft has published a knowledge base article detailing this approach that even provides a complete sample implementation. You can find that article here: How To Use a 32-Bit Application to Determine When a Shelled Process Ends.
Finally, perhaps the simplest approach yet is to take advantage of the fact that the built-in Shell function's return value is an application task ID. This is a unique number that identifies the program you started, and it can be passed to the OpenProcess function to obtain a process handle that can be passed to the WaitForSingleObject function.
However, the simplicity of this approach does come at a cost. A very significant disadvantage is that it will cause your VB 6 application to become completely unresponsive. Because it will not be processing Windows messages, it will not respond to user interaction or even redraw the screen.
The good folks over at VBnet have made complete sample code available in the following article: WaitForSingleObject: Determine when a Shelled App has Ended.
I'd love to be able to reproduce the code here to help stave off link rot (VB 6 is getting up there in years now; there's no guarantee that these resources will be around forever), but the distribution license in the code itself appears to explicitly forbid that.
There is no need to resort to the extra effort of calling CreateProcess(), etc. This more or less duplicates the old Randy Birch code though it wasn't based on his example. There are only so many ways to skin a cat.
Here we have a prepackaged Function for handy use, which also returns the exit code. Drop it into a static (.BAS) module or include it inline in a Form or Class.
Option Explicit
Private Const INFINITE = &HFFFFFFFF&
Private Const SYNCHRONIZE = &H100000
Private Const PROCESS_QUERY_INFORMATION = &H400&
Private Declare Function CloseHandle Lib "kernel32" ( _
ByVal hObject As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" ( _
ByVal hProcess As Long, _
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 WaitForSingleObject Lib "kernel32" ( _
ByVal hHandle As Long, _
ByVal dwMilliseconds As Long) As Long
Public Function ShellSync( _
ByVal PathName As String, _
ByVal WindowStyle As VbAppWinStyle) As Long
'Shell and wait. Return exit code result, raise an
'exception on any error.
Dim lngPid As Long
Dim lngHandle As Long
Dim lngExitCode As Long
lngPid = Shell(PathName, WindowStyle)
If lngPid <> 0 Then
lngHandle = OpenProcess(SYNCHRONIZE _
Or PROCESS_QUERY_INFORMATION, 0, lngPid)
If lngHandle <> 0 Then
WaitForSingleObject lngHandle, INFINITE
If GetExitCodeProcess(lngHandle, lngExitCode) <> 0 Then
ShellSync = lngExitCode
CloseHandle lngHandle
Else
CloseHandle lngHandle
Err.Raise &H8004AA00, "ShellSync", _
"Failed to retrieve exit code, error " _
& CStr(Err.LastDllError)
End If
Else
Err.Raise &H8004AA01, "ShellSync", _
"Failed to open child process"
End If
Else
Err.Raise &H8004AA02, "ShellSync", _
"Failed to Shell child process"
End If
End Function
I know it's an old thread, but...
How about using the Windows Script Host's Run method? It has a bWaitOnReturn parameter.
object.Run (strCommand, [intWindowStyle], [bWaitOnReturn])
Set oShell = CreateObject("WSCript.shell")
oShell.run "cmd /C " & App.Path & sCommand, 0, True
intWindowStyle = 0, so cmd will be hidden
Do like this :
Private Type STARTUPINFO
cb As Long
lpReserved As String
lpDesktop As String
lpTitle As String
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
Private Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessID As Long
dwThreadID As Long
End Type
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal _
hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CreateProcessA Lib "kernel32" (ByVal _
lpApplicationName As String, ByVal lpCommandLine As String, ByVal _
lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, _
ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, _
ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As String, _
lpStartupInfo As STARTUPINFO, lpProcessInformation As _
PROCESS_INFORMATION) As Long
Private Declare Function CloseHandle Lib "kernel32" _
(ByVal hObject As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" _
(ByVal hProcess As Long, lpExitCode As Long) As Long
Private Const NORMAL_PRIORITY_CLASS = &H20&
Private Const INFINITE = -1&
Public Function ExecCmd(cmdline$)
Dim proc As PROCESS_INFORMATION
Dim start As STARTUPINFO
' Initialize the STARTUPINFO structure:
start.cb = Len(start)
' Start the shelled application:
ret& = CreateProcessA(vbNullString, cmdline$, 0&, 0&, 1&, _
NORMAL_PRIORITY_CLASS, 0&, vbNullString, start, proc)
' Wait for the shelled application to finish:
ret& = WaitForSingleObject(proc.hProcess, INFINITE)
Call GetExitCodeProcess(proc.hProcess, ret&)
Call CloseHandle(proc.hThread)
Call CloseHandle(proc.hProcess)
ExecCmd = ret&
End Function
Sub Form_Click()
Dim retval As Long
retval = ExecCmd("notepad.exe")
MsgBox "Process Finished, Exit Code " & retval
End Sub
Reference : http://support.microsoft.com/kb/129796
Great code. Just one tiny little problem: you must declare in the ExecCmd (after Dim start As STARTUPINFO):
Dim ret as Long
You will get an error when trying to compile in VB6 if you don't.
But it works great :)
Kind regards
In my hands, the csaba solution hangs with intWindowStyle = 0, and never passes control back to VB. The only way out is to end process in taskmanager.
Setting intWindowStyle = 3 and closing the window manually passes control back
I've found a better & simpler solution:
Dim processID = Shell("C:/path/to/process.exe " + args
Dim p As Process = Process.GetProcessById(processID)
p.WaitForExit()
and then you just continue with your code.
Hope it helps ;-)

VB6 Lookup Hostname From IP, Specifying DNS Server

I know how to look up a hostname from an IPv4 in VB using the GetHostByAddr Windows API call (this works great). However, that function does not allow one to specify the DNS server to use. Sometimes the default company DNS servers are fine, but other times I need to specify an external DNS server for lookups, and I don't think doing a shell nslookup and parsing the output is the best method, here.
Note: this is actually going to be used as VBA code in an Excel workbook to help someone else do his job, and it's not worth writing a big application when some simple functionality is all he needs.
I thought I had possibly found an answer in the API call getnameinfo but careful reading seems to indicate it does not offer a servername parameter.
After some intense searching, I found reference to the pExtra parameter to the DNSQuery function. But I don't even know how to begin to use that in VB6.
Could anyone help me out in any way with doing a DNS lookup from VB6, specifying the servername to use?
A full working solution would of course be nice, but I'm willing to work: just point me in the right direction.
UPDATE: For some odd reason it didn't click that DNSQuery was a Windows API call. It just didn't sound like one. I certainly would have been able to make more headway on the problem if I'd gathered that one tiny detail.
Try this:
Option Explicit
Private Declare Function DnsQuery Lib "dnsapi" Alias "DnsQuery_A" (ByVal strname As String, ByVal wType As Integer, ByVal fOptions As Long, ByVal pServers As Long, ppQueryResultsSet As Long, ByVal pReserved As Long) As Long
Private Declare Function DnsRecordListFree Lib "dnsapi" (ByVal pDnsRecord As Long, ByVal FreeType As Long) As Long
Private Declare Function lstrlen Lib "kernel32" (ByVal straddress As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, ByVal Source As Long, ByVal Length As Long)
Private Declare Function inet_ntoa Lib "ws2_32.dll" (ByVal pIP As Long) As Long
Private Declare Function inet_addr Lib "ws2_32.dll" (ByVal sAddr As String) As Long
Private Const DnsFreeRecordList As Long = 1
Private Const DNS_TYPE_A As Long = &H1
Private Const DNS_QUERY_BYPASS_CACHE As Long = &H8
Private Type VBDnsRecord
pNext As Long
pName As Long
wType As Integer
wDataLength As Integer
flags As Long
dwTel As Long
dwReserved As Long
prt As Long
others(35) As Byte
End Type
Private Sub Command1_Click()
MsgBox Resolve("google.com", "208.67.222.222")
End Sub
Private Function Resolve(sAddr As String, Optional sDnsServers As String) As String
Dim pRecord As Long
Dim pNext As Long
Dim uRecord As VBDnsRecord
Dim lPtr As Long
Dim vSplit As Variant
Dim laServers() As Long
Dim pServers As Long
Dim sName As String
If LenB(sDnsServers) <> 0 Then
vSplit = Split(sDnsServers)
ReDim laServers(0 To UBound(vSplit) + 1)
laServers(0) = UBound(laServers)
For lPtr = 0 To UBound(vSplit)
laServers(lPtr + 1) = inet_addr(vSplit(lPtr))
Next
pServers = VarPtr(laServers(0))
End If
If DnsQuery(sAddr, DNS_TYPE_A, DNS_QUERY_BYPASS_CACHE, pServers, pRecord, 0) = 0 Then
pNext = pRecord
Do While pNext <> 0
Call CopyMemory(uRecord, pNext, Len(uRecord))
If uRecord.wType = DNS_TYPE_A Then
lPtr = inet_ntoa(uRecord.prt)
sName = String(lstrlen(lPtr), 0)
Call CopyMemory(ByVal sName, lPtr, Len(sName))
If LenB(Resolve) <> 0 Then
Resolve = Resolve & " "
End If
Resolve = Resolve & sName
End If
pNext = uRecord.pNext
Loop
Call DnsRecordListFree(pRecord, DnsFreeRecordList)
End If
End Function
It is not an answer, but very important note to wqw post:
Security Warning on lstrlen function (lines 5 & 55):
Using this function incorrectly can compromise the security of your
application. lstrlen assumes that lpString is a null-terminated
string, or NULL. If it is not, this could lead to a buffer overrun or
a denial of service attack against your application.
Consider using one of the following alternatives: StringCbLength or
StringCchLength.
You can use the DNS WMI provider to set the DNS of the system then use GetHostByAddr

Using GetTokenInformation in Visual Basic 6 to determine whether a user is an admin

I am using GetTokenInformation as a part of the code that determines if the current thread is running as an Administrator.
Anyway, I have a structure for TOKEN INFORMATION that looks like this:
Private Type TOKEN_GROUPS
GroupCount As Long
Groups(500) As SID_AND_ATTRIBUTES
End Type
Then, I invoke GetTokenInformation like so:
res = GetTokenInformation(<Process Handle>, 2, <TOKEN_GROUPS>, _
<Token Info Length>, <Buffer Length)
The first invocation is to get the Buffer Length, then I invoke it again to get the token information.
Anyway, the application will suddenly crash when the account that run the application is connected to a domain. Apparently, the size of the,
Groups(500) As SID.AND.ATTRIBUTES
is not enough and is causing a buffer overrun. I don't know why that is (MSDN says that I should provide an ANYSIZE_ARRAY or 1). Increasing the size of the Groups to 1000 fixes the problem.
As a quick fix and since I don't have an idea on how to get the appropriate size of Groups, I am planning to just ReDim the Groups until the call succeeds.
Here's my question:
I have an On Error clause, but when the buffer overrun occurs, the On Error can't catch it and my app suddenly crashes. Why is that?
Given the code below
Private Type TOKEN_GROUPS
GroupCount As Long
Groups() As SID_AND_ATTRIBUTES 'FAILING
'Groups(1000) As SID_AND_ATTRIBUTES DOES NOT FAIL
End Type
Dim X as TOKEN_GROUPS
ReDim Preserve X.Groups(1000) As SID_AND_ATTRIBUTES 'FAILING
res = GetTokenInformation(<Process Handle>, 2, <TOKEN_GROUPS>, <Token Info Length>, <Buffer Length)
res = GetTokenInformation(<Process Handle>, 2, <TOKEN_GROUPS>, <Token Info Length>, <Buffer Length)
Why is that when I declared Groups as 1000, the GetTokenInformation call is not failing but when I declared an "empty" Groups() and ReDim'd it to 1000, it is failing?
If you want to use dynamicly sized array for Groups you'll need "custom API call marshaling" code. Basicly couple of CopyMemory's and an array resize
Option Explicit
'--- for OpenProcessToken
Private Const TOKEN_READ As Long = &H20008
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pTo As Any, uFrom As Any, ByVal lSize As Long)
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Private Declare Function GetTokenInformation Lib "advapi32.dll" (ByVal TokenHandle As Long, ByVal TokenInformationClass As Long, TokenInformation As Any, ByVal TokenInformationLength As Long, ReturnLength As Long) As Long
Private Type SID_AND_ATTRIBUTES
Sid As Long
Attributes As Long
End Type
Private Type VB_TOKEN_GROUPS
GroupCount As Long
Groups() As SID_AND_ATTRIBUTES
End Type
Private Sub Command1_Click()
Dim hProcessID As Long
Dim hToken As Long
Dim lNeeded As Long
Dim baBuffer() As Byte
Dim uGroups As VB_TOKEN_GROUPS
hProcessID = GetCurrentProcess()
If hProcessID <> 0 Then
If OpenProcessToken(hProcessID, TOKEN_READ, hToken) = 1 Then
Call GetTokenInformation(hToken, 2, ByVal 0, 0, lNeeded)
ReDim baBuffer(0 To lNeeded)
'--- enum TokenInformationClass { TokenUser = 1, TokenGroups = 2, ... }
If GetTokenInformation(hToken, 2, baBuffer(0), UBound(baBuffer), lNeeded) = 1 Then
Call CopyMemory(uGroups.GroupCount, baBuffer(0), 4)
ReDim uGroups.Groups(0 To uGroups.GroupCount - 1)
Call CopyMemory(uGroups.Groups(0), baBuffer(4), uGroups.GroupCount * Len(uGroups.Groups(0)))
End If
Call CloseHandle(hToken)
End If
Call CloseHandle(hProcessID)
End If
End Sub
There is another question here that seems to have solved the GetTokenInformation call.
Copied from the accepted answer:
Call GetTokenInformation(hToken, 1, ByVal 0, 0, lNeeded)
ReDim baBuffer(0 To lNeeded)
...

Resources