FPPS4/gui/ms_shell_hack.pas

160 lines
2.9 KiB
Plaintext

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.