From 859b0231be31e47a9f1a3b61970f8ed570a0b95b Mon Sep 17 00:00:00 2001 From: zizzo81 Date: Tue, 17 Mar 2026 16:54:28 +0100 Subject: [PATCH] Managed UIPI under Vista+ --- Demo/RxMain.dfm | 181 +++++++++++++++++++++++----------------- Demo/RxMain.pas | 85 ++++++++++++------- README.md | 22 ++++- Source/WMsgReceiver.pas | 120 ++++++++++++++++++++++++-- 4 files changed, 294 insertions(+), 114 deletions(-) diff --git a/Demo/RxMain.dfm b/Demo/RxMain.dfm index 4941769..2a2f329 100644 --- a/Demo/RxMain.dfm +++ b/Demo/RxMain.dfm @@ -1,75 +1,106 @@ -object RXForm: TRXForm - Left = 0 - Top = 0 - BorderWidth = 4 - Caption = 'Receiver' - ClientHeight = 347 - ClientWidth = 440 - Color = clBtnFace - Font.Charset = DEFAULT_CHARSET - Font.Color = clWindowText - Font.Height = -11 - Font.Name = 'Tahoma' - Font.Style = [] - OnDestroy = FormDestroy - TextHeight = 13 - object Memo: TMemo - Left = 0 - Top = 32 - Width = 440 - Height = 315 - Align = alClient - ReadOnly = True - ScrollBars = ssVertical - TabOrder = 0 - end - object TopPanel: TPanel - Left = 0 - Top = 0 - Width = 440 - Height = 32 - Align = alTop - BevelOuter = bvNone - BorderWidth = 4 - TabOrder = 1 - DesignSize = ( - 440 - 32) - object ReceiverEdit: TEdit - Left = 4 - Top = 4 - Width = 121 - Height = 24 - Align = alLeft - TabOrder = 0 - Text = 'ReceiverWindow' - ExplicitHeight = 21 - end - object btnStart: TButton - Left = 284 - Top = 2 - Width = 75 - Height = 24 - Anchors = [akTop, akRight] - Caption = 'Start' - TabOrder = 1 - OnClick = btnStartClick - end - object btnStop: TButton - Left = 365 - Top = 2 - Width = 75 - Height = 24 - Anchors = [akTop, akRight, akBottom] - Caption = 'Stop' - TabOrder = 2 - OnClick = btnStopClick - end - end - object WMsgReceiver: TWMsgReceiver - WindowName = 'DefaultWindow' - OnMessageReceived = WMsgReceiverMessageReceived - Left = 312 - Top = 184 - end -end +object RXForm: TRXForm + Left = 0 + Top = 0 + BorderWidth = 4 + Caption = 'Receiver' + ClientHeight = 347 + ClientWidth = 440 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + OnCreate = FormCreate + OnDestroy = FormDestroy + TextHeight = 13 + object Memo: TMemo + Left = 0 + Top = 64 + Width = 440 + Height = 283 + Align = alClient + ReadOnly = True + ScrollBars = ssVertical + TabOrder = 0 + ExplicitTop = 32 + ExplicitHeight = 315 + end + object TopPanel: TPanel + Left = 0 + Top = 0 + Width = 440 + Height = 32 + Align = alTop + BevelOuter = bvNone + BorderWidth = 4 + TabOrder = 1 + DesignSize = ( + 440 + 32) + object ReceiverEdit: TEdit + Left = 4 + Top = 4 + Width = 121 + Height = 24 + Align = alLeft + TabOrder = 0 + Text = 'ReceiverWindow' + OnChange = ReceiverEditChange + ExplicitHeight = 21 + end + object btnStart: TButton + Left = 284 + Top = 2 + Width = 75 + Height = 24 + Anchors = [akTop, akRight, akBottom] + Caption = 'Start' + TabOrder = 1 + OnClick = btnStartClick + end + object btnStop: TButton + Left = 365 + Top = 2 + Width = 75 + Height = 24 + Anchors = [akTop, akRight, akBottom] + Caption = 'Stop' + Enabled = False + TabOrder = 2 + OnClick = btnStopClick + end + end + object SubPanel: TPanel + Left = 0 + Top = 32 + Width = 440 + Height = 32 + Align = alTop + BevelOuter = bvNone + BorderWidth = 4 + TabOrder = 2 + ExplicitTop = 8 + DesignSize = ( + 440 + 32) + object chkUIPI: TCheckBox + Left = 4 + Top = 6 + Width = 436 + Height = 17 + Anchors = [akLeft, akTop, akRight] + Caption = 'Enable messages from processes with lower user execution level' + TabOrder = 0 + OnClick = chkUIPIClick + end + end + object WMsgReceiver: TWMsgReceiver + Active = False + LowProcessMessages = False + WindowName = 'DefaultWindow' + OnMessageReceived = WMsgReceiverMessageReceived + Left = 312 + Top = 184 + end +end diff --git a/Demo/RxMain.pas b/Demo/RxMain.pas index 64bac70..1c5d04a 100644 --- a/Demo/RxMain.pas +++ b/Demo/RxMain.pas @@ -3,11 +3,7 @@ interface uses - Winapi.Windows, Winapi.Messages, - System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, - Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls,Vcl.ExtCtrls, - - WMsgReceiver; + Forms, Classes, Controls, StdCtrls, ExtCtrls, WMsgReceiver; type TRXForm = class(TForm) @@ -17,16 +13,18 @@ TRXForm = class(TForm) btnStart: TButton; btnStop: TButton; WMsgReceiver: TWMsgReceiver; + SubPanel: TPanel; + chkUIPI: TCheckBox; procedure FormDestroy(Sender: TObject); procedure btnStartClick(Sender: TObject); procedure btnStopClick(Sender: TObject); procedure WMsgReceiverMessageReceived(aID: Cardinal; aMsg: string); + procedure ReceiverEditChange(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure chkUIPIClick(Sender: TObject); private - { Private declarations } - procedure StopTheReceiver; - public - { Public declarations } + procedure UpdateUI; end; var @@ -37,42 +35,69 @@ implementation {$R *.dfm} uses - WMsgCommon; + SysUtils, Windows, WMsgCommon; + +function IsRunAsAdministrator: Boolean; +const + ELEVATION_FULL = 2; +var + hToken: THandle; + dwElevation, dwSize: Cardinal; +begin + Result := False; + if OpenProcessToken(GetCurrentProcess, TOKEN_QUERY, hToken) then try + dwElevation := 0; + Result := (GetTokenInformation(hToken, TokenElevationType, @dwElevation, SizeOf(Cardinal), dwSize)) and (dwElevation = ELEVATION_FULL); + dwElevation := 0; + Result := Result or (((GetTokenInformation(hToken, TokenElevation, @dwElevation, SizeOf(Cardinal), dwSize))) and (dwElevation > 0)) + finally + CloseHandle(hToken) + end +end; procedure TRXForm.btnStartClick(Sender: TObject); begin - StopTheReceiver; + if Length(Trim(ReceiverEdit.Text)) = 0 then + ReceiverEdit.Text := WMSG_DEFAULT_WINDOW; - WMsgReceiver.OnMessageReceived := WMsgReceiverMessageReceived; - if not (Trim(ReceiverEdit.Text) = '') - then - begin - WMsgReceiver.WindowName := ReceiverEdit.Text - end - else - begin - WMsgReceiver.WindowName := WMSG_DEFAULT_WINDOW; - ReceiverEdit.Text := WMsgReceiver.WindowName; - end; + WMsgReceiver.WindowName := ReceiverEdit.Text; WMsgReceiver.Start; + UpdateUI end; procedure TRXForm.btnStopClick(Sender: TObject); begin - StopTheReceiver; + WMsgReceiver.Stop; + UpdateUI end; +procedure TRXForm.chkUIPIClick(Sender: TObject); +begin + WMsgReceiver.LowProcessMessages := chkUIPI.Checked +end; + +procedure TRXForm.FormCreate(Sender: TObject); +begin + chkUIPI.Enabled := IsRunAsAdministrator +end; + procedure TRXForm.FormDestroy(Sender: TObject); begin - StopTheReceiver; -end; - -procedure TRXForm.StopTheReceiver; -begin - WMsgReceiver.OnMessageReceived := nil; - WMsgReceiver.Stop; + WMsgReceiver.Stop end; +procedure TRXForm.ReceiverEditChange(Sender: TObject); +begin + UpdateUI +end; + +procedure TRXForm.UpdateUI; +begin + ReceiverEdit.Enabled := not WMsgReceiver.Active; + btnStart.Enabled := not WMsgReceiver.Active and (Length(Trim(ReceiverEdit.Text)) > 0); + btnStop.Enabled := WMsgReceiver.Active +end; + procedure TRXForm.WMsgReceiverMessageReceived(aID: Cardinal; aMsg: string); begin Memo.Lines.Add(aID.ToString +', '+ aMsg); diff --git a/README.md b/README.md index 2f57471..8515f1a 100644 --- a/README.md +++ b/README.md @@ -51,6 +51,24 @@ Window Names: WM_COPYDATA relies on finding the target window handle by name. En Data Limits: While WM_COPYDATA is efficient, it is intended for small-to-medium data packets. For multi-gigabyte transfers, consider memory-mapped files. +## ⚠️ Limitations + +### User Interface Privilege Isolation + +Under Windows Vista and later, UIPI prevents by default certain messages, including `WM_COPYDATA` being delivered from lower execution level process to higher execution level processes. APIs have been introduced for a high execution level process to allow these to be delivered to himself. Under Vista the isolation can be turned off for a certain message at process level, this means all windows created by the same process receive the message after being enabled, starting from Windows 7 isolation is at window level, meaning each window can set its own accepted messages. + +The code has been written to take advantage from the later and, if not available, from the previous, while maintaining retro compatibility with pre-Vista operating systems. + +A new `LowProcessMessages` property has been added to the `TWMsgReceiver` component, setting it to true will allow lower execution level processes' messages to be delivered to the elevated receiver. + +Settings this into low execution level processes has no effect. + +To test this, execute `TxDemo.exe` normally while running `RxDemo.exe` as Administrator. + +### Windows Stations isolation + +This component it not designed to be used in case you need IPC for processes running under different windows stations, for example if you need a desktop or console application which is running under the interactive user windows station (`WinSta0`) to communicate with a service (which is running in Session 0). + # 📄 License This project is licensed under the MIT License - see the LICENSE file for details. @@ -66,6 +84,4 @@ If you have questions, find a bug, or want to suggest a feature for the **Window * **Website:** [latitude53north.co.uk](https://latitude53north.co.uk) > [!TIP] -> If you encounter an issue with window handle detection, please include your Windows version and Delphi edition in the [Issue Tracker](https://github.com/antonydanby/WindowsMessaging/issues). -> -> \ No newline at end of file +> If you encounter an issue with window handle detection, please include your Windows version and Delphi edition in the [Issue Tracker](https://github.com/antonydanby/WindowsMessaging/issues). \ No newline at end of file diff --git a/Source/WMsgReceiver.pas b/Source/WMsgReceiver.pas index 4503020..8b9c202 100644 --- a/Source/WMsgReceiver.pas +++ b/Source/WMsgReceiver.pas @@ -52,7 +52,9 @@ interface TReceivedMessage = procedure(aID: cardinal; aMsg: string) of object; TWMsgReceiver = class(TComponent) - protected + private + fActive: boolean; + fLowProcessMessages: boolean; fWindowName: string; fWndHandle: HWND; fOnMessageReceived: TReceivedMessage; @@ -62,8 +64,13 @@ TWMsgReceiver = class(TComponent) procedure CreateTheWindow(const aWindowName: string); overload; procedure DestroyWindowAndDeRegister; + function GetActive: boolean; function GetWindowName: string; + procedure SetActive(const Value: boolean); procedure SetWindowName(const Value: string); + procedure SetLowProcessMessages(const Value: boolean); + protected + procedure Restart; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; @@ -71,7 +78,9 @@ TWMsgReceiver = class(TComponent) procedure Start; procedure Stop; - published + published + property Active: boolean read GetActive write SetActive; + property LowProcessMessages: boolean read fLowProcessMessages write SetLowProcessMessages; property WindowName: string read GetWindowName write SetWindowName; property OnMessageReceived: TReceivedMessage read fOnMessageReceived write fOnMessageReceived; end; @@ -83,6 +92,47 @@ implementation uses WMsgCommon; +const + MSGFLT_ADD = 1; + MSGFLT_REMOVE = 2; + +var + ChangeWindowMessageFilter: function(message: UINT; dwFlag: DWORD): BOOL; stdcall; + ChangeWindowMessageFilterEx: function(hWnd: HWND; message: UINT; action: DWORD; pChangeFilterStruct: Pointer): BOOL; stdcall; + +function EnableLowProcessMessages(hWnd: HWND; Enable: Boolean): Boolean; +var + hUser32: HMODULE; + dwMode: Cardinal; +begin + Result := False; + hUser32 := GetModuleHandle(user32); + + dwMode := MSGFLT_ADD; + if not Enable then + dwMode := MSGFLT_REMOVE; + + // 7+ setting is per-window + if not Assigned(ChangeWindowMessageFilterEx) then + ChangeWindowMessageFilterEx := GetProcAddress(hUser32, 'ChangeWindowMessageFilterEx'); + + if Assigned(ChangeWindowMessageFilterEx) then + begin + + Result := ChangeWindowMessageFilterEx(hWnd, WM_COPYDATA, dwMode, nil); + end; + + if Result then + Exit; + + // Vista+ setting is per process + if not Assigned(ChangeWindowMessageFilter) then + ChangeWindowMessageFilter := GetProcAddress(hUser32, 'ChangeWindowMessageFilter'); + + if Assigned(ChangeWindowMessageFilter) then + Result := ChangeWindowMessageFilter(WM_COPYDATA, dwMode) +end; + { TReceiver } procedure Register; @@ -95,6 +145,9 @@ constructor TWMsgReceiver.Create(AOwner: TComponent); inherited Create(AOwner); // Initializing the field to ensure we have a window name at construction fWindowName := WMSG_DEFAULT_WINDOW; + // Make sure to clear the variables. + fActive := false; + fWndHandle := 0; end; destructor TWMsgReceiver.Destroy; @@ -106,11 +159,17 @@ destructor TWMsgReceiver.Destroy; procedure TWMsgReceiver.DestroyWindowAndDeRegister; begin if fWndHandle <> 0 then DestroyWindow(fWndHandle); + // Ensure to reset the handle to zero. + fWndHandle := 0; Winapi.Windows.UnregisterClass(WINDOWS_MESSAGING_CLASS_NAME, HInstance); end; procedure TWMsgReceiver.Start; begin + // Avoid creating the window multiple times. + if Active then + Exit; + if fWindowName.IsEmpty then fWindowName := WMSG_DEFAULT_WINDOW; CreateTheWindow(fWindowName); end; @@ -140,9 +199,13 @@ procedure TWMsgReceiver.CreateTheWindow(const aWindowName: string); raise Exception.Create('Failed to create message window'); SetWindowLongPtr(fWndHandle, GWLP_USERDATA, LONG_PTR(Self)); + + // If necessary, enable messages through UIPI. + if LowProcessMessages then + EnableLowProcessMessages(fWndHandle, True) end; -class function TWMsgReceiver.StaticWndProc(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; +class function TWMsgReceiver.StaticWndProc(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; var Receiver: TWMsgReceiver; Msg: TMessage; @@ -175,6 +238,11 @@ procedure TWMsgReceiver.WndProc(var aMsg: TMessage); else aMsg.Result := DefWindowProc(fWndHandle, aMsg.Msg, aMsg.WParam, aMsg.LParam); end; +function TWMsgReceiver.GetActive: boolean; +begin + Result := fWndHandle > 0 +end; + function TWMsgReceiver.GetHandle: HWND; begin Result := fWndHandle; @@ -186,6 +254,49 @@ function TWMsgReceiver.GetWindowName: string; Result := fWindowName; end; +procedure TWMsgReceiver.Restart; +var + Running: boolean; +begin + // If not active does nothing. + if not Active then + Exit; + + // Store current status. + Running := Active; + + // Stop everything. + Active := False; + + // If it was running, restart it. + if Running then + Active := True +end; + +procedure TWMsgReceiver.SetActive(const Value: boolean); +begin + // Don't do this while in Delphi IDE, runtime only. + if (Value <> Active) and not(csDesigning in ComponentState) then + if Value then + Start + else + Stop +end; + +procedure TWMsgReceiver.SetLowProcessMessages(const Value: boolean); +begin + // Only act if changing it. + if Value = fLowProcessMessages then + Exit; + + // Changes the value. + fLowProcessMessages := Value; + + // Only applies it effectively on + if not (csDesigning in ComponentState) then + Restart +end; + procedure TWMsgReceiver.SetWindowName(const Value: string); begin // Setters are perfect for validation or side effects @@ -193,6 +304,3 @@ procedure TWMsgReceiver.SetWindowName(const Value: string); end; end. - - -