From 9661df2c722041fe4586c13315f5a6844b4e0a8a Mon Sep 17 00:00:00 2001
From: Pavel <68122101+red-prig@users.noreply.github.com>
Date: Mon, 3 Feb 2025 17:01:52 +0300
Subject: [PATCH] ms shell hack

This hack explicitly prevents third-party shell extensions from injecting into other threads.
---
 fpPS4.lpi             |   4 ++
 gui/game_edit.pas     |   7 ++
 gui/main.pas          |  12 +++-
 gui/ms_shell_hack.pas | 159 ++++++++++++++++++++++++++++++++++++++++++
 4 files changed, 180 insertions(+), 2 deletions(-)
 create mode 100644 gui/ms_shell_hack.pas

diff --git a/fpPS4.lpi b/fpPS4.lpi
index 36e9ae33..8d8e5630 100644
--- a/fpPS4.lpi
+++ b/fpPS4.lpi
@@ -1566,6 +1566,10 @@
         <Filename Value="sys\dev\dev_random.pas"/>
         <IsPartOfProject Value="True"/>
       </Unit>
+      <Unit>
+        <Filename Value="gui\ms_shell_hack.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
     </Units>
   </ProjectOptions>
   <CompilerOptions>
diff --git a/gui/game_edit.pas b/gui/game_edit.pas
index ef74c50e..f3c457c1 100644
--- a/gui/game_edit.pas
+++ b/gui/game_edit.pas
@@ -8,6 +8,8 @@ uses
   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ComCtrls, ExtCtrls,
   StdCtrls, Grids,
 
+  ms_shell_hack,
+
   game_info,
   param_sfo_gui;
 
@@ -96,7 +98,10 @@ type
 procedure TButtonPath.OpenDir(Sender:TObject);
 var
  d:TSelectDirectoryDialog;
+ Cookie:Pointer;
 begin
+ Cookie:=RegisterDllHack;
+
  d:=nil;
 
  try
@@ -120,6 +125,8 @@ begin
  end;
  FreeAndNil(d);
 
+ UnregisterDllHack(Cookie);
+
  TfrmGameEditor(Self.Form).LoadParamSfo(True);
 
  Hide;
diff --git a/gui/main.pas b/gui/main.pas
index 6b2022e0..ee185585 100644
--- a/gui/main.pas
+++ b/gui/main.pas
@@ -22,6 +22,8 @@ uses
   Rtti,
   jsonscanner,
 
+  ms_shell_hack,
+
   host_ipc,
   game_info,
   game_edit,
@@ -1128,8 +1130,12 @@ procedure TfrmMain.MIAddFolderClick(Sender: TObject);
 var
  d:TSelectDirectoryDialog;
  form:TfrmGameEditor;
+
+ Cookie:Pointer;
 begin
- d:=TSelectDirectoryDialog.Create(nil);
+ Cookie:=RegisterDllHack;
+
+ d:=TSelectDirectoryDialog.Create(Self);
 
  //d.InitialDir:=
 
@@ -1151,7 +1157,9 @@ begin
   form.FormInit(True);
  end;
 
- d.Free;
+ FreeAndNil(d);
+
+ UnregisterDllHack(Cookie);
 end;
 
 procedure TfrmMain.MIEditClick(Sender: TObject);
diff --git a/gui/ms_shell_hack.pas b/gui/ms_shell_hack.pas
new file mode 100644
index 00000000..d625c2a2
--- /dev/null
+++ b/gui/ms_shell_hack.pas
@@ -0,0 +1,159 @@
+unit ms_shell_hack;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+function  RegisterDllHack:Pointer;
+Procedure UnregisterDllHack(Cookie:Pointer);
+
+implementation
+
+Uses
+ sysutils,
+ windows,
+ ntapi,
+ versionresource,
+ versiontypes,
+ CharStream;
+
+type
+ P_LDR_DLL_NOTIFICATION_DATA=^LDR_DLL_NOTIFICATION_DATA;
+ LDR_DLL_NOTIFICATION_DATA=record
+  Flags      :ULONG;
+  FullDllName:PUNICODE_STRING;
+  BaseDllName:PUNICODE_STRING;
+  DllBase    :Pointer;
+  SizeOfImage:ULONG;
+ end;
+
+type
+ TLdrDllNotification=procedure(
+  NotificationReason:ULONG;
+  NotificationData  :P_LDR_DLL_NOTIFICATION_DATA;
+  Context           :Pointer
+ ); MS_ABI_Default;
+
+function LdrRegisterDllNotification(
+          Flags        :ULONG;
+          NotifFunction:TLdrDllNotification;
+          Context      :Pointer;
+          Cookie       :PPointer
+         ):DWORD; MS_ABI_Default; external 'ntdll';
+
+function LdrUnregisterDllNotification(
+          Cookie:Pointer
+         ):DWORD; MS_ABI_Default; external 'ntdll';
+
+function LdrResSearchResource(
+          DllBase            :Pointer;
+          ResIds             :PULONG_PTR;
+          ResIdCount         :ULONG;
+          Flags              :ULONG;
+          Resource           :PPointer;
+          Size               :PULONG_PTR;
+          FoundLanguage      :PUSHORT;
+          FoundLanguageLength:PULONG
+         ):DWORD; MS_ABI_Default; external 'ntdll';
+
+const
+ RT_VERSION=16;
+ CREATEPROCESS_MANIFEST_RESOURCE_ID=1;
+
+ IdPath:array[0..2] of ULONG_PTR=(
+  RT_VERSION,
+  CREATEPROCESS_MANIFEST_RESOURCE_ID,
+  0
+ );
+
+Function GetCompanyName(Data:Pointer;Size:ULONG_PTR):RawByteString;
+label
+ _exit;
+var
+ VR:TVersionResource;
+ SI:TVersionStringFileInfo;
+ ST:TVersionStringTable;
+ mem:TPCharStream;
+
+ i,k:Integer;
+begin
+ Result:='';
+
+ mem:=TPCharStream.Create(Data,Size);
+
+ VR:=TVersionResource.Create;
+ VR.SetCustomRawDataStream(mem);
+ VR.UpdateRawData;
+ SI:=VR.StringFileInfo;
+
+ if (SI.Count<>0) then
+ For i:=0 to SI.Count-1 do
+ begin
+  ST:=SI[i];
+  //
+  if (ST.Count<>0) then
+  begin
+   For k:=0 to ST.Count-1 do
+   begin
+    if (ST.Keys[k]='CompanyName') then
+    begin
+     Result:=ST.ValuesByIndex[k];
+     goto _exit;
+    end;
+   end;
+  end;
+  //
+ end;
+
+ _exit:
+
+ FreeAndNil(VR);
+ FreeAndNil(mem);
+end;
+
+procedure LdrDllNotification(
+  NotificationReason:ULONG;
+  NotificationData  :P_LDR_DLL_NOTIFICATION_DATA;
+  Context           :Pointer
+ ); MS_ABI_Default;
+var
+ Data:Pointer;
+ Size:ULONG_PTR;
+begin
+ if (NotificationReason<>1) then Exit;
+
+ Data:=nil;
+ Size:=0;
+
+ LdrResSearchResource(
+  NotificationData^.DllBase,
+  @IdPath,
+  3,
+  0,
+  @Data,
+  @Size,
+  nil,
+  nil
+ );
+
+ if (Data=nil) then Exit;
+
+ if (GetCompanyName(Data,Size)='Microsoft Corporation') then Exit;
+
+ DisableThreadLibraryCalls(QWORD(NotificationData^.DllBase));
+end;
+
+function RegisterDllHack:Pointer;
+begin
+ Result:=nil;
+ LdrRegisterDllNotification(0,@LdrDllNotification,nil,@Result);
+end;
+
+Procedure UnregisterDllHack(Cookie:Pointer);
+begin
+ LdrUnregisterDllNotification(Cookie);
+end;
+
+
+end.
+