Delphi CreateProcess as administrator [duplicate] - delphi

This question already has an answer here:
Launch an EXE with elevated privileges from a "normal" non-elevated one?
(1 answer)
Closed 3 months ago.
I am executing a command line program from Delphi.
I am using CreateProcess as I need to capture the output and display it in a memo.
My problem now is that the program I am executing needs to run "as administrator" to work properly. If I run it in an "as administrator" command prompt it executes fine.
How do I tell the CreateProcess to run as administrator? I see ShellExecute has an lpVerb parameter that can be set to 'runas' for this to work, but I need CreateProcess to be able to capture the command line output and display it.
I thought if I run my exe as administrator those rights would be passed down to the CreateProcess cmd, but it does not look like that happens.
Any ideas on how I can tell CreateProcess I want to run the process elevated?
Here is the working code now that launches a command line fine (just not as admin)
var
SA: TSecurityAttributes;
SI: TStartupInfo;
PI: TProcessInformation;
StdOutPipeRead, StdOutPipeWrite: THandle;
Handle: Boolean;
begin
with SA do begin
nLength := SizeOf(SA);
bInheritHandle := True;
lpSecurityDescriptor := nil;
end;
CreatePipe(StdOutPipeRead, StdOutPipeWrite, #SA, 0);
try
with SI do
begin
FillChar(SI, SizeOf(SI), 0);
cb := SizeOf(SI);
dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
wShowWindow := SW_HIDE;
hStdInput := GetStdHandle(STD_INPUT_HANDLE); // don't redirect stdin
hStdOutput := StdOutPipeWrite;
hStdError := StdOutPipeWrite;
end;
Handle := CreateProcess(nil, PWideChar('cmd.exe /C ' + CommandLine),
nil, nil, True, 0, nil,
PWideChar(WorkDir), SI, PI);

the program I am executing needs to run "as administrator" to work properly.
If that is true, then that program should have a UAC manifest that specifies a requestedExecutionLevel of requireAdministrator. In which case, CreateProcess() would fail with an ERROR_ELEVATION_REQUIRED error code if your program is not also running as an elevated administrator. If that is not the case then that other program is not designed properly.
How do I tell the CreateProcess to run as administrator?
You cannot, as it does not have that capability.
Your options are to either:
run your program as an elevated admin, so that calling CreateProcess() will run the command in the same elevated admin context.
use ShellExecute/Ex() with the "runas" verb to run the command as an elevated admin (as you already know). But then, you can't capture the output of the new process, unless you instruct the command to pipe its output to a temp file, which you can then read once the command has terminated.
have your main program use ShellExecute/Ex("runas") to run a separate copy of itself as an elevated admin, and then that process can call CreateProcess(), capture the output, and send it back to your main process via an IPC mechanism of your own choosing.
refactor your CreateProcess+capturing code into a separate COM object, and then use the COM Elevation Moniker to instantiate that object in an elevated admin context when needed.
use the unofficial CreateProcessElevated() API that is described in this article: Vista UAC: The Definitive Guide
I thought if I run my exe as administrator those rights would be passed down to the CreateProcess cmd, but it does not look like that happens.
Yes, it will.

I have used this in my programs
function RunAsAdmin(hWnd: hWnd; filename: string; Parameters: string; Visible: Boolean = true): Boolean;
{
See Step 3: Redesign for UAC Compatibility (UAC)
http://msdn.microsoft.com/en-us/library/bb756922.aspx
This code is released into the public domain. No attribution required.
}
var
sei: TShellExecuteInfo;
begin
ZeroMemory(#sei, SizeOf(sei));
sei.cbSize := SizeOf(TShellExecuteInfo);
sei.Wnd := hWnd;
sei.fMask := SEE_MASK_FLAG_DDEWAIT or SEE_MASK_FLAG_NO_UI;
sei.lpVerb := PChar('runas');
sei.lpFile := PChar(filename); // PAnsiChar;
if Parameters <> '' then
sei.lpParameters := PChar(Parameters); // PAnsiChar;
if Visible then
sei.nShow := SW_SHOWNORMAL // Integer;
else
sei.nShow := SW_HIDE;
Result := ShellExecuteEx(#sei);
end;

Related

Acceptable replacement for WinExec()?

I want to run a command that the user defined in an INI file.
The commands can be EXE files, or other files (e.g. DOC files) and parameters should be allowed.
Since WinExec() can handle arguments (e.g. "cmd /?"), but ShellExec() can handle Non-EXE files (e.g. "Letter.doc"), I am using a combination of these both.
I am concerned about future Windows versions, because WinExec() is deprecated, and even from the 16 bit era.
Here is my current function:
procedure RunCMD(cmdLine: string; WindowMode: integer);
procedure ShowWindowsErrorMessage(r: integer);
begin
MessageDlg(SysErrorMessage(r), mtError, [mbOK], 0);
end;
var
r, g: Cardinal;
begin
// We need a function which does following:
// 1. Replace the Environment strings, e.g. %SystemRoot% --> ExpandEnvStr
// 2. Runs EXE files with parameters (e.g. "cmd.exe /?") --> WinExec
// 3. Runs EXE files without path (e.g. "calc.exe") --> WinExec
// 4. Runs EXE files without extension (e.g. "calc") --> WinExec
// 5. Runs non-EXE files (e.g. "Letter.doc") --> ShellExecute
// 6. Commands with white spaces (e.g. "C:\Program Files\xyz.exe") must be enclosed in quotes.
cmdLine := ExpandEnvStr(cmdLine);
// TODO: Attention: WinExec() is deprecated, but there is no acceptable replacement
g := WinExec(PChar(cmdLine), WindowMode);
r := GetLastError;
if g = ERROR_BAD_FORMAT then
begin
// e.g. if the user tries to open a non-EXE file
ShellExecute(0, nil, PChar(cmdLine), '', '', WindowMode);
r := GetLastError;
end;
if r <> 0 then ShowWindowsErrorMessage(r);
end;
function ExpandEnvStr(const szInput: string): string;
// http://stackoverflow.com/a/2833147/3544341
const
MAXSIZE = 32768;
begin
SetLength(Result, MAXSIZE);
SetLength(Result, ExpandEnvironmentStrings(pchar(szInput),
#Result[1],length(Result)));
end;
Microsoft recommends using CreateProcess(), but I do not accept it as a real replacement for WinExec().
For example, given following command line:
"C:\Program Files\xyz.exe" /a /b /c
Since ShellExecute() and CreateProcess() require a strict separation of command and arguments, I would have to parse this string myself. Is that really the only way I can go? Has someone written a public available code featuring this functionality?
Additional note: The process should not be attached to the caller. My program will close, right after the command has started.
CreateProcess() is the replacement for WinExec(). The documentation explicitly states as much.
And BTW, the error handling in your original code is completely wrong. You are misusing GetLastError(). In fact, neither WinExec() nor ShellExecute() even report errors with GetLastError() to begin with. So, even if WinExec() or ShellExecute() are successful (and you are not even checking if ShellExecute() succeeds or fails), you risk reporting random errors from earlier API calls.
Try something more like this:
procedure RunCMD(cmdLine: string; WindowMode: integer);
procedure ShowWindowsErrorMessage(r: integer);
var
sMsg: string;
begin
sMsg := SysErrorMessage(r);
if (sMsg = '') and (r = ERROR_BAD_EXE_FORMAT) then
sMsg := SysErrorMessage(ERROR_BAD_FORMAT);
MessageDlg(sMsg, mtError, [mbOK], 0);
end;
var
si: TStartupInfo;
pi: TProcessInformation;
sei: TShellExecuteInfo;
err: Integer;
begin
// We need a function which does following:
// 1. Replace the Environment strings, e.g. %SystemRoot% --> ExpandEnvStr
// 2. Runs EXE files with parameters (e.g. "cmd.exe /?") --> WinExec
// 3. Runs EXE files without path (e.g. "calc.exe") --> WinExec
// 4. Runs EXE files without extension (e.g. "calc") --> WinExec
// 5. Runs non-EXE files (e.g. "Letter.doc") --> ShellExecute
// 6. Commands with white spaces (e.g. "C:\Program Files\xyz.exe") must be enclosed in quotes.
cmdLine := ExpandEnvStr(cmdLine);
{$IFDEF UNICODE}
UniqueString(cmdLine);
{$ENDIF}
ZeroMemory(#si, sizeof(si));
si.cb := sizeof(si);
si.dwFlags := STARTF_USESHOWWINDOW;
si.wShowWindow := WindowMode;
if CreateProcess(nil, PChar(cmdLine), nil, nil, False, 0, nil, nil, si, pi) then
begin
CloseHandle(pi.hThread);
CloseHandle(pi.hProcess);
Exit;
end;
err := GetLastError;
if (err = ERROR_BAD_EXE_FORMAT) or
(err = ERROR_BAD_FORMAT) then
begin
ZeroMemory(#sei, sizeof(sei));
sei.cbSize := sizeof(sei);
sei.lpFile := PChar(cmdLine);
sei.nShow := WindowMode;
if ShellExecuteEx(#sei) then Exit;
err := GetLastError;
end;
ShowWindowsErrorMessage(err);
end;
Although similar ShellExecute and CreateProcess serve a different purpose.
ShellExecute can open non executable files. It looks up the information in the registry for the associated program for the given file and will execute it. ShellExecute is also great for launching the default web browser and you can pass a URL to it it.
So if you were to pass an TXT file to ShellExecute it would open the associated program such as notepad. However it would fail with CreateProcess.
CreateProcess is a lower level function, that allows you to have better control over the input and output from the the process. For example you can call command line programs that have text output with CreateProcess and capture that output and react according.
Given the concerns you have you will need to use ShellExecute. You will however need to split the command from the parameters. This is would be the first non escaped whitespace character.
I personally rarely call ShellExecute or CreateProcess directly. I tend to use on of the following functions from the JCL that wrap these functions.
JclMiscel.pas
CreateDosProcessRedirected
WinExec32
WinExec32AndWait
WinExecAndRedirectOutput
CreateProcessAsUser
CreateProcessAsUserEx
JclShell.pas
ShellExecEx
ShellExec
ShellExecAndWwait
RunAsAdmin
JclSysUtils.pas
Execute (8 Overloaded versions and is the one I use the most)

What can cause ShellExecuteEx fail with COMADMIN_E_REGDB_SYSTEMERR when started from the Delphi IDE?

I have a rather strange problem:
My program uses ShellExecuteEx to start another program. This works fine when my program runs stand alone, but fails when it gets started from the Delphi IDE where "Started from the Delphi IDE" means either:
Run -> Run (inside the debugger)
Run -> Run without Debugging
ShellExecuteEx returns false and RaiseLastOsError results in the following error message:
System Error. Code: -2146368396.
The COM+ registry database detected a system error.
The same program has another problem that is probably caused by the same issue: The TOpenDialog.Exeucte and TSaveDialog.Execute methods don't do anything. No dialog is shown and the functions return false. Again this works fine when the program runs stand alone. From googling I have found that this is a COM related issue as well.
My program does not contain any COM code, only those functions that the Delphi RTL/VCL automatically calls.
I have placed a breakpoint on CoInitialize and CoInitializeEx and found only one call to CoInitialize which comes from ComObj.InitComObj. There seems to be nothing wrong there.
Here is the code that fails:
function ShellExecEx(const Filename: string; const Parameters: string;
const Verb: string; CmdShow: Integer; _ShowAssociateDialog: Boolean = False): boolean;
var
Sei: TShellExecuteInfo;
begin
FillChar(Sei, SizeOf(Sei), #0);
Sei.cbSize := SizeOf(Sei);
Sei.FMask := SEE_MASK_DOENVSUBST;
if not _ShowAssociateDialog then
Sei.FMask := Sei.FMask or SEE_MASK_FLAG_NO_UI;
Sei.lpFile := PChar(Filename);
if Parameters <> '' then
Sei.lpParameters := PChar(Parameters)
else
Sei.lpParameters := nil;
if Verb <> '' then
Sei.lpVerb := PChar(Verb)
else
Sei.lpVerb := nil;
Sei.nShow := CmdShow;
Result := ShellExecuteEx(#Sei);
end;
// called as:
lEditorFilename := 'C:\Program Files (x86)\Notepad++\notepad++.exe';
lParameterStr := '"D:\source\EditorUi.dfm" -n1540';
if not ShellExecEx(lEditorFilename, lParameterStr, '', SW_SHOWNORMAL) then
RaiseLastOSError;
This is a 32 bit Delphi XE2 program running on Windows 8.1 64 bit.
Any hints what might cause this?
EDIT:
Following the question from David Heffernan regarding env substitution I removed the additional environment variable
lang=de
I had put into the Run -> Parameters dialog to test the German translations. And all of a sudden both effects described above went away. Putting it back, or adding just any environment variable (eg. test=test), reproduced them reliably.
WTF?

Getting output from a command-line program in a Delphi application on Windows XP

I have VCL application written in Delphi XE2 that needs to execute a command-line program (also written in Delphi XE2) and obtain the text output by it. I am currently using the following code, which is based on that found here: Getting output from a shell/dos app into a Delphi app
function GetDosOutput(ACommandLine : string; AWorkingDirectory : string): string;
var
SecurityAttributes : TSecurityAttributes;
StartupInfo : TStartupInfo;
ProcessInformation: TProcessInformation;
StdOutPipeRead, StdOutPipeWrite: THandle;
WasOK: Boolean;
Buffer: array[0..255] of AnsiChar;
BytesRead: Cardinal;
Handle: Boolean;
begin
Result := '';
SecurityAttributes.nLength := SizeOf(TSecurityAttributes);
SecurityAttributes.bInheritHandle := True;
SecurityAttributes.lpSecurityDescriptor := nil;
CreatePipe(StdOutPipeRead, StdOutPipeWrite, #SecurityAttributes, 0);
try
FillChar(StartupInfo, SizeOf(TStartupInfo), 0);
StartupInfo.cb := SizeOf(TStartupInfo);
StartupInfo.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
StartupInfo.wShowWindow := SW_HIDE;
StartupInfo.hStdInput := StdOutPipeRead;
StartupInfo.hStdOutput := StdOutPipeWrite;
StartupInfo.hStdError := StdOutPipeWrite;
FillChar(ProcessInformation, SizeOf(ProcessInformation), 0);
Handle := CreateProcess(
nil,
PChar(ACommandLine),
nil,
nil,
True,
0,
nil,
PChar(AWorkingDirectory),
StartupInfo,
ProcessInformation
);
CloseHandle(StdOutPipeWrite);
if Handle then
try
repeat
WasOK := ReadFile(StdOutPipeRead, Buffer, 255, BytesRead, nil);
if BytesRead > 0 then
begin
Buffer[BytesRead] := #0;
Result := Result + Buffer;
end;
until not WasOK or (BytesRead = 0);
WaitForSingleObject(ProcessInformation.hProcess, INFINITE);
finally
CloseHandle(ProcessInformation.hThread);
CloseHandle(ProcessInformation.hProcess);
end;
finally
CloseHandle(StdOutPipeRead);
end;
end;
This works fine on most versions of Windows. Unfortunately it has recently come to our attention that it does not work on Windows XP. The call to WaitForSingleObject simply never returns. I tried replacing the second parameter INFINITE with a smaller value (e.g. 15000) but that doesnt't seem to make any difference. In Task Manager I can see that, after calling GetDosOutput, the command-line program is actually running. If I end the VCL application, the command-line program then seems to complete its work successfully (as evidenced by the fact that it outputs the files I was expecting it to). I've also noticed that if I remove STARTF_USESTDHANDLES from StartupInfo.dwFlags, the command-line program runs normally and WaitForSingleObject returns promptly; however I am then obviously unable to obtain the text returned by the program.
Does anybody have a suggestion as to how I can get this working on Windows XP?
There is a really useful unit in freepascal called "process", which does just that, and, work has been done to port it to Delphi so you can capture the output of a command in Delphi using a simple one liner:
RunCommand()
Or you can capture the output of the command with more advanced features by creating a TProcess object yourself (which RunCommand just wraps).
The project is here:
https://github.com/z505/TProcess-Delphi
A simple demo: https://github.com/z505/TProcess-Delphi/tree/master/demo-simple
How to capture the output of a command, i.e. "dir" (list directory contents, famous MS DOS command) into a string then add it to a memo:
uses
dprocess;
// ...
var
output: ansistring;
begin
RunCommand('cmd', ['/c', 'dir'], output, [poNoConsole]);
memo1.Lines.Add(output);
end;

Run with elevated rights fails on WIN7

I am developing using Delphi 6 on a WinXP system.
I have been using the following function to run a program with elevated rights.
function LB_RunAsAdminWait(hWnd: HWND;
filename: string;
Parameters: string): Boolean;
var sei: TShellExecuteInfo; // shell execute info
begin
Result := False; // default to failure
FillChar(sei, SizeOf(sei), 0);
sei.cbSize := SizeOf(sei);
sei.Wnd := hWnd;
sei.fMask := SEE_MASK_FLAG_NO_UI or SEE_MASK_NOCLOSEPROCESS;
sei.lpVerb := 'runas';
sei.lpFile := PChar(filename);
sei.lpParameters := PChar(Parameters);
sei.nShow := SW_SHOWNORMAL;
if ShellExecuteEx(#sei) then // if success
Result := True; // return sucess
if sei.hProcess <> 0 then begin // wait for process to finish
while WaitForSingleObject(sei.hProcess, 50) = WAIT_TIMEOUT do
Application.ProcessMessages;
CloseHandle(sei.hProcess);
end;
end; // of function LB_RunAsAdminWait
How I call it:
if (LB_RunAsAdminWait(FPGM.Handle,'RegSvr32',FName+' /s') = False) then
begin
ShowMessage('WARNING: unable to register OCX');
exit;
end;
where FPGM.handle is the handle to my application
and Fname is the OCX i want to register.
When I run it on a WIN7 machine it returns true(successful) but the OCX is not registered.
Any help would be appreciated.
Most likely explanation is that this is a 32 bit vs 64 bit issue. The DLL is 64 bit, and you are running the 32 bit regsvr32. Or vice versa. Or the file system redirector is confounding you. You put the DLL in system32, but the redirector turns that into SysWow64.
The obvious way to debug it is to remove the silent switch and let regsvr32 tell you what went wrong.
As an aside, as you have discovered, you cannot use the return value of ShellExecuteEx to determine whether or not the server registration succeeded. The return value of ShellExecuteEx merely tells you whether or not the process started.

How can I wait for a command-line program to finish?

I have run program with command-line parameters. How can i wait for it to finish running?
This is my answer : (Thank you all)
uses ShellAPI;
function TForm1.ShellExecute_AndWait(FileName: string; Params: string): bool;
var
exInfo: TShellExecuteInfo;
Ph: DWORD;
begin
FillChar(exInfo, SizeOf(exInfo), 0);
with exInfo do
begin
cbSize := SizeOf(exInfo);
fMask := SEE_MASK_NOCLOSEPROCESS or SEE_MASK_FLAG_DDEWAIT;
Wnd := GetActiveWindow();
exInfo.lpVerb := 'open';
exInfo.lpParameters := PChar(Params);
lpFile := PChar(FileName);
nShow := SW_SHOWNORMAL;
end;
if ShellExecuteEx(#exInfo) then
Ph := exInfo.hProcess
else
begin
ShowMessage(SysErrorMessage(GetLastError));
Result := true;
exit;
end;
while WaitForSingleObject(exInfo.hProcess, 50) <> WAIT_OBJECT_0 do
Application.ProcessMessages;
CloseHandle(Ph);
Result := true;
end;
If I understand your question correctly, you want to execute program in command-line and capture its output in your application rather than in console window. To do so, you can read the output using pipes. Here is an example source code:
Capture the output from a DOS (command/console) Window
Using DSiWin32:
sl := TStringList.Create;
if DSiExecuteAndCapture('cmd.exe /c dir', sl, 'c:\test', exitCode) = 0 then
// exec error
else
// use sl
sl.Free;
Ok, getting the command-line parameters, you use
ParamCount : returns the number of parameters passed to the program on the command-line.
ParamStr : returns a specific parameter, requested by index.
Running Dephi Applications With Parameters
Now, if what you meant is reading and writing to the console, you use
WriteLn : writes a line of text to the console.
ReadLn : reads a line of text from the console as a string.
Delphi Basics
If what you want is to execute a command-line executable, and get the response that this exe writes to the console, the easiest way could be to call the exe from a batch file and redirect the output to another file using >, and then read that file.
For example, if you need to execute the "dir" command and get its output you could have a batch file called getdir.bat that contains the following:
#echo off
dir c:\users\myuser\*.* > output.txt
you could exec that batch file using the API function ShellExecute. You can read about it http://delphi.about.com/od/windowsshellapi/a/executeprogram.htm
Then you can read output file, even using something like a TStringList:
var
output: TStringList;
begin
output := TStringList.Create();
output.LoadFromFile('output.txt');
...

Resources