{*******************************************************}
{                                                       }
{       Tocsg.AppInfo                                   }
{                                                       }
{       Copyright (C) 2022 kku                          }
{                                                       }
{*******************************************************}

unit Tocsg.AppInfo;

interface

uses
  Tocsg.Obj, System.SysUtils, System.Classes, Winapi.Windows,
  System.Generics.Collections, superobject;

type
  TInstExe = class(TTgObject)
  private
    nRunCnt_: Integer;
    ExeDtList_: TList<TDateTime>;
    sPath_,
    sFName_: String;
  public
    Constructor Create(sPath: String);
    Destructor Destroy; override;

    property RunCount: Integer read nRunCnt_;
    property FileName: String read sFName_;
    property ExeDtList: TList<TDateTime> read ExeDtList_;
  end;
  TInstExeList = class(TList<TInstExe>)
  protected
    procedure Notify(const Item: TInstExe; Action: TCollectionNotification); override;
  public
    function GetExeFiles: String;
    function GetRunCount: Integer;
  end;

  PInstAppEnt = ^TInstAppEnt;
  TInstAppEnt = record
    sName,
    sVersion,
    sPublisher,
    sUrlInfo,
    sInstDir,
    sIconPath,
    sCopyright,
    sDescription,
    sUninstStr: String;
    dtInst: TDateTime;
    InstExeList: TInstExeList;
  end;
  TTgInstAppList = class(TList<PInstAppEnt>)
  protected
    procedure Notify(const Item: PInstAppEnt; Action: TCollectionNotification); override;
  public
    procedure UpdateInstAppList;

    function ToJsonObj: ISuperObject;
    function ToJsonObjHE: ISuperObject;
  end;

implementation

uses
  Tocsg.Safe, Tocsg.Registry, System.Win.Registry, Tocsg.Exception, Tocsg.FileInfo,
  Tocsg.DateTime, Tocsg.Json, Tocsg.Path, Tocsg.Prefetch, Tocsg.Strings;

const
  REGKEY_UNINSTALL = 'SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\';
  REGKEY_UNINSTALL_WOW64 = 'SOFTWARE\WOW6432Node\Microsoft\Windows\CurrentVersion\Uninstall\';

{ TInstExe }

Constructor TInstExe.Create(sPath: String);
begin
  Inherited Create;
  sFName_ := ExtractFileName(sPath);
  sPath_ := ExtractFilePath(sPath);
  ExeDtList_ := TList<TDateTime>.Create;
end;

Destructor TInstExe.Destroy;
begin
  FreeAndNil(ExeDtList_);
  Inherited;
end;

{ TInstExeList }

procedure TInstExeList.Notify(const Item: TInstExe; Action: TCollectionNotification);
begin
  if Action = cnRemoved then
    Item.Free;
end;

function TInstExeList.GetExeFiles: String;
var
  i: Integer;
begin
  Result := '';
  for i := 0 to Self.Count - 1 do
    SumString(Result, Self[i].sFName_, ', ');
end;

function TInstExeList.GetRunCount: Integer;
var
  i: Integer;
begin
  Result := 0;
  for i := 0 to Self.Count - 1 do
    Inc(Result, Self[i].nRunCnt_);
end;

{ TTgInstAppList }

procedure TTgInstAppList.Notify(const Item: PInstAppEnt; Action: TCollectionNotification);
begin
  if Action = cnRemoved then
  begin
    if Item.InstExeList <> nil then
      FreeAndNil(Item.InstExeList);
    Dispose(Item);
  end;
end;

procedure ExtrPfFileInfo(aIExe: TInstExe);
var
  wfd: TWin32FindData;
  hSc: THandle;
  sDir,
  sPath,
  sFName: String;
  pf: TTgPrefetchAnal;
  i: Integer;
begin
  sDir := GetWindowsDir + 'Prefetch\';
  sPath := sDir + '*.*';

  hSc := FindFirstFile(PChar(sPath), wfd);
  if hSc = INVALID_HANDLE_VALUE then
    exit;

  try
    sPath := UpperCase(ExcludeTrailingPathDelimiter(aIExe.sPath_));
    Delete(sPath, 1, 2); // C: 빼기
    sFName := UpperCase(aIExe.sFName_);
    Guard(pf, TTgPrefetchAnal.Create);
    Repeat
      if (String(wfd.cFileName) <> '.') and (String(wfd.cFileName) <> '..') then
        if ((wfd.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0) then
        begin
          if Pos(aIExe.sFName_.ToUpper, String(wfd.cFileName)) > 0 then
          begin
            if pf.LoadFromFile(sDir + wfd.cFileName) then
            begin
              if (pf.FileName <> sFName) or (Pos(sPath, pf.FilePath) = 0) then
                continue;

              for i := 0 to pf.ExeDtList.Count - 1 do
                aIExe.ExeDtList_.Add(pf.ExeDtList[i]);
              Inc(aIExe.nRunCnt_, pf.RunCount);
            end;
          end;
        end;
    Until not FindNextFile(hSc, wfd);
  finally
    WinApi.Windows.FindClose(hSc);
  end;
end;

procedure ExtractExeFilesFromInstDir(sDir: String; var aList: TInstExeList);
var
  wfd: TWin32FindData;
  hSc: THandle;
  sPath: String;
  IExe: TInstExe;
begin
  if (sDir = '') or not DirectoryExists(sDir) then
    exit;

  sDir := IncludeTrailingPathDelimiter(sDir);
  sPath := sDir + '*.*';

  hSc := FindFirstFile(PChar(sPath), wfd);
  if hSc = INVALID_HANDLE_VALUE then
    exit;
  try
    Repeat
      if (String(wfd.cFileName) <> '.') and (String(wfd.cFileName) <> '..') then
        if ((wfd.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) <> 0) then
        begin
//          if CompareText(wfd.cFileName, 'bin') = 0 then
            ExtractExeFilesFromInstDir(sDir + wfd.cFileName, aList);
        end else begin
//          if (UpperCase(GetFileExt(wfd.cFileName)) = 'EXE') and
//             (CompareText(wfd.cFileName, 'setup.exe') <> 0) and
//             (CompareText(wfd.cFileName, 'uninstall.exe') <> 0) and
//             (CompareText(wfd.cFileName, 'update.exe') <> 0) then
          if (UpperCase(GetFileExt(wfd.cFileName)) = 'EXE') then
          begin
            IExe := TInstExe.Create(sDir + wfd.cFileName);
            ExtrPfFileInfo(IExe);
            aList.Add(IExe);
          end;
        end;
    Until not FindNextFile(hSc, wfd);
  finally
    WinApi.Windows.FindClose(hSc);
  end;
end;

procedure TTgInstAppList.UpdateInstAppList;

  function GetRegStrValue(aReg: TRegistry; sValName: String): String; inline;
  begin
    if aReg.ValueExists(sValName) then
      Result := aReg.ReadString(sValName)
    else
      Result := '';
  end;

  procedure AddInstAppFromReg(K: HKEY; sRegKey: String);
  var
    InstList: TStringList;
    Reg: TRegistry;
    i: Integer;
    sName, sUninstStr: String;
    pEnt: PInstAppEnt;
    FileInfo: TTgFileInfo;
    RegInfo: TRegKeyInfo;
  begin
    try
      Guard(InstList, TStringList.Create);
      ExtRegSubKeyToStrings(K, sRegKey, InstList);
      if InstList.Count = 0 then
        exit;

      Guard(Reg, TRegistry.Create);
      Reg.RootKey := K;
      for i := 0 to InstList.Count - 1 do
      begin
        if not Reg.OpenKey(InstList[i], false) then
          continue;

        try
          FileInfo := nil;
          try
            sName := GetRegStrValue(Reg, 'DisplayName');
            sUninstStr := GetRegStrValue(Reg, 'UninstallString');
            if (sName = '') or (sUninstStr = '') then
              continue;

            New(pEnt);
            ZeroMemory(pEnt, SizeOf(TInstAppEnt));
            pEnt.sName := sName;
            pEnt.sVersion := GetRegStrValue(Reg, 'DisplayVersion');
            pEnt.sPublisher := GetRegStrValue(Reg, 'Publisher');
            pEnt.sUrlInfo := GetRegStrValue(Reg, 'URLInfoAbout');
            pEnt.sInstDir := StringReplace(GetRegStrValue(Reg, 'InstallLocation'), '"', '', [rfReplaceAll]);
            if pEnt.sInstDir = '' then
            begin
              pEnt.sInstDir := ExtractFilePath(StringReplace(sUninstStr, '"', '', [rfReplaceAll]));
              if not DirectoryExists(pEnt.sInstDir) then
                pEnt.sInstDir := '';
            end;
          {$IFNDEF _HE_}
            pEnt.InstExeList := TInstExeList.Create;
            ExtractExeFilesFromInstDir(pEnt.sInstDir, pEnt.InstExeList);
          {$ENDIF}
            pEnt.sIconPath := GetRegStrValue(Reg, 'DisplayIcon');
            pEnt.sUninstStr := sUninstStr;
            if reg.GetKeyInfo(RegInfo) then
              pEnt.dtInst := ConvFileTimeToDateTime_Local(RegInfo.FileTime);

            if FileExists(pEnt.sIconPath) then
            begin
              FileInfo := TTgFileInfo.Create(pEnt.sIconPath);
              pEnt.sCopyright := FileInfo.LegalCopyright;
              pEnt.sDescription := FileInfo.Description;
              if pEnt.sVersion = '' then
                pEnt.sVersion := FileInfo.Version;
              if pEnt.sPublisher = '' then
                pEnt.sPublisher := FileInfo.Company;
            end;
            Add(pEnt);
          except
            continue;
          end;
        finally
          Reg.CloseKey;
          if FileInfo <> nil then
            FreeAndNil(FileInfo);
        end;
      end;
    except
      on E: Exception do
        ETgException.TraceException(Self, E, 'Fail .. AddInstAppFromReg()');
    end;
  end;

var
  sCurUserSid: String;
begin
  Clear;

  sCurUserSid := GetRegRecentUserSid;

  if sCurUserSid <> '' then
  begin
    AddInstAppFromReg(HKEY_USERS, sCurUserSid + '\' + REGKEY_UNINSTALL);
    AddInstAppFromReg(HKEY_USERS, sCurUserSid + '\' + REGKEY_UNINSTALL_WOW64);
  end;

  AddInstAppFromReg(HKEY_LOCAL_MACHINE, REGKEY_UNINSTALL);
  AddInstAppFromReg(HKEY_LOCAL_MACHINE, REGKEY_UNINSTALL_WOW64);
end;

function TTgInstAppList.ToJsonObj: ISuperObject;
var
  i: Integer;
begin
  Result := TSuperObject.Create(stArray);
  for i := 0 to Count - 1 do
    Result.AsArray.Add(TTgJson.ValueToJsonObject<TInstAppEnt>(Items[i]^));
end;

function TTgInstAppList.ToJsonObjHE: ISuperObject;
var
  i: Integer;
  pEnt: PInstAppEnt;
  O: ISuperObject;
begin
  Result := TSuperObject.Create(stArray);
  for i := 0 to Count - 1 do
  begin
    pEnt := Items[i];
    O := SO;

    with pEnt^ do
    begin
      O.S['Name'] := sName;
      O.S['Version'] := sVersion;
      O.S['Publisher'] := sPublisher;
      O.S['UrlInfo'] := sUrlInfo;
      O.S['InstDir'] := sInstDir;
      O.S['IconPath'] := sIconPath;
      O.S['Copyright'] := sCopyright;
      O.S['Description'] := sDescription;
      O.I['InstDT'] := DelphiToJavaDateTime(dtInst);
    end;
    Result.AsArray.Add(O);
  end;
end;

end.