unit SeCrmHeMain;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.SvcMgr, Vcl.Dialogs;

const
  SERVICE_ACCEPT_SESSIONCHANGE = $00000020;
  SERVICE_CONTROL_SESSIONCHANGE = $00000014;

  WTS_SESSION_LOGON = 5;
  WTS_SESSION_LOGOFF = 6;
  WTS_SESSION_LOCK = 7;
  WTS_SESSION_UNLOCK = 8;

  SHTDN_REASON_MAJOR_SOFTWARE = $00030000;
  SHTDN_REASON_MINOR_OTHER = $00000000;

type
  TSvcCrmHe = class(TService)
    procedure ServicePause(Sender: TService; var Paused: Boolean);
    procedure ServiceStop(Sender: TService; var Stopped: Boolean);
    procedure ServiceExecute(Sender: TService);
  private
    { Private declarations }
  public
    function GetServiceController: TServiceController; override;
    { Public declarations }
  end;

function CreateEnvironmentBlock(var lpEnvironment: Pointer;
                              hToken: THandle;
                              bInherit: BOOL): BOOL; stdcall; external 'userenv.dll';

var
  SvcCrmHe: TSvcCrmHe;

implementation

uses
//{$IFDEF DEBUG}
//  Tocsg.Trace,
//{$ENDIF}
  Tocsg.Trace,Tocsg.Win32, GlobalDefine, Tocsg.Path, Tocsg.Process, Tocsg.Safe, Tocsg.WTS,
  Tocsg.Kernel32, Tocsg.Shell, Tocsg.Service, Winapi.WinSvc, Tocsg.Registry;

{$R *.dfm}

function _ExecuteAppAsUser(dwFollowPID: DWORD; sPath, sParam: String; dwVisible: DWORD): TProcessInformation;
type
  TOKEN_MANDATORY_LABEL = record
      Label_: SID_AND_ATTRIBUTES;
    end;
const
 DEFWINSTATION = 'WinSta0';

 DEFDESKTOP = 'Default';
 WINLOGON = 'Winlogon';
 SCREENSAVER = 'Screen-Saver';

 WHITESPACE = ' '{SPACE}+chr(9){TAB}+chr(10){LF};
 DOMUSERSEP = '\';
var
  StartupInfo: TStartupInfo;
  ProcessInfo: TProcessInformation;
  dwCreateFlag: DWORD;
  pEnvBlock: Pointer;
  hProc, hToken, hNewToken: THandle;
  TIL: TOKEN_MANDATORY_LABEL;
begin
  ZeroMemory(@Result, SizeOf(Result));
  ZeroMemory(@ProcessInfo, SizeOf(TProcessInformation));
  ZeroMemory(@TIL, SizeOf(TIL));

  hToken := 0;
  hNewToken := 0;

  if dwFollowPID = 0 then
  begin
    {$IFDEF DEBUG} TTgTrace.T('_ExecuteAppAsUser() .. FollowPID is null..'); {$ENDIF}
    exit;
  end;

//  hProc := OpenProcess(PROCESS_ALL_ACCESS, false, dwFollowPID);
  hProc := OpenProcess(MAXIMUM_ALLOWED, false, dwFollowPID);
  if hProc = 0 then
  begin
    {$IFDEF DEBUG} TTgTrace.T('_ExecuteAppAsUser() .. OpenProcess() - Fail... Error=%d', [GetLastError]); {$ENDIF}
    exit;
  end;

  try
//    if OpenProcessToken(hProc, TOKEN_ASSIGN_PRIMARY or TOKEN_DUPLICATE, hToken) then
    if OpenProcessToken(hProc, MAXIMUM_ALLOWED, hToken) then
    begin
//      if DuplicateTokenEx(hToken, TOKEN_ASSIGN_PRIMARY or TOKEN_ALL_ACCESS, nil,
      if DuplicateTokenEx(hToken, MAXIMUM_ALLOWED, nil,
              SecurityImpersonation, TokenPrimary, hNewToken) then
      begin
        ZeroMemory(@StartupInfo, SizeOf(StartupInfo));
        StartupInfo.cb := Sizeof(StartupInfo);
        StartupInfo.lpDesktop := DEFWINSTATION + '\' + DEFDESKTOP;
  //      StartupInfo.dwFlags := STARTF_USESHOWWINDOW or STARTF_USEPOSITION; // SW_HIDEµîÀ» Àû¿ë ½ÃÅ°·Á¸é ÀÌ°É È°¼ºÈ­ ½ÃÄÑÁà¾ß ÇÑ´Ù (¿ë¼º ãÀ½) 15_0521 sunk
        StartupInfo.wShowWindow := dwVisible;

        dwCreateFlag := NORMAL_PRIORITY_CLASS or CREATE_NEW_CONSOLE;

        pEnvBlock := nil;
        CreateEnvironmentBlock(pEnvBlock, hNewToken, true);
        if pEnvBlock <> nil then
          dwCreateFlag := dwCreateFlag or CREATE_UNICODE_ENVIRONMENT;

        if CreateProcessAsUserW(hNewToken,
                                nil,//PWideChar(ExtractFileName(sPath)),
                                PWideChar(Format('"%s" %s', [sPath, sParam])),
                                nil,
                                nil,
                                false,
                                dwCreateFlag,
                                pEnvBlock,
                                nil,//PWideChar(ExtractFilePath(sPath)),
                                StartupInfo,
                                ProcessInfo) then
        begin
          Result := ProcessInfo;
        end else
          {$IFDEF DEBUG} TTgTrace.T('_ExecuteAppAsUser() .. CreateProcessAsUserW() - Fail... Error=%d', [GetLastError]); {$ENDIF}
      end;
    end else
      {$IFDEF DEBUG} TTgTrace.T('_ExecuteAppAsUser() .. OpenProcessToken() - Fail... Error=%d', [GetLastError]); {$ENDIF}
  finally
    if hToken <> 0 then
      CLoseHandle(hToken);
    if hNewToken <> 0 then
      CloseHandle(hNewToken);
    if hProc <> 0 then
      CloseHandle(hProc);
  end;
end;


procedure ForceRebootSystem;
var
  hToken: THandle;
  tkp: TTokenPrivileges;
  ReturnLength: DWORD;
begin
  // 1. ÇöÀç ÇÁ·Î¼¼½ºÀÇ ÅäÅ«À» ¿­¾î ±ÇÇÑ Á¶Á¤ Áغñ
  if OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken) then
  begin
    // 2. Á¾·á ±ÇÇÑ(SeShutdownPrivilege)ÀÇ LUID ȹµæ
    LookupPrivilegeValue(nil, 'SeShutdownPrivilege', tkp.Privileges[0].Luid);
    tkp.PrivilegeCount := 1;
    tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;

    // 3. ÅäÅ«¿¡ ±ÇÇÑ Àû¿ë
    AdjustTokenPrivileges(hToken, False, tkp, 0, nil, ReturnLength);
    CloseHandle(hToken);
  end;

  // 4. °­Á¦ ÀçºÎÆà ½ÇÇà (EWX_FORCE ¿É¼ÇÀ¸·Î ¿­·ÁÀÖ´Â ÇÁ·Î±×·¥ ¹«½ÃÇÏ°í ÀçºÎÆÃ)
  ExitWindowsEx(EWX_REBOOT or EWX_FORCE, SHTDN_REASON_MAJOR_SOFTWARE or SHTDN_REASON_MINOR_OTHER);
end;

procedure ServiceController(CtrlCode: DWord); stdcall;
begin
  SvcCrmHe.Controller(CtrlCode);
end;

function TSvcCrmHe.GetServiceController: TServiceController;
begin
  Result := ServiceController;
end;


procedure TSvcCrmHe.ServiceExecute(Sender: TService);
var
  sAPath,
  sWPath,
  sCurDir,
  sRunParam,
  sRunAsModule: String;
  bExeBeforeSleep: Boolean;
  dwExeTerm: DWORD;
//  bFailExeTrust: Boolean;
  nFailExeTrustCnt: Integer;
  processInfo: TProcessInformation;

  function ExecuteAgent(dwOwnerPid: DWORD): THandle;//Boolean;
  var
    t: Integer;
    sTrustedInstExe: String;
  begin
    Result := 0;

    if FileExists(sWPath) then
    begin
      dwExeTerm := GetTickCount;
      if not DeleteFile(sWPath) then
      begin
        SetFileAttributes(PChar(sWPath), FILE_ATTRIBUTE_NORMAL);
        DeleteFile(sWPath);
      end;
      exit;
    end else
    if dwExeTerm <> 0 then
    begin
      if (GetTickCount - dwExeTerm) < 10000 then
        exit;
      dwExeTerm := 0;
    end;

    if bExeBeforeSleep then
    begin
      bExeBeforeSleep := false;
      Sleep(3000);
    end;

    sTrustedInstExe := sCurDir + DIR_CONF + EXE_TRUST;
  // cmd âÀÌ ³ª¿Ô´Ù »ç¶óÁö´Â HEC¿¡¼­ Á¦°Å¿äûÇÔ 23_1208 13:56:30 kku
    if (nFailExeTrustCnt < 3) and FileExists(sTrustedInstExe) then
    begin
//      -U:[ Option ] Create a process with specified user option.
//      Available options:
//          T TrustedInstaller
//          S System
//          C Current User
//          E Current User (Elevated)
//          P Current Process
//          D Current Process (Drop right)
//      PS: This is a mandatory parameter.
    // -UseCurrentConsole - X ¾Æ¹«·¡µµ cmd·Î ½ÇÇà ½ÃÄÑ¾ß ¸ÔÀ»°Å °°Áö¸¸ ÆĶó¸ÞÅÍ°¡ ³Ê¹« ±æ¾îÁü.

      Inc(nFailExeTrustCnt);

      sRunParam := UpperCase(GetRegValueAsString(HKEY_LOCAL_MACHINE, 'SYSTEM\ControlSet001\Services\SvcCrmHe', 'EA'));
      if sRunParam = 'ADMIN' then
        sRunParam := Format('-U:E -P:E "%s"', [sAPath])
      else if sRunParam = 'USER' then
        sRunParam := Format('-U:C -P:E "%s"', [sAPath])
      else
        sRunParam := Format('-U:T -P:E "%s"', [sAPath]);
      ExecutePath_hide(sTrustedInstExe, sRunParam);
//      ExecutePath_hide(sTrustedInstExe, Format('-U:E -P:E "%s"', [sAPath]));
//      t := 0;
//      while t < 10 do
//      begin
//        if MutexExists(MUTEX_AGENT) then
//        begin
//          nFailExeTrustCnt := 0;
//          Result := true;
//          exit;
//        end;
//
//        Sleep(500);
//        Inc(t);
//      end;

//      if _ExecuteAppAsUser(dwOwnerPid, sTrustedInstExe, Format('-U:T -P:E "%s"', [sAPath]), SW_HIDE).dwProcessId <> 0 then
//      begin
//        {$IFDEF DEBUG} TTgTrace.T('ServiceExecute() .. No Agent Mutext .. RunAsModule=%s .. Success!!', [sRunAsModule]); {$ENDIF}
//        Sleep(2000);
//      end else begin
//        {$IFDEF DEBUG} TTgTrace.T('ServiceExecute() .. No Agent Mutext .. RunAsModule=%s .. Fail..... _ExecuteAppAsUser()', [sRunAsModule]); {$ENDIF}
//        bFailExeTrust := true;
//      end;
    end else
    begin
  //    if _ExecuteAppAsUser(dwOwnerPid, sAPath, Format('/wlid %d', [dwOwnerPid]), SW_HIDE).dwProcessId <> 0 then

  //    if ExecuteApp(sAPath, '', SW_SHOWNORMAL).dwProcessId <> 0 then // Æ®·¹ÀÌ ¾È³ª¿È
      processInfo:= _ExecuteAppAsUser(dwOwnerPid, sAPath, '', SW_SHOWNORMAL);
      if processInfo.dwProcessId <> 0 then
      begin
//        t := 0;
//        while t < 10 do
//        begin
//          if MutexExists(MUTEX_AGENT) then
//          begin
//            nFailExeTrustCnt := 0;
//            Result := true;
//            exit;
//          end;
//
//          Sleep(500);
//          Inc(t);
//        end;
        Result:= processInfo.hProcess;
        CloseHandle(processInfo.hThread);
//        if Result then
//        begin
//          {$IFDEF DEBUG} TTgTrace.T('ServiceExecute() .. No Agent Mutext .. RunAsModule=%s .. Success!!', [sRunAsModule]); {$ENDIF}
//          Sleep(2000);
//        end;
      end else begin
        {$IFDEF DEBUG} TTgTrace.T('ServiceExecute() .. No Agent Mutext .. RunAsModule=%s .. Fail..... _ExecuteAppAsUser()', [sRunAsModule]); {$ENDIF}
      end;
    end;

//    t := 0;
//    while t < 6 do
//    begin
//      if MutexExists(MUTEX_AGENT) then
//      begin
//        Result := true;
//        exit;
//      end;
//
//      Sleep(500);
//      Inc(t);
//    end;

    {$IFDEF DEBUG} TTgTrace.T('ServiceExecute() .. No Agent Mutex .. check timeover .. '); {$ENDIF}
  end;

var
  PIDList: TProcessIdList;
  WTSInfo: TTgWTSSessionInfomation;
  dwWinLogonSsId,
  dwExecuteAsPid: DWORD;
  sAccount: String;
  i: Integer;
  Mtx: TTgMutex;
  processHandle: THandle;
  WaitHandles: array[0..1] of THandle;
  WaitResult: DWORD;

begin
//  bFailExeTrust := false;
  nFailExeTrustCnt := 0;
  dwExeTerm := 0;
  bExeBeforeSleep := false;
  Mtx := nil;
  if not MutexExists(MUTEX_SERVICE) then
  begin
    Mtx := TTgMutex.Create(MUTEX_SERVICE);
    if Mtx.MutexState <> msCreateOk then
      exit;
  end;

  {$IFDEF DEBUG} TTgTrace.T('ServiceExecute() .. Begin'); {$ENDIF}

  Guard(WTSInfo, TTgWTSSessionInfomation.Create);
  Guard(PIDList, TProcessIdList.Create);
  sCurDir := GetRunExePathDir;
  sAPath := sCurDir + EXE_HE;
  if not FileExists(sAPath) then
  begin
    sCurDir := GetProgramFilesDir + DIR_HE;
    sAPath := sCurDir + EXE_HE;
  end;
  {$IFDEF DEBUG} TTgTrace.T('APath="%s"', [sAPath]); {$ENDIF}
  sWPath := ExtractFilePath(sAPath) + BYE_ENDSESSION;

  try
    while not Terminated do
    begin
      if MutexExists(MUTEX_KILL) then
      begin
        {$IFDEF DEBUG} TTgTrace.T('Found .. MUTEX_KILL!!'); {$ENDIF}
        ServiceThread.Terminate;
        exit;
      end;

      if FileExists(sAPath) then
      begin
          if not MutexExists(MUTEX_AGENT) then
          begin
            {$IFDEF DEBUG} TTgTrace.T('ServiceExecute() .. No Agent Mutext'); {$ENDIF}

//            if LoadWinlogonPidInfo then
//              continue;

          // explorer.exe ½ÇÇàÀü¿¡ ÇÁ·Î±×·¥ ½ÇÇàÇϸé Æ®·¹ÀÌ°¡ ¾È»ý°Ü¼­
          // ½ÇÇàµÈ°Å È®ÀÎÇÏ°í ½ÃµµÇÑ´Ù 22_0502 14:21:30 kku
            if GetProcessPidByName('explorer.exe') <> 0 then
            begin
              dwExecuteAsPid := 0;
              case GetProcessPidsByName('winlogon.exe', PIDList)  of
                0 : sRunAsModule := 'explorer.exe';
                1 : sRunAsModule := 'winlogon.exe';
                else
                begin
                  sRunAsModule := 'winlogon.exe';

                  WTSInfo.UpdateSessionInfo;
                  for i := 0 to PIDList.Count - 1 do
                    if ProcessIdToSessionId(PIDList[i], dwWinLogonSsId) then
                    begin
                      sAccount := WTSInfo.GetUserNameBySsid(dwWinLogonSsId);
                      if (sAccount <> '') and
                         (UpperCase(sAccount) <> 'SYSTEM') and
                         (UpperCase(sAccount) <> 'CONSOLE') then
                      begin
                        dwExecuteAsPid := PIDList[i];
                        break;
                      end;
                    end;
                end;
              end;

              {$IFDEF DEBUG} TTgTrace.T('ServiceExecute() .. No Agent Mutext .. RunAsModule=%s', [sRunAsModule]); {$ENDIF}

//              dwExecuteAsPid := GetProcessPidByName('TrustedInstaller.exe');

              if dwExecuteAsPid = 0 then
                dwExecuteAsPid := GetProcessPidByName(sRunAsModule);

              {$IFDEF DEBUG} TTgTrace.T(Format('ServiceExecute() .. dwExecuteAsPid : %d',[DWORD(dwExecuteAsPid)])); {$ENDIF}

              if dwExecuteAsPid <> 0 then
                processHandle:= ExecuteAgent(dwExecuteAsPid);
            end else
              bExeBeforeSleep := true;
          end
          else
          begin
            var pid: DWORD;
            pid:= GetProcessPidByName(sAPath);
            if pid <> 0 then
            begin
              var hProc := OpenProcess(PROCESS_ALL_ACCESS, false, pid);
              if hProc = 0 then
              begin
                {$IFDEF DEBUG} TTgTrace.T('ExecuteAgent() .. OpenProcess() - Fail... Error=%d, sAPath:%s', [GetLastError, sAPath]); {$ENDIF}
              end
              else
              begin
                {$IFDEF DEBUG} TTgTrace.T('ExecuteAgent() .. OpenProcess() - ok... '); {$ENDIF}
                processHandle:= hProc;
              end;
            end;
          end;
      end;

      {$IFDEF DEBUG} TTgTrace.T(Format('ServiceExecute() .. processHandle : %p',[Pointer(processHandle)])); {$ENDIF}
      if processHandle <> 0 then
      begin
        WaitHandles[0] := ServiceThread.Handle;
        WaitHandles[1] := processHandle;

        WaitResult := WaitForMultipleObjects(2, @WaitHandles, False, INFINITE);
        if WaitResult = WAIT_OBJECT_0 then
        begin


        //WaitForSingleObject(ServiceThread.Handle, 500);
  //      Sleep(500);
          ServiceThread.ProcessRequests(false);
        end
        else if WaitResult = WAIT_OBJECT_0 + 1 then
        begin
          var ExitCode: DWORD;
          if GetExitCodeProcess(processHandle, ExitCode) then
          begin
          if ExitCode = 0 then
          begin
            // [»óȲ A] Á¤»óÀûÀ¸·Î ½º½º·Î Á¾·áµÊ
            // Àç½ÇÇàÇÏÁö ¾Ê°í ·çÇÁ¸¦ ³¡³»°Å³ª ´ë±âÇÒ ¼ö ÀÖ½À´Ï´Ù.

          end
          else if ExitCode = 1 then
          begin
            // [»óȲ B] ´©±º°¡ °­Á¦ Á¾·á(1)Ç߰ųª Å©·¡½Ã(ºñÁ¤»ó ÄÚµå)·Î Á×À½
            // °­Á¦ Á¾·á·Î °£ÁÖÇÏ°í Áï½Ã Àç½ÇÇà ¶Ç´Â ½Ã½ºÅÛ ÀçºÎÆÃ!
             ForceRebootSystem;
          end;

            Sleep(3000);

            {$IFDEF DEBUG} TTgTrace.T(Format('ServiceExecute() .. Terminate Process ExitCode : %x',[ExitCode])); {$ENDIF}
            CloseHandle(ProcessInfo.hProcess);
            processHandle := 0;
          end;
        end;
      end
      else
      begin
        WaitForSingleObject(ServiceThread.Handle, 500);
        ServiceThread.ProcessRequests(false);
  //        bRunLoop := False;
      end;
  end;
  finally
    {$IFDEF DEBUG} TTgTrace.T('ServiceExecute() .. End'); {$ENDIF}
    if Assigned(PIDList) then FreeAndNil(PIDList);
    if Assigned(WTSInfo) then FreeAndNil(WTSInfo);
    if Mtx <> nil then
      FreeAndNil(Mtx);

    if processHandle <> 0 then
      CloseHandle(processHandle);
  end;
end;

procedure TSvcCrmHe.ServicePause(Sender: TService; var Paused: Boolean);
begin
{$IFDEF DEBUG}
  Paused := true;
{$ELSE}
  Paused := MutexExists(MUTEX_KILL);
{$ENDIF}
end;

procedure TSvcCrmHe.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
{$IFDEF DEBUG}
  Stopped := true;
{$ELSE}
  Stopped := MutexExists(MUTEX_KILL);
{$ENDIF}
end;

end.