unit Unit2;
interface
uses
Winapi.Windows,
Winapi.Messages, System.SysUtils, System.Classes,
Vcl.Graphics,
Vcl.Controls,
Vcl.SvcMgr,
Vcl.Dialogs,
Vcl.ExtCtrls;
type
TService2 =
class(TService)
Timer1: TTimer;
procedure Timer1Timer(Sender: TObject);
private
{ Private-Deklarationen }
public
function GetServiceController: TServiceController;
override;
{ Public-Deklarationen }
end;
var
Service2: TService2;
implementation
{$R *.DFM}
procedure ServiceController(CtrlCode: DWord);
stdcall;
begin
Service2.Controller(CtrlCode);
end;
function TService2.GetServiceController: TServiceController;
begin
Result := ServiceController;
end;
function CreateProcessWithLogon(lpUsername: PWideChar;
lpDomain: PWideChar;
lpPassword: PWideChar;
dwLogonFlags: DWORD;
lpApplicationName: PWideChar;
lpCommandLine: PWideChar;
dwCreationFlags: DWORD;
lpEnvironment: Pointer;
lpCurrentDirectory: PWideChar;
var lpStartupInfo: TStartupInfo;
var lpProcessInfo: TProcessInformation): BOOL;
stdcall;
external '
advapi32'
name '
CreateProcessWithLogonW';
function CreateEnvironmentBlock(
var lpEnvironment: Pointer;
hToken: THandle;
bInherit: BOOL): BOOL;
stdcall;
external '
userenv';
function DestroyEnvironmentBlock(pEnvironment: Pointer): BOOL;
stdcall;
external '
userenv';
const
LOGON_WITH_PROFILE = $00000001;
{------------
Emulate the RunAs function
--------------}
function RunAs(User, Password, Command:
String): Integer;
var dwSize: DWORD;
hToken: THandle;
lpvEnv: Pointer;
pi: TProcessInformation;
si: TStartupInfo;
szPath:
Array [0..MAX_PATH]
of WideChar;
begin
ZeroMemory(@szPath, SizeOf(szPath));
ZeroMemory(@pi, SizeOf(pi));
ZeroMemory(@si, SizeOf(si));
si.cb:=SizeOf(TStartupInfo);
if LogonUser(PChar(User),
nil, PChar(Password), LOGON32_LOGON_INTERACTIVE,
LOGON32_PROVIDER_DEFAULT, hToken)
then
begin
if CreateEnvironmentBlock(lpvEnv, hToken, True)
then
begin
dwSize:=SizeOf(szPath)
div SizeOf(WCHAR);
if (GetCurrentDirectoryW(dwSize, @szPath) > 0)
then
begin
if (CreateProcessWithLogon(PWideChar(WideString(User)),
nil,
PWideChar(WideString(Password)),
LOGON_WITH_PROFILE,
nil, PWideChar(WideString(Command)),
CREATE_UNICODE_ENVIRONMENT,
lpvEnv, szPath, si, pi))
then
begin
result:=ERROR_SUCCESS;
CloseHandle(pi.hProcess);
CloseHandle(pi.hThread);
end
else
result:=GetLastError;
end
else
result:=GetLastError;
DestroyEnvironmentBlock(lpvEnv);
end
else
result:=GetLastError;
CloseHandle(hToken);
end
else
result:=GetLastError;
end;
procedure TService2.Timer1Timer(Sender: TObject);
begin
RunAs('
user','
password','
notepad.exe');
Timer1.Enabled:=false;
end;
end.