358 lines
9.7 KiB
Plaintext
358 lines
9.7 KiB
Plaintext
{*******************************************************}
|
|
{ }
|
|
{ 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.
|