From f1fcdcfbc3738c608d8e687b93c3884238787b7d Mon Sep 17 00:00:00 2001
From: marcoonthegit <marco@freepascal.org>
Date: Wed, 14 Jun 2023 14:22:08 +0200
Subject: [PATCH] * Switched from waitformultiple objects to -handles for xp/w7
 compat, closes 40297

---
 packages/fcl-base/src/syncobjs.pp | 63 ++++++++++++++++++++-----------
 rtl/win/systhrd.inc               | 28 +++++++-------
 2 files changed, 54 insertions(+), 37 deletions(-)

diff --git a/packages/fcl-base/src/syncobjs.pp b/packages/fcl-base/src/syncobjs.pp
index c36491a3e8..830f11ad04 100644
--- a/packages/fcl-base/src/syncobjs.pp
+++ b/packages/fcl-base/src/syncobjs.pp
@@ -100,7 +100,7 @@ implementation
 {$ifdef MSWindows}
 uses Windows;
 
-function CoWaitForMultipleObjects(nCount:DWORD; lpHandles : PWOHandleArray; bWaitAll:WINBOOL; dwMilliseconds:DWORD):DWORD; external 'kernel32' name 'CoWaitForMultipleObjects';
+function CoWaitForMultipleHandles(dwFlags, dwTimeout: DWORD; cHandles: ULONG; pHandles: PWOHandleArray; out lpdwindex: DWORD): HRESULT; stdcall; external 'ole32.dll' name 'CoWaitForMultipleHandles';
 {$endif}
 
 
@@ -204,30 +204,51 @@ end;
 
 {$IFDEF MSWINDOWS}
 class function THandleObject.WaitForMultiple(const HandleObjs: THandleObjectArray; Timeout: Cardinal; AAll: Boolean; out SignaledObj: THandleObject; UseCOMWait: Boolean = False; Len: Integer = 0): TWaitResult;
+const COWAIT_DEFAULT = 0;
+      COWAIT_WAITALL = 1;
+      RPC_S_CALLPENDING = HRESULT($80010115);
 var
-  ret: Integer;
-  AmountHandles: Integer;
+  HandleIndex: SizeInt;
+  ret, CoWaitFlags, SignaledIndex: DWord;
+  WOHandles: TWOHandleArray;
 begin
-  AmountHandles := Length(HandleObjs);
-  if AmountHandles = 0 then
+  if Len = 0 then
+    Len := Length(HandleObjs);
+
+  if Len = 0 then
     raise ESyncObjectException.Create(SErrEventZeroNotAllowed);
 
-  if AmountHandles > MAXIMUM_WAIT_OBJECTS then
-    raise ESyncObjectException.CreateFmt(SErrEventMaxObjects, [MAXIMUM_WAIT_OBJECTS]);
-
-  if Len > AmountHandles then
+  if Len > Length(HandleObjs) then
     raise ESyncObjectException.Create(SErrEventTooManyHandles);
 
+  if Len > MAXIMUM_WAIT_OBJECTS then
+    raise ESyncObjectException.CreateFmt(SErrEventMaxObjects, [MAXIMUM_WAIT_OBJECTS]);
+
+  for HandleIndex := 0 to Len - 1 do
+    WOHandles[HandleIndex] := Windows.HANDLE(HandleObjs[HandleIndex].Handle);
+
   // what about UseCOMWait?
-  {$IFDEF MSWINDOWS}
   if UseCOMWait Then
     begin
-      SetLastError(ERROR_SUCCESS); // only for "alertable" objects
-      ret := CoWaitForMultipleObjects(Len, @HandleObjs, AAll, Timeout);
-    end
-  else
-  {$ENDIF}
-    ret := WaitForMultipleObjects(Len, @HandleObjs, AAll, Timeout);
+      SetLastError(ERROR_SUCCESS); // workaround for mutexes, see docs on CoWaitForMultipleHandles.
+      CoWaitFlags := COWAIT_DEFAULT;
+      if AAll then
+        CoWaitFlags := CoWaitFlags or COWAIT_WAITALL;
+      case CoWaitForMultipleHandles(CoWaitFlags, Timeout, Len, @WOHandles, SignaledIndex) of
+        S_OK:
+          begin
+            if not AAll then
+              SignaledObj := HandleObjs[SignaledIndex];
+            Exit(wrSignaled);
+          end;
+        RPC_S_CALLPENDING:
+          Exit(wrTimeout);
+        else
+          Exit(wrError);
+      end;
+    end;
+
+  ret := WaitForMultipleObjects(Len, @WOHandles, AAll, Timeout);
 
   if (ret >= WAIT_OBJECT_0) and (ret < (WAIT_OBJECT_0 + Len)) then
     begin
@@ -245,13 +266,9 @@ begin
 
   case ret of
     WAIT_TIMEOUT:
-      begin
-        Result := wrTimeout;
-      end;
-    Integer(WAIT_FAILED): // w/o: Warning: Range check error while evaluating constants (4294967295 must be between -2147483648 and 2147483647)
-      begin
-        Result := wrError;
-      end;
+      Result := wrTimeout;
+    else
+      Result := wrError;
   end;
 end;
 {$endif}
diff --git a/rtl/win/systhrd.inc b/rtl/win/systhrd.inc
index 588d0a815c..9de93f15fe 100644
--- a/rtl/win/systhrd.inc
+++ b/rtl/win/systhrd.inc
@@ -545,25 +545,25 @@ end;
 type 
       PWOHandleArray = ^THandle;
 
-function CoWaitForMultipleObjects(nCount:DWORD; lpHandles : PWOHandleArray; bWaitAll:LONGBOOL; dwMilliseconds:DWORD):DWORD; external 'ole32.dll' name 'CoWaitForMultipleObjects';
+function CoWaitForMultipleHandles(dwFlags, dwTimeout: DWORD; cHandles: uint32; pHandles: PWOHandleArray; out lpdwindex: DWORD): HRESULT; stdcall; external 'ole32.dll' name 'CoWaitForMultipleHandles';
 
 function intbasiceventWaitFor(Timeout : Cardinal;state:peventstate;UseCOMWait: Boolean = False) : longint;
-
-var ret : Integer;
+const COWAIT_DEFAULT = 0;
+      RPC_S_CALLPENDING = HRESULT($80010115);
+var SignaledIndex : DWORD;
 begin
    if UseComWait Then
-     ret:=CoWaitForMultipleObjects(1,PWOHandleArray(@state), True, Timeout)
+     case CoWaitForMultipleHandles(COWAIT_DEFAULT, Timeout, 1, PWOHandleArray(@state), SignaledIndex) of
+       S_OK: Result := wrSignaled;
+       RPC_S_CALLPENDING: Result := wrTimeout;
+       else Result := wrError;
+     end
    else 
-     ret:=WaitForSingleObject(THandle(state), Timeout);
-
-   case ret of
-    WAIT_ABANDONED: Result := wrAbandoned;
-    WAIT_OBJECT_0: Result := wrSignaled;
-    WAIT_TIMEOUT: Result := wrTimeout;
-    WAIT_FAILED: Result := wrError;
-  else
-    Result := wrError;
-  end;
+     case WaitForSingleObject(THandle(state), Timeout) of
+       WAIT_OBJECT_0: Result := wrSignaled;
+       WAIT_TIMEOUT: Result := wrTimeout;
+       else result := wrError; { WAIT_FAILED or any other value. Note that only mutex waits can return WAIT_ABANDONED. }
+     end;
 end;
 
 function intRTLEventCreate: PRTLEvent;