{*******************************************************}
{                                                       }
{       Tocsg.WTS                                       }
{                                                       }
{       Copyright (C) 2022 sunk                         }
{                                                       }
{*******************************************************}

unit Tocsg.WTS;

interface

uses
  WinApi.Windows, SysUtils, Generics.Collections, Winapi.Wtsapi32;
//{$IF CompilerVersion >= 37.0}
//  Winapi.Wtsapi32
//{$ELSE}
//  EM.Wtsapi32
//{$IFEND}
//  ;

const
  NEAR_SUCCESS = 0;

type
  PWTSSessionEntryInfo = ^TWTSSessionEntryInfo;
  TWTSSessionEntryInfo = record
    dwSessionId: DWORD;
    sWinStationName: String;
  end;

  TTgWTSSessionInfomation = class(TObject)
  protected
    lstSessionID_: TList<PWTSSessionEntryInfo>;

    procedure OnSessionInfo(Sender: TObject; const Item: PWTSSessionEntryInfo;
                    Action: TCollectionNotification);
    function GetCount: Integer;
    function GetUserNameByIndex(nIndex: Integer): String;
    function GetSessionIdByIndex(nIndex: Integer): DWORD;
  public
    Constructor Create;
    Destructor Destroy; override;

    procedure UpdateSessionInfo;

    function GetUserNameBySsid(const dwSsid: DWORD): String;

    property Count: Integer read GetCount;
    property SessionIDs[nIndex: Integer]: DWORD read GetSessionIdByIndex;
    property UserNames[nIndex: Integer]: String read GetUserNameByIndex;
  end;

const
  UF_SCRIPT                          = $0001;
  {$EXTERNALSYM UF_SCRIPT}
  UF_ACCOUNTDISABLE                  = $0002;
  {$EXTERNALSYM UF_ACCOUNTDISABLE}
  UF_HOMEDIR_REQUIRED                = $0008;
  {$EXTERNALSYM UF_HOMEDIR_REQUIRED}
  UF_LOCKOUT                         = $0010;
  {$EXTERNALSYM UF_LOCKOUT}
  UF_PASSWD_NOTREQD                  = $0020;
  {$EXTERNALSYM UF_PASSWD_NOTREQD}
  UF_PASSWD_CANT_CHANGE              = $0040;
  {$EXTERNALSYM UF_PASSWD_CANT_CHANGE}
  UF_ENCRYPTED_TEXT_PASSWORD_ALLOWED = $0080;
  {$EXTERNALSYM UF_ENCRYPTED_TEXT_PASSWORD_ALLOWED}

//
// Account type bits as part of usri_flags.
//

  UF_TEMP_DUPLICATE_ACCOUNT    = $0100;
  {$EXTERNALSYM UF_TEMP_DUPLICATE_ACCOUNT}
  UF_NORMAL_ACCOUNT            = $0200;
  {$EXTERNALSYM UF_NORMAL_ACCOUNT}
  UF_INTERDOMAIN_TRUST_ACCOUNT = $0800;
  {$EXTERNALSYM UF_INTERDOMAIN_TRUST_ACCOUNT}
  UF_WORKSTATION_TRUST_ACCOUNT = $1000;
  {$EXTERNALSYM UF_WORKSTATION_TRUST_ACCOUNT}
  UF_SERVER_TRUST_ACCOUNT      = $2000;
  {$EXTERNALSYM UF_SERVER_TRUST_ACCOUNT}

  UF_MACHINE_ACCOUNT_MASK = UF_INTERDOMAIN_TRUST_ACCOUNT or UF_WORKSTATION_TRUST_ACCOUNT or UF_SERVER_TRUST_ACCOUNT;
  {$EXTERNALSYM UF_MACHINE_ACCOUNT_MASK}

  UF_ACCOUNT_TYPE_MASK = UF_TEMP_DUPLICATE_ACCOUNT or UF_NORMAL_ACCOUNT or UF_INTERDOMAIN_TRUST_ACCOUNT or UF_WORKSTATION_TRUST_ACCOUNT or UF_SERVER_TRUST_ACCOUNT;
  {$EXTERNALSYM UF_ACCOUNT_TYPE_MASK}

  UF_DONT_EXPIRE_PASSWD                     = $10000;
  {$EXTERNALSYM UF_DONT_EXPIRE_PASSWD}
  UF_MNS_LOGON_ACCOUNT                      = $20000;
  {$EXTERNALSYM UF_MNS_LOGON_ACCOUNT}
  UF_SMARTCARD_REQUIRED                     = $40000;
  {$EXTERNALSYM UF_SMARTCARD_REQUIRED}
  UF_TRUSTED_FOR_DELEGATION                 = $80000;
  {$EXTERNALSYM UF_TRUSTED_FOR_DELEGATION}
  UF_NOT_DELEGATED                          = $100000;
  {$EXTERNALSYM UF_NOT_DELEGATED}
  UF_USE_DES_KEY_ONLY                       = $200000;
  {$EXTERNALSYM UF_USE_DES_KEY_ONLY}
  UF_DONT_REQUIRE_PREAUTH                   = $400000;
  {$EXTERNALSYM UF_DONT_REQUIRE_PREAUTH}
  UF_PASSWORD_EXPIRED                       = DWORD($800000);
  {$EXTERNALSYM UF_PASSWORD_EXPIRED}
  UF_TRUSTED_TO_AUTHENTICATE_FOR_DELEGATION = $1000000;
  {$EXTERNALSYM UF_TRUSTED_TO_AUTHENTICATE_FOR_DELEGATION}

  UF_SETTABLE_BITS =
                    UF_SCRIPT or
                    UF_ACCOUNTDISABLE or
                    UF_LOCKOUT or
                    UF_HOMEDIR_REQUIRED or
                    UF_PASSWD_NOTREQD or
                    UF_PASSWD_CANT_CHANGE or
                    UF_ACCOUNT_TYPE_MASK or
                    UF_DONT_EXPIRE_PASSWD or
                    UF_MNS_LOGON_ACCOUNT or
                    UF_ENCRYPTED_TEXT_PASSWORD_ALLOWED or
                    UF_SMARTCARD_REQUIRED or
                    UF_TRUSTED_FOR_DELEGATION or
                    UF_NOT_DELEGATED or
                    UF_USE_DES_KEY_ONLY or
                    UF_DONT_REQUIRE_PREAUTH or
                    UF_PASSWORD_EXPIRED or
                    UF_TRUSTED_TO_AUTHENTICATE_FOR_DELEGATION;
  {$EXTERNALSYM UF_SETTABLE_BITS}

  ENCRYPTED_PWLEN = 16;

type
  _USER_INFO_1 = record
    usri1_name: LPWSTR;
    usri1_password: LPWSTR;
    usri1_password_age: DWORD;
    usri1_priv: DWORD;
    usri1_home_dir: LPWSTR;
    usri1_comment: LPWSTR;
    usri1_flags: DWORD;
    usri1_script_path: LPWSTR;
  end;
  {$EXTERNALSYM _USER_INFO_1}
  USER_INFO_1 = _USER_INFO_1;
  {$EXTERNALSYM USER_INFO_1}
  TUserInfo1 = USER_INFO_1;
  PUserInfo1 = ^TUserInfo1;

  _USER_INFO_2 = record
    usri2_name: LPWSTR;
    usri2_password: LPWSTR;
    usri2_password_age: DWORD;
    usri2_priv: DWORD;
    usri2_home_dir: LPWSTR;
    usri2_comment: LPWSTR;
    usri2_flags: DWORD;
    usri2_script_path: LPWSTR;
    usri2_auth_flags: DWORD;
    usri2_full_name: LPWSTR;
    usri2_usr_comment: LPWSTR;
    usri2_parms: LPWSTR;
    usri2_workstations: LPWSTR;
    usri2_last_logon: DWORD;
    usri2_last_logoff: DWORD;
    usri2_acct_expires: DWORD;
    usri2_max_storage: DWORD;
    usri2_units_per_week: DWORD;
    usri2_logon_hours: PBYTE;
    usri2_bad_pw_count: DWORD;
    usri2_num_logons: DWORD;
    usri2_logon_server: LPWSTR;
    usri2_country_code: DWORD;
    usri2_code_page: DWORD;
  end;
  {$EXTERNALSYM _USER_INFO_2}
  USER_INFO_2 = _USER_INFO_2;
  {$EXTERNALSYM USER_INFO_2}
  TUserInfo2 = USER_INFO_2;
  PUserInfo2 = ^TUserInfo2;

  _USER_INFO_22 = record
    usri22_name: LPWSTR;
    usri22_password: array [0..ENCRYPTED_PWLEN - 1] of BYTE;
    usri22_password_age: DWORD;
    usri22_priv: DWORD;
    usri22_home_dir: LPWSTR;
    usri22_comment: LPWSTR;
    usri22_flags: DWORD;
    usri22_script_path: LPWSTR;
    usri22_auth_flags: DWORD;
    usri22_full_name: LPWSTR;
    usri22_usr_comment: LPWSTR;
    usri22_parms: LPWSTR;
    usri22_workstations: LPWSTR;
    usri22_last_logon: DWORD;
    usri22_last_logoff: DWORD;
    usri22_acct_expires: DWORD;
    usri22_max_storage: DWORD;
    usri22_units_per_week: DWORD;
    usri22_logon_hours: PBYTE;
    usri22_bad_pw_count: DWORD;
    usri22_num_logons: DWORD;
    usri22_logon_server: LPWSTR;
    usri22_country_code: DWORD;
    usri22_code_page: DWORD;
  end;
  {$EXTERNALSYM _USER_INFO_22}
  USER_INFO_22 = _USER_INFO_22;
  {$EXTERNALSYM USER_INFO_22}
  TUserInfo22 = USER_INFO_22;
  PUserInfo22 = ^TUserInfo22;

// 사용자 계정에 띄어쓰기가 있는경우...
// WTSQuerySessionInformation()만으로는 풀네임을 구해올수 없다. 그래서 추가
  PUserInfo23 = ^TUserInfo23;
  _USER_INFO_23 = record
    usri23_name: LPWSTR;
    usri23_full_name: LPWSTR;
    usri23_comment: LPWSTR;
    usri23_flags: DWORD;
    usri23_user_sid: PSID;
  end;
  {$EXTERNALSYM _USER_INFO_23}
  TUserInfo23 = _USER_INFO_23;
  USER_INFO_23 = _USER_INFO_23;
  {$EXTERNALSYM USER_INFO_23}

  TNetUserGetInfo = function(sServerName: PChar; sUserName: PChar; dwLevel: DWORD; var pBuf: Pointer): DWORD; stdcall;
  TNetApiBufferFree = function(pBuf: Pointer): Integer; stdcall;
  TNetUserChangePassword = function(sServerName, sUserName, sOldPass, sNewPass: PChar): DWORD; stdcall;

function NetUserGetInfo(sServerName: PChar; sUserName: PChar; dwLevel: DWORD; var pBuf: Pointer): DWORD;
function NetApiBufferFree(pBuf : Pointer) :Integer;

function NetUserChangePassword(sServerName, sUserName, sOldPass, sNewPass: String): DWORD;

function GetLastChangePasswordDT(sServerName, sUserName: String): TDateTime;
function GetLastLogOnDT(sServerName, sUserName: String): TDateTime;
function GetLastLogOnDTandBadCnt(sServerName, sUserName: String; var dtLastLogOn: TDateTime; var nBadCnt: Integer): Boolean;
function HasAccountPassword(sServerName, sUserName: String): Boolean;

function WTSGetActiveConsoleSessionId: DWORD; stdcall external 'Kernel32.dll';
function WTS_GetString(dwSessionID: DWORD; const aWTSInfoClass: WTS_INFO_CLASS): String;
function WTS_GetDWORD(dwSessionID: DWORD; const aWTSInfoClass: WTS_INFO_CLASS): DWORD;
function WTS_GetUserNameFromSessionID(dwSessionID: DWORD): String;
function WTS_GetCurrentUserName: String;
function WTS_GetActiveSessionUserName: String;
function WTS_GetActiveUserProfilePath: String;

implementation

uses
  Tocsg.Exception, System.DateUtils, Tocsg.DateTime, Winapi.UserEnv;

var
  _hNetApi32: THandle = 0;
  _fnNetUserGetInfo: TNetUserGetInfo = nil;
  _fnNetApiBufferFree: TNetApiBufferFree = nil;
  _fnNetUserChangePassword: TNetUserChangePassword = nil;

function InitNetApi32Procedure: Boolean;
begin
  if _hNetApi32 = 0 then
  begin
//    _hNetApi32 := GetModuleHandle('netapi32.dll');
    _hNetApi32 := LoadLibrary('netapi32.dll');
    if _hNetApi32 <> 0 then
    begin
      @_fnNetUserGetInfo := GetProcAddress(_hNetApi32, 'NetUserGetInfo');
      @_fnNetApiBufferFree := GetProcAddress(_hNetApi32, 'NetApiBufferFree');
      @_fnNetUserChangePassword := GetProcAddress(_hNetApi32, 'NetUserChangePassword');
    end;
  end;
  Result := _hNetApi32 <> 0;
end;

function NetUserGetInfo(sServerName, sUserName: PChar; dwLevel: DWORD; var pBuf: Pointer): DWORD;
begin
  Result := DWORD(-1);
  if InitNetApi32Procedure and Assigned(_fnNetUserGetInfo) then
    Result := _fnNetUserGetInfo(sServerName, sUserName, dwLevel, pBuf);
end;

function NetApiBufferFree(pBuf: Pointer) :Integer;
begin
  Result := -1;
  if InitNetApi32Procedure and Assigned(_fnNetUserGetInfo) then
    Result := _fnNetApiBufferFree(pBuf);
end;

function NetUserChangePassword(sServerName, sUserName, sOldPass, sNewPass: String): DWORD;
begin
  Result := DWORD(-1);
  if InitNetApi32Procedure and Assigned(_fnNetUserChangePassword) then
    Result := _fnNetUserChangePassword(PChar(sServerName), PChar(sUserName), PChar(sOldPass), PChar(sNewPass));
end;

function GetLastChangePasswordDT(sServerName, sUserName: String): TDateTime;
var
  pInfo: PUserInfo1;
begin
  Result := 0;
  try
    pInfo := nil;
    if NetUserGetInfo(PChar(sServerName), PChar(sUserName), 1, Pointer(pInfo)) = 0 then
    begin
      Result := IncSecond(Now, pInfo.usri1_password_age * -1);
      NetApiBufferFree(pInfo);
    end;
  except
    on E: Exception do
      ETgException.TraceException(E, 'Fail .. GetLastChangePasswordDT()');
  end;
end;

function GetLastLogOnDT(sServerName, sUserName: String): TDateTime;
var
  pInfo: PUserInfo2;
begin
  Result := 0;
  try
    pInfo := nil;
    if NetUserGetInfo(PChar(sServerName), PChar(sUserName), 2, Pointer(pInfo)) = 0 then
    begin
      Result := ConvTimeToDateTime(pInfo.usri2_last_logon);
      NetApiBufferFree(pInfo);
    end;
  except
    on E: Exception do
      ETgException.TraceException(E, 'Fail .. GetLastLogOnDT()');
  end;
end;

function GetLastLogOnDTandBadCnt(sServerName, sUserName: String; var dtLastLogOn: TDateTime; var nBadCnt: Integer): Boolean;
var
  pInfo: PUserInfo2;
begin
  Result := false;
  dtLastLogOn := 0;
  nBadCnt := 0;
  try
    pInfo := nil;
    if NetUserGetInfo(PChar(sServerName), PChar(sUserName), 2, Pointer(pInfo)) = 0 then
    begin
      dtLastLogOn := ConvTimeToDateTime(pInfo.usri2_last_logon);
      nBadCnt := pInfo.usri2_bad_pw_count;
      NetApiBufferFree(pInfo);
      Result := true;
    end;
  except
    on E: Exception do
      ETgException.TraceException(E, 'Fail .. GetLastLogOnDTandBadCnt()');
  end;
end;

// 임계치 초과 시 계정이 잠긴다 24_0109 13:00:48 kku
function HasAccountPassword(sServerName, sUserName: String): Boolean;
var
  bRet: Boolean;
  hToken: THandle;
begin
  try
    bRet := LogonUser(PChar(sUserName), PChar(sServerName), '',
                                LOGON32_LOGON_INTERACTIVE, LOGON32_PROVIDER_DEFAULT, hToken);
    Result := not bRet and (GetLastError <> 1327);

  // 음 이걸로 체크하면 false 시 최근 비번 설정일이 변경된다...
//    Result := NetUserChangePassword(sServerName, sUserName, '', '') = 86;
  except
    on E: Exception do
      ETgException.TraceException(E, 'Fail .. HasAccountPassword()');
  end;
end;

{ TTgWTSSessionInfomation }

Constructor TTgWTSSessionInfomation.Create;
begin
  Inherited Create;
  lstSessionID_ := TList<PWTSSessionEntryInfo>.Create;
  lstSessionID_.OnNotify := OnSessionInfo;
  UpdateSessionInfo;
end;

Destructor TTgWTSSessionInfomation.Destroy;
begin
  FreeAndNil(lstSessionID_);
  Inherited;
end;

procedure TTgWTSSessionInfomation.OnSessionInfo(Sender: TObject; const Item: PWTSSessionEntryInfo;
                Action: TCollectionNotification);
begin
  case Action of
    cnAdded: ;
    cnRemoved: Dispose(Item);
    cnExtracted: ;
  end;
end;

function TTgWTSSessionInfomation.GetUserNameByIndex(nIndex: Integer): String;
begin
  Result := '';
  if (nIndex >= 0) and (nIndex < lstSessionID_.Count) then
    Result := WTS_GetUserNameFromSessionID(lstSessionID_[nIndex].dwSessionId);
end;

function TTgWTSSessionInfomation.GetSessionIdByIndex(nIndex: Integer): DWORD;
begin
  Result := 0;
  if (nIndex >= 0) and (nIndex < lstSessionID_.Count) then
    Result := lstSessionID_[nIndex].dwSessionId;
end;

function TTgWTSSessionInfomation.GetCount: Integer;
begin
  Result := lstSessionID_.Count;
end;

procedure TTgWTSSessionInfomation.UpdateSessionInfo;
var
  pwsi, iter: PWTS_SESSION_INFO;
  i, dwCount: DWORD;
  pInfo: PWTSSessionEntryInfo;
begin
  lstSessionID_.Clear;
  if WTSEnumerateSessions(WTS_CURRENT_SERVER_HANDLE, 0, 1, pwsi, dwCount) then
  begin
    iter := pwsi;
    for i := 0 to dwCount - 1 do
    begin
      New(pInfo);
      pInfo.dwSessionId := iter.SessionId;
      pInfo.sWinStationName := iter.pWinStationName;
      lstSessionID_.Add(pInfo);
      Inc(iter);
    end;
    WTSFreeMemory(pwsi);
  end;
end;

function TTgWTSSessionInfomation.GetUserNameBySsid(const dwSsid: DWORD): String;
var
  i: Integer;
begin
  Result := '';
  for i := 0 to lstSessionID_.Count - 1 do
    if lstSessionID_[i].dwSessionId = dwSsid then
    begin
      Result := lstSessionID_[i].sWinStationName;
      exit;
    end;
end;

{ other }

function WTS_GetString(dwSessionID: DWORD; const aWTSInfoClass: WTS_INFO_CLASS): String;
var
  pBuf     : PChar;
  dwReturn : DWORD;
begin
  Result := '';
  pBuf := nil;
  dwReturn := 0;
// WTS_INFO_CLASS이 형식이 꼬였는지.. 그대로 넘겨주면 안된다.. 그래서 이렇게 두번 캐스팅 2012-01-09 sunk
  if WTSQuerySessionInformation(WTS_CURRENT_SERVER_HANDLE, dwSessionID,
                                aWTSInfoClass, pBuf, dwReturn) then
  begin
    if pBuf <> nil then
    begin
      Result := pBuf;
      WTSFreeMemory(pBuf);
    end;
  end;
end;

function WTS_GetDWORD(dwSessionID: DWORD; const aWTSInfoClass: WTS_INFO_CLASS): DWORD;
var
  pBuf     : PChar;
  dwReturn : DWORD;
begin
  Result := 0;
  pBuf := nil;
  dwReturn := 0;
// WTS_INFO_CLASS이 형식이 꼬였는지.. 그대로 넘겨주면 안된다.. 그래서 이렇게 두번 캐스팅 2012-01-09 sunk
  if WTSQuerySessionInformation(WTS_CURRENT_SERVER_HANDLE, dwSessionID,
                                aWTSInfoClass, pBuf, dwReturn) then
  begin
    if pBuf <> nil then
    begin
      Result := DWORD(pBuf);
      WTSFreeMemory(pBuf);
    end;
  end;
end;

function WTS_GetUserNameFromSessionID(dwSessionID: DWORD): String;
begin
  Result := WTS_GetString(dwSessionID, WTSUserName);
end;

function WTS_GetCurrentUserName: String;
var
  pBuf: Pointer;
  sResult: String;
begin
  Result := Trim(WTS_GetUserNameFromSessionID(WTS_CURRENT_SESSION));
  if NetUserGetInfo(nil, PChar(Result), 23, pBuf) = NEAR_SUCCESS then
  begin
    try
      if PUserInfo23(pBuf).usri23_full_name <> '' then
      begin
        SetLength(sResult, Length(PUserInfo23(pBuf).usri23_full_name));
        StrCopy(PChar(sResult), PUserInfo23(pBuf).usri23_full_name);
        Result := Trim(sResult);
      end;
      NetApiBufferFree(pBuf);
    except
    //
      exit;
    end;
  end;
end;

function WTS_GetActiveSessionUserName: String;
begin
  Result := WTS_GetUserNameFromSessionID(WTSGetActiveConsoleSessionId);
end;

function WTS_GetActiveUserProfilePath: String;
var
  hUserToken: THandle;
  dwSessionId: DWORD;
  arrBuf: array[0..MAX_PATH] of Char;
  dwSize: DWORD;
begin
  Result := '';
  dwSessionId := WTSGetActiveConsoleSessionId;
  if WTSQueryUserToken(dwSessionId, hUserToken) then
  try
    dwSize := Length(arrBuf);
    if GetUserProfileDirectory(hUserToken, arrBuf, dwSize) then
      Result := arrBuf;
  finally
    CloseHandle(hUserToken);
  end;
end;

//finalization
//  if _hNetApi32 <> 0 then
//    FreeLibrary(_hNetApi32);

end.