Mega Code Archive
Run a command with higher privileges
<![CDATA[
Title: Run a command with higher privileges
Question: How can I run a command as an Administrator when I have a user profile?
Answer:
This component was tested on Delphi 7 only.
This component are very usefull when you have to execute something as an administrator in a user profile environment.
A couple days ago, I was tested an application in a hospital were the security on the network was very high. Everytime a user started my application, the application had to register an OCX. The user had a USER PROFILE but to register an OCX you should have to be an administrator.
The following component bypass the actual user profile to execute his command.
unit RVRunAs;
interface
uses
SysUtils,
Classes,
Types, //Not necessary with D5
Windows;
type
//Create an error event if the command fail
TOnErrorEvent = procedure(Sender: TObject; ErrorMessage: string) of object;
//To add a BeforeExecute and AfterExecute events
TExecuteEvent = procedure(Sender: TObject) of object;
TRVRunAs = class(TComponent)
private
FUserName: string;
FPassword: string;
FDomain: string;
FCommand: string;
FOnError: TOnErrorEvent;
FBeforeExecute: TExecuteEvent;
FAfterExecute: TExecuteEvent;
protected
{ Protected declarations }
public
procedure Execute;
published
property OnError: TOnErrorEvent read FOnError write FOnError;
property BeforeExecute: TExecuteEvent read FBeforeExecute write FBeforeExecute;
property AfterExecute: TExecuteEvent read FAfterExecute write FAfterExecute;
property UserName: string read FUserName write FUserName;
property Password: string read FPassword write FPassword;
property Domain: string read FDomain write FDomain;
property Command: string read FCommand write FCommand;
end;
//API function reference
function CreateProcessWithLogonW(
lpUsername,
lpDomain,
lpPassword:PWideChar;
dwLogonFlags:dword;
lpApplicationName: PWideChar;
lpCommandLine: PWideChar;
dwCreationFlags: DWORD;
lpEnvironment: Pointer;
lpCurrentDirectory: PWideChar;
const lpStartupInfo: tSTARTUPINFO;
var lpProcessInformation: TProcessInformation
): BOOL; stdcall; external 'advapi32.dll'
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('MyPalette', [TRVRunAs]);
end;
{ TRVRunAs }
procedure TRVRunAs.Execute;
var
StartupInfo: TStartupInfo;
ProcessInfo: TProcessInformation;
wDomain : PWideChar;
wUsername : PWideChar;
wPassword : PWideChar;
wCommand : PWideChar;
//Convert an integer error message to string
function WinErrorAsString(WinError: integer): string;
var
A: array[0..MAX_PATH] of char;
begin
FillChar(A, SizeOf(A), #0);
FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, nil, WinError, LANG_SYSTEM_DEFAULT, @A, MAX_PATH, nil);
Result := string(A);
end;
begin
if Assigned(FBeforeExecute) then
FBeforeExecute(Self);
if Trim(FCommand) '' then
begin
//Setup some flags to execute dos commands in hide mode
FillChar(StartupInfo, SizeOf(StartupInfo), #0);
StartupInfo.cb := SizeOf(StartupInfo);
StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
StartupInfo.wShowWindow := SW_HIDE;
//Allocate necessary memory for the fourth main properties
GetMem(wDomain,Length(FDomain) * SizeOf(WideChar) + SizeOf(WideChar));
GetMem(wUsername,Length(FUsername) * SizeOf(WideChar) + SizeOf(WideChar));
GetMem(wPassword,Length(FPassword) * SizeOf(WideChar) + SizeOf(WideChar));
GetMem(wCommand,Length(FCommand) * SizeOf(WideChar) + SizeOf(WideChar));
//Convert the fourth main properties to WideString data type
StringToWideChar(FDomain,wDomain,Length(FDomain) * SizeOf(WideChar) + SizeOf(WideChar));
StringToWideChar(FUsername,wUsername,Length(FUsername) * SizeOf(WideChar) + SizeOf(WideChar));
StringToWideChar(FPassword,wPassword,Length(FPassword) * SizeOf(WideChar) + SizeOf(WideChar));
StringToWideChar(FCommand,wCommand,Length(FCommand) * SizeOf(WideChar) + SizeOf(WideChar));
//Call the command as a different user/password/domain
if not CreateProcessWithLogonW(wUsername,wDomain,wPassword,0,nil,wCommand,0,nil,nil,StartupInfo,ProcessInfo) then
begin
//If failed, raise an error
if Assigned(FOnError) then
FOnError(Self,WinErrorAsString(GetLastError))
else
RaiseLastOSError; //RaiseLastWin32Error with D5
end;
//Wait for the command to end
WaitForSingleObject(ProcessInfo.hProcess,INFINITE);
//UnAllocate necessary memory
FreeMem(wDomain);
FreeMem(wUsername);
FreeMem(wPassword);
FreeMem(wCommand);
end;
if Assigned(FAfterExecute) then
FAfterExecute(Self);
end;
end.
]]>