{*******************************************************}
{                                                       }
{       Tocsg.Registry                                  }
{                                                       }
{       Copyright (C) 2022 kkuzil                       }
{                                                       }
{*******************************************************}

unit Tocsg.Registry;

interface

uses
  WinApi.Windows, System.Classes, System.Win.Registry, System.SysUtils,
  System.Generics.Collections, Tocsg.Trace;

const
  REG_RUN = 'SOFTWARE\Microsoft\Windows\CurrentVersion\Run\';
  REG_PROFILE = 'SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileList\';

type
  TRkInfo = record
    sKName: string;
    ftLastWriteTime: TFileTime;
  end;
  TRkInfoList = TList<TRkInfo>;

function SetRegValueString(K: HKEY; const sKey, sValueName, sValue: String; bCanCreate: Boolean = false): Boolean;
function SetRegValueStringEx(K: HKEY; const sKey, sValueName, sValue: String; bCanCreate: Boolean = false): Boolean;
function SetRegValueInteger(K: HKEY; const sKey, sValueName: String; nValue: Integer; bCanCreate: Boolean = false): Boolean;

function ExistsKey(K: HKEY; const sKey: String): Boolean;
function CountRegKeyValue(K: HKEY; const sKey: String): Integer;
function GetRegValueAsString(K: HKEY; const sKey, sValue: String; bCreate: Boolean = false): String;
function GetRegValueAsInteger(K: HKEY; const sKey, sValue: String; nDefVal: Integer = 0): Integer;

function GetRegRecentUserSid: String;

function DelRegKey(K: HKEY; const sKey: String): Boolean;
function DelRegValue(K: HKEY; const sKey, sValueName: String): Boolean;

function ExtRegSubKeyToStrings(K: HKEY; sKey: String; aStrings: TStrings): Boolean;

function ExistsRunAppByHLM(const AppName: String; aRootKey: HKEY = HKEY_LOCAL_MACHINE): Boolean;
function AddRunAppByHLM(const AppName, sValue: String; aRootKey: HKEY = HKEY_LOCAL_MACHINE): Boolean;
function DeleteRunAppByHLM(const AppName: String; aRootKey: HKEY = HKEY_LOCAL_MACHINE): Boolean;

function GetDomainUserNameFromReg: String;
function GetUserNameFromReg(sRegKey: String = ''): String;

procedure CopyRegKey(K: HKEY; sSrcKey, sDestKey: String);

function ExtrSubKeySortList(K: HKEY; sKey: String; aRkInfoList: TRkInfoList): Integer;

type
// 기본 TRegistry 클래스는 REG_MULTI_SZ 타입까지 분석하지 못한다.
// 그래서 헬퍼 클래스로 지원되도록 추가함 14_1006 15:08:25 kku
  TRegDataTypeEx = (rdxUnknown, rdxString, rdxExpandString, rdxInteger, rdxBinary, rdxMultiString{추가});

  TRegDataInfoEx = record
    RegData: TRegDataTypeEx;
    DataSize: Integer;
  end;

  TRegistryHelper = class helper for TRegistry
  private
    function GetDataEx(const Name: string; Buffer: Pointer; BufSize: Integer; var RegData: TRegDataTypeEx): Integer; // 지금까지 외부에서 사용할일이 없어서 숨김 14_1006 15:09:49 kku
    function GetDataInfoEx(const ValueName: string; var Value: TRegDataInfoEx): Boolean; // 지금까지 외부에서 사용할일이 없어서 숨김 14_1006 15:09:49 kku
  public
    function GetDataAsStringEx(const ValueName: string; PrefixType: Boolean = false): string;
    function GetDataTypeEx(const ValueName: string): TRegDataTypeEx; // 외부에서는 이걸로 타입 확인하고, GetDataAsStringEx 이걸로 데이터 가져오는걸로 사용한다 14_1006 15:09:20 kku
    procedure WriteMultiString(const ValueName: String; aMultiStrList: TStrings);
  end;


implementation

uses
  System.RTLConsts, Tocsg.Safe, Tocsg.Exception, Tocsg.DateTime, Tocsg.Process,
  System.Generics.Defaults;

function CompareByLastWriteTime(const Left, Right: TRkInfo): Integer;
begin
  Result := CompareFileTime(Right.ftLastWriteTime, Left.ftLastWriteTime);
end;

function SetRegValueString(K: HKEY; const sKey, sValueName, sValue: String; bCanCreate: Boolean = false): Boolean;
var
  Reg: TRegistry;
begin
  Result := false;
  Guard(Reg, TRegistry.Create);
  Reg.RootKey := K;
  if Reg.OpenKey(sKey, bCanCreate) then
    if bCanCreate or Reg.ValueExists(sValueName) then
    begin
      try
        Reg.WriteString(sValueName, sValue);
        Result := true;
      except

      end;
    end;
end;

function SetRegValueStringEx(K: HKEY; const sKey, sValueName, sValue: String; bCanCreate: Boolean = false): Boolean;
var
  Reg: TRegistry;
begin
  Result := false;
  Guard(Reg, TRegistry.Create);
  Reg.RootKey := K;
  if Reg.OpenKey(sKey, bCanCreate) then
    if bCanCreate or Reg.ValueExists(sValueName) then
    begin
      try
        Reg.WriteExpandString(sValueName, sValue);
        Result := true;
      except

      end;
    end;
end;

function SetRegValueInteger(K: HKEY; const sKey, sValueName: String; nValue: Integer; bCanCreate: Boolean = false): Boolean;
var
  Reg: TRegistry;
begin
  Result := false;
  Guard(Reg, TRegistry.Create);
  Reg.RootKey := K;
  if Reg.OpenKey(sKey, bCanCreate) then
    if bCanCreate or Reg.ValueExists(sValueName) then
    begin
      try
        Reg.WriteInteger(sValueName, nValue);
        Result := true;
      except

      end;
    end;
end;

function ExistsKey(K: HKEY; const sKey: String): Boolean;
var
  Reg: TRegistry;
begin
  Result := false;

  Guard(Reg, TRegistry.Create);
  Reg.RootKey := K;
  try
    Result := Reg.KeyExists(sKey);
  except
  //
  end;
end;

function CountRegKeyValue(K: HKEY; const sKey: String): Integer;
var
  Reg: TRegistry;
  StrList: TStringList;
begin
  Result := 0;

  Guard(Reg, TRegistry.Create);
  Reg.RootKey := K;
  try
    if Reg.OpenKey(sKey, false) then
    begin
      Guard(StrList, TStringList.Create);
      Reg.GetValueNames(StrList);
      Result := StrList.Count;
    end;
  except
  //
  end;
end;

function GetRegValueAsString(K: HKEY; const sKey, sValue: String; bCreate: Boolean = false): String;
var
  Reg: TRegistry;
begin
  Result := '';

  Guard(Reg, TRegistry.Create);
  Reg.RootKey := K;
  try
    if Reg.OpenKey(sKey, bCreate) and Reg.ValueExists(sValue) then
      Result := Reg.ReadString(sValue);
  except
  //
  end;
end;

function GetRegValueAsInteger(K: HKEY; const sKey, sValue: String; nDefVal: Integer = 0): Integer;
var
  Reg: TRegistry;
begin
  Result := nDefVal;
  Guard(Reg, TRegistry.Create);
  Reg.RootKey := K;
  try
    if Reg.OpenKey(sKey, false) and Reg.ValueExists(sValue) then
    begin
      Result := Reg.ReadInteger(sValue);
    end;
  except
  //
  end;
end;

function GetRegRecentUserSid: String;
var
  Reg, RegCheck: TRegistry;
  StrList: TStringList;
  i, nHigh, nLow: Integer;
  sTemp: String;
  dtRecent, dtCheck: TDateTime;
begin
  Result := '';
  try
    Guard(Reg, TRegistry.Create);
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    if not Reg.OpenKeyReadOnly(REG_PROFILE) then
      exit;
    Guard(StrList, TStringList.Create);

    dtRecent := 0;
    Reg.GetKeyNames(StrList);
    Reg.CloseKey;

    Guard(RegCheck, TRegistry.Create);
    RegCheck.RootKey := HKEY_USERS;
    for i := 0 to StrList.Count - 1 do
    begin
      if (Length(StrList[i]) > 20) and
         RegCheck.OpenKeyReadOnly(StrList[i]) then // 키가 존재하는거 대상으로 함 (로그온된거) 22_0620 16:50:47 kku
      begin
        RegCheck.CloseKey;

      // LocalProfileLoadTimeHigh, LocalProfileLoadTimeLow가 0인 경우가 있다... 22_0620 16:45:02 kku
        nHigh := GetRegValueAsInteger(HKEY_LOCAL_MACHINE, REG_PROFILE + StrList[i], 'LocalProfileLoadTimeHigh');
        nLow := GetRegValueAsInteger(HKEY_LOCAL_MACHINE, REG_PROFILE + StrList[i], 'LocalProfileLoadTimeLow');
        sTemp := IntToHex(nHigh) + IntToHex(nLow);
      // UTC-0
        dtCheck := ConvTimestampToDateTime(LONGLONG(StrToInt64Def('$' + sTemp, 0)));

        if (dtRecent = 0) or (dtRecent < dtCheck) then
        begin
          dtRecent := dtCheck;
          Result := StrList[i];
        end;
      end;
    end;
  except
    on E: Exception do
      ETgException.TraceException(E, 'Fail .. GetRegRecentUserSid()');
  end;
end;

function DelRegKey(K: HKEY; const sKey: String): Boolean;
var
  Reg: TRegistry;
begin
  Guard(Reg, TRegistry.Create);
  Reg.RootKey := K;
  Result := Reg.DeleteKey(sKey);
end;

function DelRegValue(K: HKEY; const sKey, sValueName: String): Boolean;
var
  Reg: TRegistry;
begin
  Guard(Reg, TRegistry.Create);
  Reg.RootKey := K;
  Result := false;
  if Reg.OpenKey(sKey, false) then
    Result := Reg.DeleteValue(sValueName);
end;

function ExtRegSubKeyToStrings(K: HKEY; sKey: String; aStrings: TStrings): Boolean;
var
  Reg: TRegistry;
  SubList: TStringList;
  i: Integer;
begin
  Result := false;

  Guard(Reg, TRegistry.Create);
  Reg.RootKey := K;

  if Reg.KeyExists(sKey) then
    if Reg.OpenKey(sKey, false) then
    begin
      sKey := IncludeTrailingPathDelimiter(sKey);
      Guard(SubList, TStringList.Create);
      Reg.GetKeyNames(SubList);
      for i := 0 to SubList.Count - 1 do
      begin
      // 값까지 체크 해준다. notepad++ 같은 경우 설정값을 여기에 남겨 놓는경우가 있음 22_0614 16:20:37 kku
        if GetRegValueAsString(K, sKey + SubList[i], 'DisplayName') <> '' then
          aStrings.Add(sKey + SubList[i]);
      end;
      Result := true;
    end;
end;

function ExistsRunAppByHLM(const AppName: String; aRootKey: HKEY = HKEY_LOCAL_MACHINE): Boolean;
var
  Reg: TRegistry;
begin
  Result := false;
  Guard(Reg, TRegistry.Create);
  Reg.RootKey := aRootKey;
  if Reg.OpenKey(REG_RUN, false) then
    Result := Reg.ValueExists(AppName);
end;

function AddRunAppByHLM(const AppName, sValue: String; aRootKey: HKEY = HKEY_LOCAL_MACHINE): Boolean;
var
  Reg: TRegistry;
begin
  Result := false;
  Guard(Reg, TRegistry.Create);
  Reg.RootKey := aRootKey;
  if Reg.OpenKey(REG_RUN, false) then
  begin
    try
      Reg.WriteString(AppName, sValue);
      Result := true;
    except
    // reg write 오류?
    end;
  end;
end;

function DeleteRunAppByHLM(const AppName: String; aRootKey: HKEY = HKEY_LOCAL_MACHINE): Boolean;
begin
  Result := DelRegValue(aRootKey, REG_RUN, AppName);
end;

{ TRegistryHelper }

function DataTypeToRegDataEx(Value: Integer): TRegDataTypeEx;
begin
  case Value of
    REG_SZ        : Result := rdxString;
    REG_EXPAND_SZ : Result := rdxExpandString;
    REG_MULTI_SZ  : Result := rdxMultiString;
    REG_DWORD     : Result := rdxInteger;
    REG_BINARY    : Result := rdxBinary;
    else Result := rdxUnknown;
  end;
end;

function BinaryToHexString(const BinaryData: array of Byte; const PrefixStr: string): string;
var
  DataSize, I, Offset: Integer;
  HexData: string;
  PResult: PChar;
begin
  OffSet := 0;
  if PrefixStr <> '' then
  begin
    Result := PrefixStr;
    Inc(Offset, Length(PrefixStr));
  end;
  DataSize := Length(BinaryData);

  SetLength(Result, Offset + (DataSize*3) - 1); // less one for last ','
  PResult := PChar(Result); // Use a char pointer to reduce string overhead
  for I := 0 to DataSize - 1 do
  begin
    HexData := IntToHex(BinaryData[I], 2);
    PResult[Offset] := HexData[1];
    PResult[Offset+1] := HexData[2];
    if I < DataSize - 1 then
      PResult[Offset+2] := ',';
    Inc(Offset, 3);
  end;
end;

function TRegistryHelper.GetDataInfoEx(const ValueName: string; var Value: TRegDataInfoEx): Boolean;
var
  DataType: Integer;
begin
  FillChar(Value, SizeOf(TRegDataInfo), 0);
  Result := CheckResult(RegQueryValueEx(CurrentKey, PChar(ValueName), nil, @DataType, nil,
    @Value.DataSize));
  Value.RegData := DataTypeToRegDataEx(DataType);
end;

function TRegistryHelper.GetDataTypeEx(const ValueName: string): TRegDataTypeEx;
var
  Info: TRegDataInfoEx;
begin
  if GetDataInfoEx(ValueName, Info) then
    Result := Info.RegData else
    Result := rdxUnknown;
end;

function TRegistryHelper.GetDataEx(const Name: string; Buffer: Pointer;
  BufSize: Integer; var RegData: TRegDataTypeEx): Integer;
var
  DataType: Integer;
begin
  DataType := REG_NONE;
  if not CheckResult(RegQueryValueEx(CurrentKey, PChar(Name), nil, @DataType, PByte(Buffer),
    @BufSize)) then
    raise ERegistryException.CreateResFmt(@SRegGetDataFailed, [Name]);
  Result := BufSize;
  RegData := DataTypeToRegDataEx(DataType);
end;

function TRegistryHelper.GetDataAsStringEx(const ValueName: string;
  PrefixType: Boolean = false): string;
const
  SDWORD_PREFIX = 'dword:';
  SHEX_PREFIX = 'hex:';
var
  Info: TRegDataInfoEx;
  BinaryBuffer: array of Byte;
  nPos: Integer;
  pBuf: TBytes;
begin
  Result := '';
  if GetDataInfoEx(ValueName, Info) and (Info.DataSize > 0) then
  begin
    case Info.RegData of
      rdxString, rdxExpandString:
        begin
          SetString(Result, nil, Info.DataSize);
          GetDataEx(ValueName, PChar(Result), Info.DataSize, Info.RegData);
          SetLength(Result, StrLen(PChar(Result)));
        end;
      rdxMultiString :
        begin
          SetLength(pBuf, Info.DataSize);
          GetDataEx(ValueName, pBuf, Info.DataSize, Info.RegData);

          nPos := 0;
          while nPos < Info.DataSize do
          begin
            Result := Result + PChar(@pBuf[nPos]);
          {$IFDEF UNICODE}
            Inc(nPos, (Length(PChar(@pBuf[nPos])) + 1) * 2);
          {$ELSE}
            Inc(nPos, Length(PChar(@pBuf[nPos])) + 1);
          {$ENDIF}
            if nPos < Info.DataSize then
              Result := Result + #13#10;
          end;
        end;
      rdxInteger:
        begin
          if PrefixType then
            Result := SDWORD_PREFIX+IntToHex(ReadInteger(ValueName), 8)
          else
            Result := IntToStr(ReadInteger(ValueName));
        end;
      rdxBinary, rdxUnknown:
        begin
          SetLength(BinaryBuffer, Info.DataSize);
          ReadBinaryData(ValueName, Pointer(BinaryBuffer)^, Info.DataSize);
          if PrefixType then
            Result := BinaryToHexString(BinaryBuffer, SHEX_PREFIX)
          else
            Result := BinaryToHexString(BinaryBuffer, '');
        end;
    end;
  end;
end;

procedure TRegistryHelper.WriteMultiString(const ValueName: String; aMultiStrList: TStrings);
var
  i, nSize: Integer;
  pBuf: TBytes;
begin
  nSize := 0;
  for i := 0 to aMultiStrList.Count - 1 do
  begin
  {$IFDEF UNICODE}
    Inc(nSize, (Length(aMultiStrList[i]) + 1) * 2);
  {$ELSE}
    Inc(nSize, Length(aMultiStrList[i]) + 1);
  {$ENDIF}
  end;

  SetLength(pBuf, nSize);
  ZeroMemory(pBuf, nSize);

  nSize := 0;
  for i := 0 to aMultiStrList.Count - 1 do
  begin
    StrCopy(PChar(@pBuf[nSize]), PChar(aMultiStrList[i]));
  {$IFDEF UNICODE}
    Inc(nSize, (Length(aMultiStrList[i]) + 1) * 2);
  {$ELSE}
    Inc(nSize, Length(aMultiStrList[i]) + 1);
  {$ENDIF}
  end;

  RegSetValueEx(CurrentKey, PChar(ValueName), 0, REG_MULTI_SZ, @pBuf[0], nSize);
end;

function GetDomainUserNameFromReg: String;
var
  sRegKey,
  sDomain,
  sUser: String;
begin
  Result := '';
  try
    sRegKey := GetRegRecentUserSid;
    if sRegKey = '' then
      exit;

    sDomain := GetRegValueAsString(HKEY_USERS, sRegKey + '\Volatile Environment', 'USERDOMAIN');
    sUser := GetRegValueAsString(HKEY_USERS, sRegKey + '\Volatile Environment', 'USERNAME');
    if (sDomain <> '') and (sUser <> '') then
      Result := sDomain + '\' + sUser;
  except
    on E: Exception do
      ETgException.TraceException(E, 'Fail .. GetDomainUserNameFromReg()');
  end;
end;

function GetUserNameFromReg(sRegKey: String = ''): String;
begin
  Result := '';
  try
    if sRegKey = '' then
      sRegKey := GetRegRecentUserSid;

    if sRegKey = '' then
      exit;

    Result := GetRegValueAsString(HKEY_LOCAL_MACHINE, REG_PROFILE + sRegKey, 'ProfileImagePath');
    if Result <> '' then
      Result := Trim(ExtractFileName(ExcludeTrailingPathDelimiter(Result)));
  except
    on E: Exception do
      ETgException.TraceException(E, 'Fail .. GetUserNameFromReg()');
  end;
end;

procedure CopyRegKey(K: HKEY; sSrcKey, sDestKey: String);
var
  Reg: TRegistry;
begin
  try
    Guard(Reg, TRegistry.Create);
    Reg.RootKey := K;
    Reg.MoveKey(sSrcKey, sDestKey, false);
  except
    on E: Exception do
      ETgException.TraceException(E, 'Fail .. CopyRegKey()');
  end;
end;

function ExtrSubKeySortList(K: HKEY; sKey: String; aRkInfoList: TRkInfoList): Integer;
var
  Reg: TRegistry;
  SubList: TStringList;
  ftLocal, ftKey: TFileTime;
  RkInfo: TRkInfo;
  i: Integer;
begin
  Result := 0;
  try
    Guard(Reg, TRegistry.Create);
    Reg.RootKey := HKEY_USERS;

    sKey := IncludeTrailingPathDelimiter(sKey);
    if Reg.OpenKeyReadOnly(sKey) then
    begin
      Guard(SubList, TStringList.Create);
      Reg.GetKeyNames(SubList);
      Reg.CloseKey;

      if SubList.Count > 0 then
      begin
        for i := 0 to SubList.Count - 1 do
        begin
          if Reg.OpenKeyReadOnly(sKey + SubList[i]) then
          begin
            if RegQueryInfoKey(Reg.CurrentKey, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, @ftKey) = ERROR_SUCCESS then
            begin
              FileTimeToLocalFileTime(ftKey, ftLocal);
              RkInfo.sKName := SubList[i];
              RkInfo.ftLastWriteTime := ftLocal;
              aRkInfoList.Add(RkInfo);
            end;
            Reg.CloseKey;
          end;
        end;

        Result := aRkInfoList.Count;
        if Result > 0 then
          aRkInfoList.Sort(TComparer<TRkInfo>.Construct(CompareByLastWriteTime));
      end;
    end;
  except
    on E: Exception do
      ETgException.TraceException(E, 'Fail .. ExtrSubKeySortList()');
  end;
end;

end.