How can i kiil a process that i open with the API not the Shell

[skynetosiris]

Im running an external process in visual basic using the API which is ok (everything runs perfect) but if the external process hangs asking a question i would like to kill the external process using a time out, how can i do this?

Thanks in advance (my process comes as follows

Private Declare Function CreatePipe Lib "kernel32" ( _
phReadPipe As Long, _
phWritePipe As Long, _
lpPipeAttributes As Any, _
ByVal nSize As Long) As Long

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

Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type

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

Private Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessId As Long
dwThreadID As Long
End Type

Private Declare Function CreateProcessA Lib "kernel32" (ByVal _
lpApplicationName As Long, ByVal lpCommandLine As String, _
lpProcessAttributes As Any, lpThreadAttributes As Any, _
ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, _
ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, _
lpStartupInfo As Any, lpProcessInformation As Any) As Long

Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Private Const NORMAL_PRIORITY_CLASS = &H20&
Private Const STARTF_USESTDHANDLES = &H100&
Private Const STARTF_USESHOWWINDOW = &H1
Private Const SW_HIDE = 0

form load

ErrMess = ExecuteApp(ExeScript)

end sub

Public Function ExecuteApp(sCmdline As String) As String
Dim proc As PROCESS_INFORMATION, ret As Long
Dim start As STARTUPINFO
Dim sa As SECURITY_ATTRIBUTES
Dim hReadPipe As Long 'Este Handle lee el Pipe.
Dim hWritePipe As Long 'A este pipe se redirecciona StdOutput y StdErr.
Dim sOutput As String
Dim lngBytesRead As Long, sBuffer As String * 256

sa.nLength = Len(sa)
sa.bInheritHandle = True

ret = CreatePipe(hReadPipe, hWritePipe, sa, 0)
If ret = 0 Then
MsgBox "CreatePipe failed. Error: " & Err.LastDllError
Exit Function
End If

start.cb = Len(start)
start.dwFlags = STARTF_USESTDHANDLES Or STARTF_USESHOWWINDOW
' Redirecciona la salida estandar y los errores al mismo pipe
start.hStdOutput = hWritePipe
start.hStdError = hWritePipe
start.wShowWindow = SW_HIDE

ret = CreateProcessA(0&, sCmdline, sa, sa, True, NORMAL_PRIORITY_CLASS, 0&, 0&, start, proc)
If ret = 0 Then
MsgBox "CreateProcess failed. Error: " & Err.LastDllError
Exit Function
End If

CloseHandle hWritePipe

' Lee el texto del shell
' hasta 256 caracteres a la vez
Do
ret = ReadFile(hReadPipe, sBuffer, 256, lngBytesRead, 0&)
sOutput = sOutput & Left$(sBuffer, lngBytesRead)
Loop While ret <> 0 ' if ret = 0 ya no hay caracteres que leer

CloseHandle proc.hProcess
CloseHandle proc.hThread
CloseHandle hReadPipe

ExecuteApp = sOutput ' Regresa el resultado.
End Function

 

[Hypetia]

See WaitForSingleObject and TerminateProcess APIs.

 

[skynetosiris]

Sorry

I don't fully understand the suggestion, i just want to know in that code where to put an option to finish the external execution if it hangs

thanks

 

[Hypetia]

Insert the following code in your code.
___

Loop While ret <> 0 ' if ret = 0 ya no hay caracteres que leer
WaitForSingleObject proc.hProcess, TimeOutIntervalInMilliseconds
TerminateProcess proc.hProcess, -1
CloseHandle proc.hProcess
___
and of course, don't forget to paste the declarations of WaitForSingleObject and TerminateProcess functions in your code.

 

[skynetosiris]

It did not work the external application still hangs