unit uty2;

interface
uses
  Windows, Classes, SysUtils, Dialogs;

type
 TProfileInfo = record
    dwSize : DWORD;
    dwFlags : DWORD;
    lpUserName : LPTSTR;
    lpProfilePath : LPTSTR;
    lpDefaultPath : LPTSTR;
    lpServerName : LPTSTR;
    lpPolicyPath : LPTSTR;
    hProfile : THandle;
 end;

function RunAs(User, Password, Command: String): DWORD;
implementation

const
  PI_NOUI        = 1;     // Prevents displaying of messages
  PI_APPLYPOLICY = 2;     // Apply NT4 style policy

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;

function LoadUserProfile (hToken : THandle; var profileInfo : TProfileInfo) : BOOL; stdcall;

function RunAs(User, Password, Command: String): DWORD;
var  dwSize:        DWORD;
     hToken:        THandle;
     lpvEnv:        Pointer;
     pi:            TProcessInformation;
     si:            TStartupInfo;
     szPath:        Array [0..MAX_PATH] of WideChar;
     fProfileLoaded : boolean;
     fProfileInfo : TProfileInfo;

begin

  ZeroMemory(@szPath, SizeOf(szPath));
  ZeroMemory(@pi, SizeOf(pi));
  ZeroMemory(@si, SizeOf(si));
  si.cb:=SizeOf(TStartupInfo);
  showmessage('1');
  if LogonUser(PChar(User), nil, PChar(Password), LOGON32_LOGON_INTERACTIVE, LOGON32_PROVIDER_DEFAULT, hToken) then
  begin
     ZeroMemory (@fProfileInfo, sizeof (fProfileInfo));
     fProfileInfo.dwSize := sizeof (fProfileInfo);
     fProfileInfo.lpUserName := PChar (user);
     fProfileInfo.dwFlags := PI_APPLYPOLICY;
     fprofileLoaded := LoadUserProfile (hToken, fProfileInfo);
     showmessage('1.1');
     if CreateEnvironmentBlock(lpvEnv, hToken, True) then
     begin
        showmessage('2');
        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
              showmessage('3');
              result:=integer(ERROR_SUCCESS);
              showmessage(inttostr(ERROR_SUCCESS));
              WaitForSingleObject(pi.hProcess, INFINITE);
              CloseHandle(pi.hProcess);
              CloseHandle(pi.hThread);
           end
           else
              result:=GetLastError;
        end
        else
           result:=GetLastError;
        DestroyEnvironmentBlock(lpvEnv);
     end
     else
     begin
        result:=GetLastError;
        SysErrorMessage(GetLastError);
        showmessage('GetLastError 1:'+inttostr(result));
     end;
     CloseHandle(hToken);
  end
  else
  begin
     result:=GetLastError;
     SysErrorMessage(GetLastError);
     showmessage('GetLastError 2:'+inttostr(result));
  end;
end;

end.