374 lines
14 KiB
ObjectPascal
374 lines
14 KiB
ObjectPascal
{**************************************************************************************************}
|
|
{ }
|
|
{ Project JEDI Code Library (JCL) }
|
|
{ }
|
|
{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
|
|
{ you may not use this file except in compliance with the License. You may obtain a copy of the }
|
|
{ License at http://www.mozilla.org/MPL/ }
|
|
{ }
|
|
{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
|
|
{ ANY KIND, either express or implied. See the License for the specific language governing rights }
|
|
{ and limitations under the License. }
|
|
{ }
|
|
{ The Original Code is JclMiscel.pas. }
|
|
{ }
|
|
{ The Initial Developers of the Original Code are Members of Team JCL. Portions created by these }
|
|
{ individuals are Copyright (C) of these individuals. All Rights Reserved }
|
|
{ }
|
|
{ Contributors: }
|
|
{ Jeroen Speldekamp }
|
|
{ Peter Friese }
|
|
{ Marcel van Brakel }
|
|
{ Robert Marquardt (marquardt) }
|
|
{ John C Molyneux }
|
|
{ Matthias Thoma (mthoma) }
|
|
{ Petr Vones (pvones) }
|
|
{ }
|
|
{**************************************************************************************************}
|
|
{ }
|
|
{ Various miscellanuous routines that do not (yet) fit nicely into other units }
|
|
{ }
|
|
{**************************************************************************************************}
|
|
|
|
// Last modified: $Date: 2005/03/08 08:33:22 $
|
|
// For history see end of file
|
|
|
|
unit JclMiscel;
|
|
|
|
{$I jcl.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
Windows,
|
|
JclBase;
|
|
|
|
// StrLstLoadSave
|
|
function SetDisplayResolution(const XRes, YRes: DWORD): Longint;
|
|
|
|
function CreateDOSProcessRedirected(const CommandLine, InputFile, OutputFile: string): Boolean;
|
|
function WinExec32(const Cmd: string; const CmdShow: Integer): Boolean;
|
|
function WinExec32AndWait(const Cmd: string; const CmdShow: Integer): Cardinal;
|
|
function WinExec32AndRedirectOutput(const Cmd: string; var Output: string; RawOutput: Boolean = False): Cardinal;
|
|
|
|
function ExitWindows(ExitCode: Cardinal): Boolean;
|
|
function LogOffOS: Boolean;
|
|
function PowerOffOS: Boolean;
|
|
function ShutDownOS: Boolean;
|
|
function RebootOS: Boolean;
|
|
|
|
// CreateProcAsUser
|
|
type
|
|
EJclCreateProcessError = class(EJclWin32Error);
|
|
|
|
procedure CreateProcAsUser(const UserDomain, UserName, PassWord, CommandLine: string);
|
|
procedure CreateProcAsUserEx(const UserDomain, UserName, Password, CommandLine: string;
|
|
const Environment: PChar);
|
|
|
|
{$IFDEF SUPPORTS_EXTSYM}
|
|
{$EXTERNALSYM ExitWindows}
|
|
{$ENDIF SUPPORTS_EXTSYM}
|
|
|
|
implementation
|
|
|
|
uses
|
|
SysUtils,
|
|
JclResources, JclSecurity, JclStrings, JclSysUtils, JclWin32;
|
|
|
|
function CreateDOSProcessRedirected(const CommandLine, InputFile, OutputFile: string): Boolean;
|
|
var
|
|
StartupInfo: TStartupInfo;
|
|
ProcessInfo: TProcessInformation;
|
|
SecAtrrs: TSecurityAttributes;
|
|
hInputFile, hOutputFile: THandle;
|
|
begin
|
|
Result := False;
|
|
hInputFile := CreateFile(PChar(InputFile), GENERIC_READ, FILE_SHARE_READ,
|
|
CreateInheritable(SecAtrrs), OPEN_EXISTING, FILE_ATTRIBUTE_TEMPORARY, 0);
|
|
if hInputFile <> INVALID_HANDLE_VALUE then
|
|
begin
|
|
hOutputFile := CreateFile(PChar(OutPutFile), GENERIC_READ or GENERIC_WRITE,
|
|
FILE_SHARE_READ, CreateInheritable(SecAtrrs), CREATE_ALWAYS,
|
|
FILE_ATTRIBUTE_TEMPORARY, 0);
|
|
if hOutputFile <> INVALID_HANDLE_VALUE then
|
|
begin
|
|
FillChar(StartupInfo, SizeOf(StartupInfo), #0);
|
|
StartupInfo.cb := SizeOf(StartupInfo);
|
|
StartupInfo.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
|
|
StartupInfo.wShowWindow := SW_HIDE;
|
|
StartupInfo.hStdOutput := hOutputFile;
|
|
StartupInfo.hStdInput := hInputFile;
|
|
Result := CreateProcess(nil, PChar(CommandLine), nil, nil, True,
|
|
CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, nil, nil, StartupInfo,
|
|
ProcessInfo);
|
|
if Result then
|
|
begin
|
|
WaitForSingleObject(ProcessInfo.hProcess, INFINITE);
|
|
CloseHandle(ProcessInfo.hProcess);
|
|
CloseHandle(ProcessInfo.hThread);
|
|
end;
|
|
CloseHandle(hOutputFile);
|
|
end;
|
|
CloseHandle(hInputFile);
|
|
end;
|
|
end;
|
|
|
|
function WinExec32(const Cmd: string; const CmdShow: Integer): Boolean;
|
|
var
|
|
StartupInfo: TStartupInfo;
|
|
ProcessInfo: TProcessInformation;
|
|
begin
|
|
FillChar(StartupInfo, SizeOf(TStartupInfo), #0);
|
|
StartupInfo.cb := SizeOf(TStartupInfo);
|
|
StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
|
|
StartupInfo.wShowWindow := CmdShow;
|
|
Result := CreateProcess(nil, PChar(Cmd), nil, nil, False,
|
|
NORMAL_PRIORITY_CLASS, nil, nil, StartupInfo, ProcessInfo);
|
|
if Result then
|
|
begin
|
|
WaitForInputIdle(ProcessInfo.hProcess, INFINITE);
|
|
CloseHandle(ProcessInfo.hThread);
|
|
CloseHandle(ProcessInfo.hProcess);
|
|
end;
|
|
end;
|
|
|
|
function WinExec32AndWait(const Cmd: string; const CmdShow: Integer): Cardinal;
|
|
var
|
|
StartupInfo: TStartupInfo;
|
|
ProcessInfo: TProcessInformation;
|
|
begin
|
|
Result := Cardinal($FFFFFFFF);
|
|
FillChar(StartupInfo, SizeOf(TStartupInfo), #0);
|
|
StartupInfo.cb := SizeOf(TStartupInfo);
|
|
StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
|
|
StartupInfo.wShowWindow := CmdShow;
|
|
if CreateProcess(nil, PChar(Cmd), nil, nil, False, NORMAL_PRIORITY_CLASS,
|
|
nil, nil, StartupInfo, ProcessInfo) then
|
|
begin
|
|
WaitForInputIdle(ProcessInfo.hProcess, INFINITE);
|
|
if WaitForSingleObject(ProcessInfo.hProcess, INFINITE) = WAIT_OBJECT_0 then
|
|
begin
|
|
if not GetExitCodeProcess(ProcessInfo.hProcess, Result) then
|
|
Result := Cardinal($FFFFFFFF);
|
|
end;
|
|
CloseHandle(ProcessInfo.hThread);
|
|
CloseHandle(ProcessInfo.hProcess);
|
|
end;
|
|
end;
|
|
|
|
function WinExec32AndRedirectOutput(const Cmd: string; var Output: string; RawOutput: Boolean): Cardinal;
|
|
begin
|
|
Result := Execute(Cmd, Output, RawOutput);
|
|
end;
|
|
|
|
function LogOffOS: Boolean;
|
|
begin
|
|
{$IFDEF MSWINDOWS}
|
|
Result := JclMiscel.ExitWindows(EWX_LOGOFF);
|
|
{$ENDIF MSWINDOWS}
|
|
{ TODO : implement at least LINUX variants throwing an exception }
|
|
end;
|
|
|
|
function PowerOffOS: Boolean;
|
|
begin
|
|
{$IFDEF MSWINDOWS}
|
|
Result := JclMiscel.ExitWindows(EWX_POWEROFF);
|
|
{$ENDIF MSWINDOWS}
|
|
end;
|
|
|
|
function ShutDownOS: Boolean;
|
|
begin
|
|
{$IFDEF MSWINDOWS}
|
|
Result := JclMiscel.ExitWindows(EWX_SHUTDOWN);
|
|
{$ENDIF MSWINDOWS}
|
|
end;
|
|
|
|
function RebootOS: Boolean;
|
|
begin
|
|
{$IFDEF MSWINDOWS}
|
|
Result := JclMiscel.ExitWindows(EWX_Reboot);
|
|
{$ENDIF MSWINDOWS}
|
|
end;
|
|
|
|
function ExitWindows(ExitCode: Cardinal): Boolean;
|
|
begin
|
|
{ TODO -cTest : Check for Win9x }
|
|
if (Win32Platform = VER_PLATFORM_WIN32_NT) and not EnableProcessPrivilege(True, SE_SHUTDOWN_NAME) then
|
|
Result := False
|
|
else
|
|
Result := ExitWindowsEx(ExitCode, SHTDN_REASON_MAJOR_APPLICATION or SHTDN_REASON_MINOR_OTHER);
|
|
end;
|
|
|
|
function SetDisplayResolution(const XRes, YRes: DWORD): Longint;
|
|
var
|
|
DevMode: TDeviceMode;
|
|
begin
|
|
Result := DISP_CHANGE_FAILED;
|
|
FillChar(DevMode, SizeOf(DevMode), #0);
|
|
DevMode.dmSize := SizeOf(DevMode);
|
|
if EnumDisplaySettings(nil, 0, DevMode) then
|
|
begin
|
|
DevMode.dmFields := DM_PELSWIDTH or DM_PELSHEIGHT;
|
|
DevMode.dmPelsWidth := XRes;
|
|
DevMode.dmPelsHeight := YRes;
|
|
Result := ChangeDisplaySettings(DevMode, 0);
|
|
end;
|
|
end;
|
|
|
|
procedure CheckOSVersion;
|
|
begin
|
|
if Win32Platform <> VER_PLATFORM_WIN32_NT then
|
|
raise EJclError.CreateRes(@RsCreateProcNTRequiredError);
|
|
if Win32BuildNumber < 1057 then
|
|
raise EJclError.CreateRes(@RsCreateProcBuild1057Error);
|
|
end;
|
|
|
|
procedure CreateProcAsUser(const UserDomain, UserName, PassWord, CommandLine: string);
|
|
begin
|
|
CreateProcAsUserEx(UserDomain, UserName, Password, CommandLine, nil);
|
|
end;
|
|
|
|
{ TODO -cTest : Check for Win9x }
|
|
procedure CreateProcAsUserEx(const UserDomain, UserName, Password, CommandLine: string;
|
|
const Environment: PChar);
|
|
const
|
|
// default values for window stations and desktops
|
|
CreateProcDEFWINSTATION = 'WinSta0';
|
|
CreateProcDEFDESKTOP = 'Default';
|
|
CreateProcDOMUSERSEP = '\';
|
|
var
|
|
ConsoleTitle: string;
|
|
Help: string;
|
|
WinStaName: string;
|
|
DesktopName: string;
|
|
hUserToken: THandle;
|
|
hWindowStation: HWINSTA;
|
|
hDesktop: HDESK;
|
|
StartUpInfo: TStartUpInfo;
|
|
ProcInfo: TProcessInformation;
|
|
begin
|
|
|
|
// Step 1: check for the correct OS version
|
|
CheckOSVersion;
|
|
|
|
// Step 2: logon as the specified user
|
|
if not LogonUser(PChar(UserName), PChar(UserDomain), PChar(Password),
|
|
LOGON32_LOGON_INTERACTIVE, LOGON32_PROVIDER_DEFAULT, hUserToken) then
|
|
begin
|
|
case GetLastError of
|
|
ERROR_PRIVILEGE_NOT_HELD:
|
|
raise EJclCreateProcessError.CreateResFmt(@RsCreateProcPrivilegeMissing,
|
|
[GetPrivilegeDisplayName(SE_TCB_NAME), SE_TCB_NAME]);
|
|
ERROR_LOGON_FAILURE:
|
|
raise EJclCreateProcessError.CreateRes(@RsCreateProcLogonUserError);
|
|
ERROR_ACCESS_DENIED:
|
|
raise EJclCreateProcessError.CreateRes(@RsCreateProcAccessDenied);
|
|
else
|
|
raise EJclCreateProcessError.CreateRes(@RsCreateProcLogonFailed);
|
|
end;
|
|
end;
|
|
|
|
// Step 3: give the new user access to the current WindowStation and Desktop
|
|
hWindowStation:= GetProcessWindowStation;
|
|
WinStaName := GetUserObjectName(hWindowStation);
|
|
if WinStaName = '' then
|
|
WinStaName := CreateProcDEFWINSTATION;
|
|
|
|
if not SetUserObjectFullAccess(hWindowStation) then
|
|
begin
|
|
CloseHandle(hUserToken);
|
|
raise EJclCreateProcessError.CreateResFmt(@RsCreateProcSetStationSecurityError, [WinStaName]);
|
|
end;
|
|
|
|
hDesktop := GetThreadDesktop(GetCurrentThreadId);
|
|
DesktopName := GetUserObjectName(hDesktop);
|
|
if DesktopName = '' then
|
|
DesktopName := CreateProcDEFDESKTOP;
|
|
|
|
if not SetUserObjectFullAccess(hDesktop) then
|
|
begin
|
|
CloseHandle(hUserToken);
|
|
raise EJclCreateProcessError.CreateResFmt(@RsCreateProcSetDesktopSecurityError, [DesktopName]);
|
|
end;
|
|
|
|
// Step 4: set the startup info for the new process
|
|
ConsoleTitle := UserDomain + UserName;
|
|
FillChar(StartUpInfo, SizeOf(StartUpInfo), #0);
|
|
with StartUpInfo do
|
|
begin
|
|
cb:= SizeOf(StartUpInfo);
|
|
lpTitle:= PChar(ConsoleTitle);
|
|
Help := WinStaName + '\' + DeskTopName;
|
|
lpDesktop:= PChar(Help);
|
|
end;
|
|
|
|
// Step 5: create the child process
|
|
if not CreateProcessAsUser(hUserToken, nil, PChar(CommandLine), nil, nil,
|
|
False, CREATE_NEW_CONSOLE or CREATE_NEW_PROCESS_GROUP, Environment, nil,
|
|
{$IFDEF FPC}
|
|
@StartUpInfo, @ProcInfo) then
|
|
{$ELSE}
|
|
StartUpInfo, ProcInfo) then
|
|
{$ENDIF FPC}
|
|
begin
|
|
case GetLastError of
|
|
ERROR_PRIVILEGE_NOT_HELD:
|
|
raise EJclCreateProcessError.CreateResFmt(@RsCreateProcPrivilegesMissing,
|
|
[GetPrivilegeDisplayName(SE_ASSIGNPRIMARYTOKEN_NAME), SE_ASSIGNPRIMARYTOKEN_NAME,
|
|
GetPrivilegeDisplayName(SE_INCREASE_QUOTA_NAME), SE_INCREASE_QUOTA_NAME]);
|
|
ERROR_FILE_NOT_FOUND:
|
|
raise EJclCreateProcessError.CreateResFmt(@RsCreateProcCommandNotFound, [CommandLine]);
|
|
else
|
|
raise EJclCreateProcessError.CreateRes(@RsCreateProcFailed);
|
|
end;
|
|
end;
|
|
|
|
// clean up
|
|
CloseWindowStation(hWindowStation);
|
|
CloseDesktop(hDesktop);
|
|
CloseHandle(hUserToken);
|
|
|
|
// if this code should be called although there has
|
|
// been an exception during invocation of CreateProcessAsUser,
|
|
// it will quite surely fail. you should make sure this doesn't happen.
|
|
// (it shouldn't happen due to the use of exceptions in the above lines)
|
|
CloseHandle(ProcInfo.hThread);
|
|
CloseHandle(ProcInfo.hProcess);
|
|
end;
|
|
|
|
// History:
|
|
|
|
// $Log: JclMiscel.pas,v $
|
|
// Revision 1.13 2005/03/08 08:33:22 marquardt
|
|
// overhaul of exceptions and resourcestrings, minor style cleaning
|
|
//
|
|
// Revision 1.12 2005/02/24 16:34:52 marquardt
|
|
// remove divider lines, add section lines (unfinished)
|
|
//
|
|
// Revision 1.11 2004/10/25 06:58:44 rrossmair
|
|
// - fixed bug #0002065
|
|
// - outsourced JclMiscel.Win32ExecAndRedirectOutput() + JclBorlandTools.ExecAndRedirectOutput() code into JclSysUtils.Execute()
|
|
// - refactored this code
|
|
// - added overload to supply callback capability per line of output
|
|
//
|
|
// Revision 1.10 2004/10/21 06:38:52 marquardt
|
|
// style clenaing, bugfixes, improvements
|
|
//
|
|
// Revision 1.9 2004/10/17 21:00:15 mthoma
|
|
// cleaning
|
|
//
|
|
// Revision 1.8 2004/07/28 18:00:53 marquardt
|
|
// various style cleanings, some minor fixes
|
|
//
|
|
// Revision 1.7 2004/06/14 11:05:53 marquardt
|
|
// symbols added to all ENDIFs and some other minor style changes like removing IFOPT
|
|
//
|
|
// Revision 1.6 2004/05/05 07:33:49 rrossmair
|
|
// header updated according to new policy: initial developers & contributors listed
|
|
//
|
|
// Revision 1.5 2004/04/06 04:55:17
|
|
// adapt compiler conditions, add log entry
|
|
//
|
|
|
|
end.
|