BSOne.SFC/Tocsg.Module/InstMon/ThdInstMon.pas

476 lines
13 KiB
Plaintext

{*******************************************************}
{ }
{ ThdInstMon }
{ }
{ Copyright (C) 2022 kkuzil }
{ }
{*******************************************************}
unit ThdInstMon;
interface
uses
Tocsg.Thread, System.SysUtils, System.Classes, Winapi.Windows,
Winapi.Messages;
const
REGKEY_UNINSTALL = 'SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\';
REGKEY_UNINSTALL_WOW64 = 'SOFTWARE\WOW6432Node\Microsoft\Windows\CurrentVersion\Uninstall\';
IGNORE_APPS = 'MICROSOFT|Sophos';
IGNORE_DEL_APPS = 'MYSQL';
WM_INST_NOTIFY = WM_USER + 9481;
type
TThdInstMon = class(TTgThread)
private
bIsWorking_: Boolean;
IgrAppList_,
IgrDelAppList_: TStringList;
protected
hRcvWnd_: HWND;
procedure Execute; override;
public
Constructor Create(hRcvWnd: HWND = 0);
Destructor Destroy; override;
// for HE
procedure StartService;
procedure StopService;
end;
implementation
uses
{$IFDEF _HE_}
ManagerService, GlobalDefine, ManagerModel,
{$ELSE}
{$ENDIF}
Tocsg.Registry, System.Win.Registry, Tocsg.Safe, Tocsg.Exception, Tocsg.Shell,
Tocsg.Strings, Tocsg.Process, Tocsg.Files, Tocsg.Path, ParserLinkFile;
{ TThdInstMon }
Constructor TThdInstMon.Create(hRcvWnd: HWND = 0);
begin
Inherited Create;
bIsWorking_ := false;
hRcvWnd_ := hRcvWnd;
IgrAppList_ := TStringList.Create;
SplitString(UpperCase(IGNORE_APPS), '|', IgrAppList_);
IgrDelAppList_ := TStringList.Create;
SplitString(UpperCase(IGNORE_DEL_APPS), '|', IgrDelAppList_);
end;
Destructor TThdInstMon.Destroy;
begin
FreeAndNil(IgrDelAppList_);
FreeAndNil(IgrAppList_);
Inherited;
end;
procedure TThdInstMon.StartService;
begin
if not bIsWorking_ then
begin
bIsWorking_ := true;
StartThread;
end;
end;
procedure TThdInstMon.StopService;
begin
if bIsWorking_ then
begin
bIsWorking_ := false;
PauseThread;
end;
end;
procedure TThdInstMon.Execute;
function GetInstDirAndExeFiles(aReg: TRegistry; var sInstDir: String; var bBlock: Boolean; aExeList: TStrings): Boolean;
var
sVal: String;
i: Integer;
begin
Result := false;
sInstDir := '';
bBlock := true;
aExeList.Clear;
if aReg.ValueExists('InstallDir') then
sVal := aReg.ReadString('InstallDir')
else if aReg.ValueExists('InstallLocation') then
sVal := aReg.ReadString('InstallLocation')
else
if aReg.ValueExists('UninstallString') then
begin
sVal := aReg.ReadString('UninstallString');
sVal := StringReplace(sVal, '"', '', [rfReplaceAll]);
sVal := ExtractFilePath(sVal);
end else exit;
sVal := StringReplace(sVal, '"', '', [rfReplaceAll]);
sInstDir := IncludeTrailingPathDelimiter(sVal);
ExtrFilesFromDir(sInstDir, aExeList, true, 'EXE');
if aReg.ValueExists('DisplayName') then
sVal := aReg.ReadString('DisplayName')
else
sVal := sInstDir;
{$IFDEF _HE_}
gMgSvc.SendEventLog(URI_USER_ACTION, LOGCODE_APP_INSTALLATION, Format('"%s" Installed', [sVal]));
var AppInstKind: TAppInstKind := gMgSvc.ModePolicy.AppInstKind;
case AppInstKind of
aikBlock,
aikPopup :
begin
var bIgr := false;
var cChk := UpperCase(sVal);
for i := 0 to IgrAppList_.Count - 1 do
begin
if cChk.Contains(IgrAppList_[i]) then // MICROSOFT 제외 추가 22_0816 17:58:23 kku
begin
bIgr := true;
break;
end;
end;
if not bIgr then
begin
if AppInstKind = aikBlock then
begin
for i := 0 to IgrDelAppList_.Count - 1 do
begin
if cChk.Contains(IgrDelAppList_[i]) then // MICROSOFT 제외 추가 22_0816 17:58:23 kku
begin
bBlock := false;
break;
end;
end;
if bBlock then
sVal := sVal + '|PV';
end;
gMgSvc.PopupMessage(TYPE_MSG_PREVENT_INSTALL, sVal);
end;
end;
end;
{$ENDIF}
if hRcvWnd_ <> 0 then
SendMessage(hRcvWnd_, WM_INST_NOTIFY, 0, NativeInt(sVal));
Result := true;
end;
procedure TerminateExes(aExeList: TStrings);
var
i: Integer;
begin
for i := 0 to aExeList.Count - 1 do
TerminateProcessByName(aExeList[i]);
end;
procedure DeleteInstDir(sDir: String; bIncludeSubDir: Boolean = true;
bForceDel: Boolean = false);
var
wfd: TWin32FindData;
hSc: THandle;
sPath: String;
bRetry: Boolean;
Label
LB_Retry;
begin
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
DeleteInstDir(sDir + wfd.cFileName, bIncludeSubDir, bForceDel);
end else begin
bRetry := false;
LB_Retry :
if bForceDel and
((wfd.dwFileAttributes and FILE_ATTRIBUTE_READONLY) <> 0) then
begin
// 읽기 전용 속성 해제 22_0510 10:28:28 kku
SetFileAttributes(PChar(sDir + wfd.cFileName), FILE_ATTRIBUTE_NORMAL);
end;
if not DeleteFile(PChar(sDir + wfd.cFileName)) then
begin
if (GetFileExt(wfd.cFileName).ToUpper = 'EXE') and not bRetry then
begin
TerminateProcessByName(wfd.cFileName);
Sleep(500);
bRetry := true;
goto LB_Retry;
end;
end;
end;
Until not FindNextFile(hSc, wfd);
finally
WinApi.Windows.FindClose(hSc);
end;
end;
function RemoveInstall(K: HKEY; sKey: String): Boolean;
var
Reg: TRegistry;
sVal,
sInstDir: String;
ExeList,
StrList: TStringList;
bBlock: Boolean;
// {$IFNDEF _HE_}
procedure DeleteLinkFileFromDir(sDir: String);
var
i: Integer;
Plf: TParserLinkFile;
begin
sDir := IncludeTrailingBackslash(sDir);
StrList.Clear;
ExtrFilesFromDir(sDir, StrList, false, 'LNK');
Guard(Plf, TParserLinkFile.Create);
for i := 0 to StrList.Count - 1 do
begin
if plf.LoadFromFile(sDir + StrList[i]) then
begin
if ExeList.IndexOf(ExtractFileName(GetLfiValueFromCaption(Plf.LfiEntList, 'Base Path'))) <> -1 then
DeleteFile(PChar(sDir + StrList[i]));
end;
end;
end;
// {$ENDIF}
begin
Result := false;
try
Guard(Reg, TRegistry.Create);
Reg.RootKey := K;
if not Reg.OpenKey(sKey, false) then
begin
_Trace('Fail .. Execute() > RemoveInstall() > Reg.OpenKey(), Key="%s"', [sKey]);
exit;
end;
Guard(ExeList, TStringList.Create);
ExeList.CaseSensitive := false;
if not GetInstDirAndExeFiles(Reg, sInstDir, bBlock, ExeList) then
exit;
{$IFDEF _HE_}
// 주의 : HE에서는 차단을 안하니까 Result는 반드시 false로 해야한다.
// 차단 기능 추가됨 22_1121 09:35:43 kku
if not bBlock or (gMgSvc.ModePolicy.AppInstKind <> aikBlock) then
exit;
{$ENDIF}
Guard(StrList, TStringList.Create);
if Reg.ValueExists('QuietUninstallString') then
begin
sVal := Reg.ReadString('QuietUninstallString');
SplitString2(sVal, ' ', StrList);
TerminateExes(ExeList);
case StrList.Count of
2 : ExecutePath_hide(StrList[0], StrList[1]);
3 : ExecutePath_hide(StrList[0], StrList[1] + ' ' + StrList[2]); // 여기까지 안올거 같긴 하다..
else ExecutePath_hide(sVal);
end;
end else
if Reg.ValueExists('UninstallString') then
begin
sVal := Reg.ReadString('UninstallString');
if Pos('msiexec.exe', LowerCase(sVal)) = 1 then
begin
TerminateExes(ExeList);
ExecutePath_hide('MsiExec.exe', Format('/x %s /quiet /qn /norestart', [ExtractFileName(sKey)]));
end else begin
TerminateExes(ExeList);
Sleep(500);
end;
end;
if sInstDir <> '' then
begin
DeleteInstDir(sInstDir, true, true);
DeleteDir(sInstDir, true, true);
// todo : 인스톨러 때문에 설치 폴더가 잡혀있을때 지워주는 스레드에 등록?
end;
DeleteLinkFileFromDir(GetDesktopDir);
DeleteLinkFileFromDir(GetCommonDesktopDir);
Reg.CloseKey;
Reg.DeleteKey(sKey);
Result := true;
except
on E: Exception do
ETgException.TraceException(Self, E, 'Fail .. Execute() > RemoveInstall()');
end;
end;
var
{$IFDEF WIN64}
PrevInstListHCU32,
PrevInstListHLM32,
NewInstListHCU32,
NewInstListHLM32,
{$ENDIF}
PrevInstListHCU,
PrevInstListHLM: TStringList;
NewInstListHCU,
NewInstListHLM: TStringList;
i: Integer;
sCurUserSid: String;
begin
sCurUserSid := GetRegRecentUserSid;
{$IFDEF WIN64}
Guard(PrevInstListHCU32, TStringList.Create);
Guard(PrevInstListHLM32, TStringList.Create);
Guard(NewInstListHCU32, TStringList.Create);
Guard(NewInstListHLM32, TStringList.Create);
{$ENDIF}
Guard(PrevInstListHCU, TStringList.Create);
Guard(PrevInstListHLM, TStringList.Create);
Guard(NewInstListHCU, TStringList.Create);
Guard(NewInstListHLM, TStringList.Create);
while not Terminated and not GetWorkStop do
begin
try
{$IFDEF WIN64}
NewInstListHCU32.Clear;
NewInstListHLM32.Clear;
{$ENDIF}
NewInstListHCU.Clear;
NewInstListHLM.Clear;
if sCurUserSid <> '' then
ExtRegSubKeyToStrings(HKEY_USERS, sCurUserSid + '\' + REGKEY_UNINSTALL, NewInstListHCU);
ExtRegSubKeyToStrings(HKEY_LOCAL_MACHINE, REGKEY_UNINSTALL, NewInstListHLM);
{$IFDEF WIN64}
if sCurUserSid <> '' then
ExtRegSubKeyToStrings(HKEY_USERS, sCurUserSid + '\' + REGKEY_UNINSTALL_WOW64, NewInstListHCU32);
ExtRegSubKeyToStrings(HKEY_LOCAL_MACHINE, REGKEY_UNINSTALL_WOW64, NewInstListHLM32);
{$ENDIF}
if (
{$IFDEF WIN64} NewInstListHCU32.Count + NewInstListHLM32.Count + {$ENDIF}
NewInstListHCU.Count + NewInstListHLM.Count ) = 0 then
begin
Sleep(1000);
continue;
end;
{$IFDEF WIN64}
// HKEY_USERS 32
if PrevInstListHCU32.Count > 0 then
begin
for i := NewInstListHCU32.Count - 1 downto 0 do
begin
if (PrevInstListHCU32.Count > 0) and
(PrevInstListHCU32.IndexOf(NewInstListHCU32[i]) = -1) then
begin
// 새로 설치된 프로그램 확인
if RemoveInstall(HKEY_USERS, NewInstListHCU32[i]) then
NewInstListHCU32.Delete(i);
end;
end;
PrevInstListHCU32.Clear;
PrevInstListHCU32.AddStrings(NewInstListHCU32);
end else
PrevInstListHCU32.AddStrings(NewInstListHCU32);
// HKEY_LOCAL_MACHINE 32
if PrevInstListHLM32.Count > 0 then
begin
for i := NewInstListHLM32.Count - 1 downto 0 do
begin
if Terminated or GetWorkStop then
exit;
if (PrevInstListHLM32.Count > 0) and
(PrevInstListHLM32.IndexOf(NewInstListHLM32[i]) = -1) then
begin
// 새로 설치된 프로그램 확인
if RemoveInstall(HKEY_LOCAL_MACHINE, NewInstListHLM32[i]) then
NewInstListHLM32.Delete(i);
end;
end;
PrevInstListHLM32.Clear;
PrevInstListHLM32.AddStrings(NewInstListHLM32);
end else
PrevInstListHLM32.AddStrings(NewInstListHLM32);
{$ENDIF}
// HKEY_USERS
if PrevInstListHCU.Count > 0 then
begin
for i := NewInstListHCU.Count - 1 downto 0 do
begin
if (PrevInstListHCU.Count > 0) and
(PrevInstListHCU.IndexOf(NewInstListHCU[i]) = -1) then
begin
// 새로 설치된 프로그램 확인
if RemoveInstall(HKEY_USERS, NewInstListHCU[i]) then
NewInstListHCU.Delete(i);
end;
end;
PrevInstListHCU.Clear;
PrevInstListHCU.AddStrings(NewInstListHCU);
end else
PrevInstListHCU.AddStrings(NewInstListHCU);
// HKEY_LOCAL_MACHINE
if PrevInstListHLM.Count > 0 then
begin
for i := NewInstListHLM.Count - 1 downto 0 do
begin
if Terminated or GetWorkStop then
exit;
if (PrevInstListHLM.Count > 0) and
(PrevInstListHLM.IndexOf(NewInstListHLM[i]) = -1) then
begin
// 새로 설치된 프로그램 확인
if RemoveInstall(HKEY_LOCAL_MACHINE, NewInstListHLM[i]) then
NewInstListHLM.Delete(i);
end;
end;
PrevInstListHLM.Clear;
PrevInstListHLM.AddStrings(NewInstListHLM);
end else
PrevInstListHLM.AddStrings(NewInstListHLM);
Sleep(1000);
except
on E: Exception do
ETgException.TraceException(Self, E, 'Fail .. Execute()');
end;
end;
end;
end.