CreateProcess and get the handle - delphi

I'm using CreateProcess API to integrate RealVNC with my exe... I just need to process handle for the created vnc client, but I'm unsuccess so far. The code is pretty simple:
procedure TForm1.VncAuth;
var
StartInfo: TStartupInfo;
ProcInfo: TProcessInformation;
CmdLine: string;
title: string;
ProcHandle: THandle;
begin
FillChar(StartInfo,SizeOf(TStartupInfo),#0);
FillChar(ProcInfo,SizeOf(TProcessInformation),#0);
StartInfo.cb := SizeOf(TStartupInfo);
CmdLine:= 'vnc.exe';
UniqueString(CmdLine);
CreateProcess(NIL ,PChar(CmdLine), NIL, NIL, False, CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS
, NIL, NIL, StartInfo, ProcInfo);
ProcHandle:= ProcInfo.hProcess;
GetWindowText(ProcHandle, PChar(title), 255);
ShowMessage(title);
end;
Nothing is returned in title var... the GetWindowText function is just a test to see if I have the right handle, if Yes I should see the vnc client title's right?
Thank you!

Window handles and process handles are not the same thing. For GetWindowText you need a window handle.
After creating the process call WaitForInputIdle to allow the process to start up and create its main window.
Call EnumWindows to enumerate the top level windows.
For each top level window, call GetWindowThreadProcessId to find out the process ID of the process that created that window. The process ID of the process you created is ProcInfo.dwProcessId.
When you have find a window with process ID that matches that of the process you just created, that window is your guy!

Related

Closing a CMD Window after launching an application through command line from Delphi

I am trying to do the following. It works but the cmd window waits for the acrobat.exe to finish executing before exiting. I have to use this method of launching because I intend to pass certain command line parameters in future.
cmdLineString := Format('/c ""%s" "%s""',['C:\Program Files (x86)\Adobe\Acrobat 11.0\Acrobat\Acrobat.exe', 'F:\Android-interview\Packt.Android.3.0.Application.Development.Cookbook.Jul.2011.ISBN.1849512949.pdf']);
ShellExecute(Handle, 'open', 'cmd.exe', PChar(CmdLineString), nil, SW_SHOWNORMAL);
There are a number of ways to improve this:
Don't use ShellExecute. It is tempting to do so because it is simple to call. However, it is not very flexible. Use CreateProcess instead.
If you must hide a console window, pass the CREATE_NO_WINDOW flag to CreateProcess.
That said, there is no point to use cmd here. You don't need to create a process that creates another process. Doing so actually makes it harder to pass on arguments. Create the Acrobat process directly. Cut out the middle man.
As answered by David and after following a few other questions regarding CreateProcess the solution code finally looks as shown below. Putting here for other beginners like me. Just think about what all things are possible with this piece of code! Thank you, Delphi.
procedure TForm.btnCMDLaunchClick(Sender: TObject);
var
commandLine: string;
si: TStartupInfo;
pi: TProcessInformation;
begin
commandLine := Format('%s %s',['C:\Program Files (x86)\Adobe\Acrobat 11.0\Acrobat\Acrobat.exe', 'F:\Android-interview\Packt.Android.3.0.Application.Development.Cookbook.Jul.2011.ISBN.1849512949.pdf']);
UniqueString(commandLine);
si := Default(TStartupInfo);
si.cb := sizeof(si);
if CreateProcess(
PChar(nil), //no module name (use command line)
PChar(commandLine), //Command Line
nil, //Process handle not inheritable
nil, //Thread handle not inheritable
False, //Don't inherit handles
0, //No creation flags
nil, //Use parent's environment block
PChar(nil), //Use parent's starting directory
si, //Startup Info
pi //Process Info
) then begin
CloseHandle(pi.hProcess);
CloseHandle(pi.hThread);
end;
end;

Execute and Wait not working sometimes

I am using this code I found on the Internet and on some devices it waits, but on others it does not. Can someone please explain where I am going wrong. My app loads in Truecrypt and then waits for the user to enter the password. On exiting Truecrypt, it then launches my menu-program.
My Lenovo Miix 2 8" tablet, win8.1 (all up to date) will wait, my Dad's win8.0 (all up to date) will wait, but my friend's ASUS M80TA 8" win8.1 tablet (all up to date) will not. Another friend's win7 laptop (all up to date) does not wait ether.
var
aTSI : TStartupInfo;
aTPI : TProcessInformation;
iRet : Integer;
ExitCode: Cardinal;
begin
FillChar(aTSI, SizeOf(aTSI), #0);
FillChar(aTPI, SizeOf(aTPI), #0);
aTSI.CB:=SizeOf(aTSI);
if not CreateProcess(nil, PChar(sEXE), nil, nil, False,
NORMAL_PRIORITY_CLASS,
nil, nil, aTSI, aTPI) then
RaiseLastWin32Error;
repeat
iRet:=MsgWaitForMultipleObjects(1, aTPI.hProcess,
False, INFINITE, (QS_ALLINPUT));
if iRet <> (WAIT_OBJECT_0) then
Application.ProcessMessages;
until iRet = (WAIT_OBJECT_0); // use this for normal programs
ExitCode:= 0;
if not GetExitCodeProcess(aTPI.hProcess, ExitCode) then
RaiseLastWin32Error;
Result:= ExitCode;
CloseHandle(aTPI.hProcess);
end;
The likely explanation is as follows:
You call CreateProcess which creates a new process and returns a handle to that process.
That first new process in turn starts a different process, and immediately returns. That second process is the one that you see, and believe to be the process that you created.
Your wait on the first process handle returns.
In order to know how to deal with this you'd need to supply some details about the process that you are attempting to start. As to why the code works on some machines and not others, that would likely be down to the implementation details of the target application, the external application that you are starting. Presumably it differs from machine to machine.
Looking at the code, it always leaks the thread handle returned in aTPI.hThread. And it leaks aTPI.hProcess if GetExitCodeProcess fails.
You also need to ensure that the string you pass to the command line argument of CreateProcess is an editable string, and not a literal that is stored in read-only memory.
It is also pointless to initialise ExitCode and then immediately overwrite it. What's more you can remove the ExitCode variable and pass Result directly to GetExitCodeProcess.
Your code also fails to acknowledge an error being returned by the wait function.
I'd probably write it like this:
function ExecAndWait(CommandLine: string): DWORD;
var
si: TStartupInfo;
pi: TProcessInformation;
iRet: Integer;
begin
UniqueString(CommandLine);
si := Default(TStartupInfo);
si.cb := SizeOf(si);
Win32Check(CreateProcess(nil, PChar(CommandLine), nil, nil, False,
NORMAL_PRIORITY_CLASS, nil, nil, si, pi));
CloseHandle(pi.hThread);
try
while True do
begin
iRet := MsgWaitForMultipleObjects(1, pi.hProcess, False, INFINITE, QS_ALLINPUT);
Win32Check(iRet <> WAIT_FAILED);
case iRet of
WAIT_OBJECT_0:
break;
WAIT_OBJECT_0+1:
Application.ProcessMessages;
end;
end;
Win32Check(GetExitCodeProcess(pi.hProcess, Result));
finally
CloseHandle(pi.hProcess);
end;
end;
On my machine, when I pass 'notepad.exe' to this function, the function does not return until the Notepad process is closed.
On the other hand, if I pass 'explorer.exe' to the process, then the function returns immediately. What happens here is that a new explorer process starts, but it detects that one is already running, and asks that process to open a new window. The newly started explorer process immediately terminates.

Start long running background process and check the status

I want to start a potentially long running background process from Delphi. I want to leave the process running independently, but first I want to check that the process started OK.
If anything went wrong on startup, I want to capture any output written to standardErr and log it. If the background process starts OK, my program needs to be able to exit and leave the spawned process running.
The psuedo code would be something like this:
process:=RunProgramInBackground('someCommand.exe');
sleep(1000); // Wait a bit to see if the program started OK
if process.Finished and process.ExitCode=FAIL then
Raise Exception.Create(process.ErrorStream);
process.Dispose; // Close any connection we may still have to the running process
Program.Exit; // Background process keeps running
I've looked at a few things (WinExec, CreateProcess, ShellExecute, JclMiscel) but can't find any examples for what I'm trying to do. What is the best way to do this?
I'm using Delphi 2010
The background process is a 3rd party program I don't have the source to.
Check out this article. I quote: "Here is an updated and improved version of the code that allows you to choose in code whether the calling application waits until the other program closes before continuing or just carries on leaving the newly started program to its own devices".
procedure ExecNewProcess(ProgramName : String; Wait: Boolean);
var
StartInfo : TStartupInfo;
ProcInfo : TProcessInformation;
CreateOK : Boolean;
begin
{ fill with known state }
FillChar(StartInfo,SizeOf(TStartupInfo),#0);
FillChar(ProcInfo,SizeOf(TProcessInformation),#0);
StartInfo.cb := SizeOf(TStartupInfo);
CreateOK := CreateProcess(nil, PChar(ProgramName), nil, nil,False,
CREATE_NEW_PROCESS_GROUP+NORMAL_PRIORITY_CLASS,
nil, nil, StartInfo, ProcInfo);
{ check to see if successful }
if CreateOK then
begin
//may or may not be needed. Usually wait for child processes
if Wait then
WaitForSingleObject(ProcInfo.hProcess, INFINITE);
end
else
begin
ShowMessage('Unable to run '+ProgramName);
end;
CloseHandle(ProcInfo.hProcess);
CloseHandle(ProcInfo.hThread);
end;
Edited: after reading your comments, I suggest that you look at this previous question
I ended up using the example No'Am linked to, and adding code to check that the process started OK. This function only checks the exit code of the background process, it doesn't read the StdErr output.
Here is what I did:
/// <summary> Runs a new process in the background. Waits for a short period, then checks that the process started succesfully.
/// If the process has already finished, checks the exit status. Otherwise, leaves it to run. </summary>
/// <param> ProgramName The executable name, including any parameters.</param>
/// <param> TimeOut Milliseconds to wait before checking the process has executed correctly</param>
/// <param> Directory The full path of the working directory</param>
/// <exception> Exception If the process was not started correctly or if the process was started but returned
/// an error before the timeout.</exception>
procedure ExecBackgroundProcess(ProgramName : String; TimeOut: Integer; Directory:string);
var
StartInfo : TStartupInfo;
ProcInfo : TProcessInformation;
CreateOK : Boolean;
status: Cardinal;
theExitCode: Cardinal;
begin
FillChar(StartInfo,SizeOf(TStartupInfo),#0);
FillChar(ProcInfo,SizeOf(TProcessInformation),#0);
StartInfo.cb := SizeOf(TStartupInfo);
UniqueString(ProgramName); // Required if a const string is passed in. Otherwise the program crashes.
CreateOK := CreateProcess(nil, PChar(ProgramName), nil, nil,False,
CREATE_NEW_PROCESS_GROUP+NORMAL_PRIORITY_CLASS+CREATE_NO_WINDOW,
nil, PChar(Directory), StartInfo, ProcInfo);
if CreateOK then
begin
status:=WaitForSingleObject(ProcInfo.hProcess, TimeOut);
if status<> WAIT_TIMEOUT then
begin
// Program has exited. Get exit code.
GetExitCodeProcess(ProcInfo.hProcess, theExitCode);
if theExitCode<>0 then raise Exception.Create('Program '''+ProgramName+''' failed with exit code '+IntToStr(theExitCode));
end
end
else
Raise Exception.Create('Unable to run '+ProgramName+' in directory '+Directory);
CloseHandle(ProcInfo.hProcess);
CloseHandle(ProcInfo.hThread);
end;

Implementing Input/Output redirection in a Delphi console application

I have a Delphi 7 (not 2007) application (lets call it App1.exe) that
the IDE thinks is a GUI application but in the DPR, a compiler
directive that makes it in to a console application. Example:
{$IFDE MAKE_CONSOLE}
{$APPTYPE CONSOLE}
{$ENDIF MAKE_CONSOLE}
During the build process, MAKE_CONSOLE might be defined.
The problem I am having is that we have another console application
(say, App2.exe) that runs App1.exe using the WinAPI CreateProcess. When
is occurs, the output from App1.exe is nowhere to be seen :-( When
App1.exe is ran straight from Commandline (cmd.exe), the output is
shown in the Commandline window.
What I am guessing is that I need to redirect output from App1.exe in
the CreateProcess, using the STARTUPINFO structure. I am not sure what
I am meant to be doing here.
Other info:
* 'dwCreationFlags' that are being used are: CREATE_NEW_PROCESS_GROUP +
NORMAL_PRIORITY_CLASS + DEBUG_PROCESS (yes, App2 debugs App1)
'bInheritHandles' is false (does this need to be changed?).
Both 'lpProcessAttributes' and 'lpThreadAttributes' are nil, as are
'lpEnvironment' and 'lpCurrentDirectory'.
Have I missed any information that is required to help me out?
Any pointers would be great!
Many thanks in advance.
Here is some code I use for calling command-line programs from Deplhi 7.
It can redirect to the current console (of the main calling exe), if you put the "Visibility" parameter to 0, instead of "SW_SHOWNORMAL".
function WinExecAndWait(const FileName: String; Visibility: integer): cardinal;
var StartupInfo: TStartupInfo;
ProcessInfo: TProcessInformation;
Options: cardinal;
begin
FillChar(StartupInfo,Sizeof(StartupInfo),0);
StartupInfo.cb := Sizeof(StartupInfo);
StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
StartupInfo.wShowWindow := Visibility;
if Visibility=0 then begin
Flush(Output);
Options := NORMAL_PRIORITY_CLASS;
end else
Options := CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS;
if not CreateProcess(nil,
pointer(FileName), { pointer to command line string }
nil, { pointer to process security attributes }
nil, { pointer to thread security attributes }
false, { handle inheritance flag }
Options, { creation flags }
nil, { pointer to new environment block }
nil, { pointer to current directory name }
StartupInfo, { pointer to STARTUPINFO }
ProcessInfo) then { pointer to PROCESS_INF }
Result := cardinal(-1) else begin
WaitforSingleObject(ProcessInfo.hProcess,INFINITE);
GetExitCodeProcess(ProcessInfo.hProcess,Result);
end;
end;
Do you by any chance have DETACHED_PROCESS in the process creation flags? Inheriting the parent console should be the default.
This MSDN article discusses how App2 can redirect App1's output:
Creating a Child Process with Redirected Input and Output
ConsoleApp by Martin Lafferty works beautifully for redirecting the output of console programs. You get an event handler that's called for every line of console output.
I can't find the official home for the code, but here's Embarcadero's page:
http://cc.embarcadero.com/Item/14692

ShellExecute not working from IDE but works otherwise

I want to create and then open a txt file using the ShellExecute command.
I have used this code for years with Delphi 7 and it worked:
function Execute(CONST ExeName, Parameters: string): Boolean;
begin
Result:= ShellExecute(0, 'open', PChar(ExeName), PChar(Parameters), nil, SW_SHOWNORMAL)> 32;
end;
Now, I switched to Windows 7 and the code is not working anymore when it runs from IDE. Delphi shows the CPU window with the caption "CPU-Process unknown (2352)". I close the CU windows and everything works fine until I close the application, when Delphi shows the CPU window one more time.
If I run the app from outside IDE, it works fine.
Looks like the debugger has something to say to me, but I don't know what.
Sounds to me like you have the "debug spawned processes" option turned on. When that's enabled, the debugger interrupts the new process at the earliest possible time. Press the "run" button to let it continue running.
You can confirm this hypothesis the next time you debug your program. Compare the process ID (2352, in your example) with the list of processes shown by Task Manager. Which process in that list matches the process ID reported by the debugger?
This is not the answer for your question (I vote for Rob Kennedy & Chris Thornton), but you can write your routine in a more compact way:
function Executa(const ExeName, Parameters: string): Boolean;
begin
Result :=
(ShellExecute(0, 'open', PChar(ExeName), Pointer(Parameters), nil, SW_SHOWNORMAL) > 32);
end;
Note Pointer() instead of PChar() for 4th argument. This is a documented behaviour of PChar/Pointer casts (see help).
I had a problem yesterday with the debugger crashing my application, but running it outside the IDE it would run fine. I was using packages in my development.
I used process explorer to verify I found I was loading a copy from another location than expected. I had two copies of the same BPL floating around. Once I removed the one I was not compiling I was fine.
Applying that to this problem, I would check to make sure you don't have any copies of compiled code that includes: .DCU, .DCP, .BPL, .EXE around. Then I would also make sure you you can ctrl-click on "ShellExecute" to and see the declaration. You may have your library path setup in a way that it can't find the source.
Shot in the dark here, but try running the IDE as administrator, and then not as administrator. That may be a factor. Some users make a shortcut with the administrator option set, so that the auto-update runs successfully. So you may be running the IDE as admin, if you've done that.
Same by me , i solved it by replacing ShellExecute with following:
function TformMain.CreateProcessSimple(
sExecutableFilePath : string )
: string;
function GetExeByExtension(sExt : string) : string;
var
sExtDesc:string;
begin
with TRegistry.Create do
begin
try
RootKey:=HKEY_CLASSES_ROOT;
if OpenKeyReadOnly(sExt) then
begin
sExtDesc:=ReadString('') ;
CloseKey;
end;
if sExtDesc <>'' then
begin
if OpenKeyReadOnly(sExtDesc + '\Shell\Open\Command') then
begin
Result:= ReadString('') ;
end
end;
finally
Free;
end;
end;
end;
var
pi: TProcessInformation;
si: TStartupInfo;
fapp: string;
begin
fapp:=GetExeByExtension(ExtractFileExt(sExecutableFilePath));
FillMemory( #si, sizeof( si ), 0 );
si.cb := sizeof( si );
if Pos('%1',fApp)>0 then begin
sExecutableFilePath:=StringReplace(fapp,'%1',sExecutableFilePath,[rfReplaceAll]);
end else begin
sExecutableFilePath:=fApp+' "'+sExecutableFilePath+'"';
end;
CreateProcess(
Nil,
// path to the executable file:
PChar( sExecutableFilePath ),
Nil, Nil, False,
NORMAL_PRIORITY_CLASS, Nil, Nil,
si, pi );
// "after calling code" such as
// the code to wait until the
// process is done should go here
CloseHandle( pi.hProcess );
CloseHandle( pi.hThread );
end;
ShellExecuteW solve my problems (XE2/Win7/32bit) with "debug spawned processes" option turned off
:)
mybe because strings and pchar are wide pointer from 2010

Resources