unit uMain;

interface

uses
  JwaWindows,SvcMgr, SysUtils,
  JwaWinType, JwaWinBase, JwaWinNT, JwaNtSecApi, JwaNTStatus,
  JwaNative, JwaUserEnv, JwaWinSta, JwaWtsApi32, Dialogs, uWinStation;

const
  DNLEN = 15;
  UNLEN = 256;

type
  TAuthInfo = record
    Header: MSV1_0_INTERACTIVE_LOGON;
    Domain: array[0..DNLEN] of WideChar;
    User: array[0..UNLEN] of WideChar;
    Password: array[0..UNLEN] of WideChar;
  end;

type
  TService1 = class(TService)
    procedure ServiceStart(Sender: TService; var Started: Boolean);
  private
    { Private declarations }
  public
    function GetServiceController: TServiceController; override;
    { Public declarations }
  end;

var
  Service1: TService1;

implementation

{$R *.DFM}

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

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

Procedure LsaInitUnicodeString(Var LsaString: TLsaUnicodeString; Const WS:
  WideString);
Begin
  FillChar(LsaString, SizeOf(LsaString), 0);
  If WS <> '' Then
  Begin
    LsaString.Length:=Length(WS) * SizeOf(WideChar);
    LsaString.MaximumLength:=LsaString.Length + SizeOf(WideChar);
    LsaString.Buffer:=PWideChar(WS);
  End;
End;

procedure GetLogonSID(hToken: THandle; var ppsid: PSID);
var dwLength: DWORD;
    ptg : ^TOKEN_GROUPS;
    i : integer;
begin
  dwLength := 0;
  ptg := nil;

  try
    // Get required buffer size and allocate the TOKEN_GROUPS buffer.
    if not GetTokenInformation(hToken, TokenGroups, ptg, 0, dwLength) then
    begin
      if GetLastError <> ERROR_INSUFFICIENT_BUFFER then
      begin
        ShowMessage('GetTokenInformation failed');
        Exit;
      end;

      ptg := HeapAlloc(GetProcessHeap, HEAP_ZERO_MEMORY, dwLength);
      if ptg = nil then
      begin
        Exit;
      end;

      // Get the token group information from the access token.
      if not GetTokenInformation(hToken, TokenGroups, ptg, dwLength, dwLength) then
      begin
        Exit;
      end;

      // Loop through the groups to find the logon SID.
      for i := 0 to ptg.GroupCount-1 do
      begin
       if ptg.Groups[i].Attributes and SE_GROUP_LOGON_ID = SE_GROUP_LOGON_ID then
       begin
         // Found the logon SID; make a copy of it.
         dwLength := GetLengthSid(ptg.Groups[i].Sid);
         ppsid := HeapAlloc(GetProcessHeap, HEAP_ZERO_MEMORY, dwLength);
         if ppsid = nil then
         begin
           Exit;
         end;
         if not CopySid(dwLength, ppsid, ptg.Groups[i].Sid) then
         begin
// raise exception.Create(Format('CopySid: %s', [SysErrorMessage(GetLastError)]));
           HeapFree(GetProcessHeap, 0, ppsid);
           Exit;
         end;

         Break;
        end;
      end;
    end;
  finally
    // Free the buffer for the token groups.
    if ptg <> nil then
    begin
      HeapFree(GetProcessHeap, 0, ptg);
    end;
  end;
end;
procedure TService1.ServiceStart(Sender: TService; var Started: Boolean);
var hToken: THandle;
  si: _STARTUPINFOA;
  pi: _PROCESS_INFORMATION;
  Res: NTSTATUS;
  hLSA: THandle;
  LSAString: _LSA_STRING;
  AuthenticationPackage: ULONG;
  AuthentificationInfo: TAuthInfo;
  pProfileBuffer: Pointer;
  LogonID: JwaWinType.LUID;
  hLsaToken: THandle;
  QuotaLimits: QUOTA_LIMITS;
  SubStatus: Integer;
  wsDomain: WideString;
  wsUser: WideString;
  wsPwd: WideString;
  TokenSource: TOKEN_SOURCE;
  dwReturnLength: ULONG;
  Mode: LSA_OPERATIONAL_MODE;
  pGroups: PTOKEN_GROUPS;
  AdminSid: PSid;
  dwSizeSid: Cardinal;
  dwSizeDomain: Cardinal;
  SidType: TSidNameUse;
  Domain: String;
  MaxGroups: Integer;
  bRes: Longbool;
begin
  ZeroMemory(@si, SizeOf(si));
  si.cb := SizeOf(si);
  si.lpDesktop := nil;

  if WTSQueryUserToken(WtsGetActiveConsoleSessionID, hToken) then
  begin
    RtlInitString(@LsaString, PCSZ(PChar('Winlogon')));
    Res := LsaRegisterLogonProcess(LsaString, hLSA, @Mode);
    if Failed(Res) then
    begin
      ShowMessageFmt('LsaRegisterLogonProcess: %s', [SysErrorMessage(LsaNtStatusToWinError(Res))]);
    end;

    RtlInitString(@LsaString,PCSZ(PChar(MSV1_0_PACKAGE_NAME)));

    Res := LsaLookupAuthenticationPackage(hLSA, LSAString, AuthenticationPackage);
    if Failed(Res) then
    begin
      ShowMessageFmt('LookupAuthPackage: %s', [SysErrorMessage(LsaNtStatusToWinError(Res))]);
    end;

    TokenSource.SourceName := '**ANON**';
    if not AllocateLocallyUniqueId(TokenSource.SourceIdentifier) then
    begin
      ShowMessageFmt('AllocLocUniqueId: %s', [SysErrorMessage(GetLastError)]);
    end;

    // The number of TOKEN_GROUPS we're going to insert
    MaxGroups := 2;

    // Reserve memory for MaxGroups numbur of PTOKEN_GROUPS
    pGroups := PTOKEN_GROUPS(GlobalAlloc(GPTR, sizeof(_SID_AND_ATTRIBUTES) * MaxGroups));
    pGroups^.GroupCount := MaxGroups;

    // Get the Logon Sid and it to the LocalGroups parameter of LsaLogonUser
    // The Logon Sid has the form S-1-5-5-XXXXXXXX-YYYYYYYY
    // We need it to obtain access to the user's desktop
    GetLogonSid(hToken, pGroups^.Groups[0].Sid);
    pGroups^.Groups[0].Attributes := SE_GROUP_MANDATORY or
                                     SE_GROUP_ENABLED or
                                     SE_GROUP_ENABLED_BY_DEFAULT or
                                     SE_GROUP_LOGON_ID;

    // Now get the Administrator's SID
    dwSizeSid := 0;
    dwSizeDomain := 0;
    bRes := LookupAccountName(nil, 'Administrator', nil, dwSizeSid, nil, dwSizeDomain, SidType);

    if (not bRes) and (GetLastError = ERROR_INSUFFICIENT_BUFFER) then
    begin
      // Reserve memory
      AdminSid := AllocMem(dwSizeSid);
      SetLength(Domain, dwSizeDomain);

      // Lookup Sid from Accountname
      // Assuming that the Admin account has not been renamed!
      bRes := LookUpAccountName(nil, 'Administrator', AdminSid, dwSizeSid, PChar(Domain), dwSizeDomain, SidType);
      if not bRes then
      begin
        // Cleanup
        FreeMem(AdminSid);
        AdminSid := nil;
      end;
    end
    else begin
      RaiseLastOSError;
    end;

    ShowMessageFmt('Administrator Sid: %s, Domain: %s', [SidToStr(AdminSid), Domain]);

    // Add the Administrator's sid to pGroups
    pGroups^.Groups[MaxGroups -1].Sid := AdminSid;
    pGroups^.Groups[MaxGroups -1].Attributes := SE_GROUP_MANDATORY or
                                                SE_GROUP_ENABLED or
                                                SE_GROUP_ENABLED_BY_DEFAULT or
                                                SE_GROUP_LOGON_ID;

    // Fill the AuthentificationInfo structure
    // First convert the EDITs to WideString
    wsDomain:= '';
    wsUser:= 'username';
    wsPwd:= 'password';

    // Fill with zeros
    RtlZeroMemory(@AuthentificationInfo, sizeof(AuthentificationInfo));
    AuthentificationInfo.Header.MessageType := MsV1_0InteractiveLogon;
    // AuthentificationInfo.Header.MessageType := MsV1_0NetworkLogon;

    // Copy the strings into a buffer.
    RtlCopyMemory(@AuthentificationInfo.Domain, @wsDomain[1], sizeof(WideChar) * Length(wsDomain));
    RtlCopyMemory(@AuthentificationInfo.User, @wsUser[1], sizeof(WideChar) * Length(wsUser));
    RtlCopyMemory(@AuthentificationInfo.Password, @wsPwd[1], sizeof(WideChar) * Length(wsPwd));

    // Now set which buffer we want to use (the arrays of WideChar from the struct)
    RtlInitUnicodeString(@AuthentificationInfo.Header.LogonDomainName, AuthentificationInfo.Domain);
    RtlInitUnicodeString(@AuthentificationInfo.Header.UserName, AuthentificationInfo.User);
    RtlInitUnicodeString(@AuthentificationInfo.Header.Password, AuthentificationInfo.Password);

    Res := JwaNtSecApi.LsaLogonUser(hLSA,
                                    LsaString,
                                    RemoteInteractive,
                                    AuthenticationPackage,
                                    @AuthentificationInfo,
                                    SizeOf(AuthentificationInfo),
                                    pGroups,
                                    @TokenSource,
                                    pProfileBuffer,
                                    dwReturnLength,
                                    LogonID,
                                    hLSAToken,
                                    QuotaLimits,
                                    SubStatus);

    if Failed(Res) then
    begin
      ShowMessageFmt('LsaLogonUser: %s', [SysErrorMessage(LsaNtStatusToWinError(Res))]);
    end;

    ZeroMemory(@si, SizeOf(si));
    si.cb := SizeOf(si);
    si.lpReserved := nil;
    si.lpDesktop := nil;
    si.dwFlags := STARTF_USESHOWWINDOW;;
    si.wShowWindow := SW_SHOWNORMAL;

    if not CreateProcessAsUser(hLsaToken, nil, PChar('notepad.exe'), nil, nil, False,
                               NORMAL_PRIORITY_CLASS or CREATE_NEW_PROCESS_GROUP,
                               nil, nil, &si, &pi) then
    begin
      ShowMessageFmt('CreateProcessAsUser: %s', [SysErrorMessage(GetLastError)]); end
    else
    begin
    end;

    // Cleanup
    CloseHandle(hToken);
    FreeMem(AdminSid);
    LsaDeregisterLogonProcess(hLSA);
    LsaFreeReturnBuffer(pProfileBuffer);
  end;
  Self.DoStop;


end;

end.