* patch by Dmitry Boyarintsev (bug #31023) implementing SysSetCtrlBreakHandler for Win32 and Win64

git-svn-id: trunk@35050 -

rtl/win/syswin.inc

@@ -722,3 +722,31 @@ procedure InitWin32Widestrings;
     DefaultRTLFileSystemCodePage:=DefaultSystemCodePage;
   end;
 
+type
+  WINBOOL = longbool;
+  PHANDLER_ROUTINE = function (dwCtrlType:DWORD):WINBOOL; stdcall;
+
+function SetConsoleCtrlHandler(HandlerRoutine:PHANDLER_ROUTINE; Add:WINBOOL):WINBOOL; stdcall; 
+  external 'kernel32' name 'SetConsoleCtrlHandler';
+
+function WinCtrlBreakHandler(dwCtrlType:DWORD): WINBOOL;stdcall;
+const
+  CTRL_BREAK_EVENT = 1;
+begin
+  if Assigned(CtrlBreakHandler) then 
+    Result:=CtrlBreakHandler((dwCtrlType and CTRL_BREAK_EVENT > 0))
+  else
+    Result:=false;
+end;
+
+function SysSetCtrlBreakHandler (Handler: TCtrlBreakHandler): TCtrlBreakHandler;
+begin
+  (* Return either nil or previous handler *)
+  if (Assigned(CtrlBreakHandler)) and (not Assigned(Handler)) then   
+    SetConsoleCtrlHandler(@WinCtrlBreakHandler, false)
+  else if (not Assigned(CtrlBreakHandler)) and (Assigned(Handler)) then
+    SetConsoleCtrlHandler(@WinCtrlBreakHandler, true);
+
+  SysSetCtrlBreakHandler := CtrlBreakHandler;
+  CtrlBreakHandler := Handler;
+end;

rtl/win32/system.pp

@@ -33,6 +33,7 @@ interface
 {$define HAS_WIDESTRINGMANAGER}
 {$define DISABLE_NO_DYNLIBS_MANAGER}
 {$define FPC_SYSTEM_HAS_SYSDLH}
+{$define FPC_HAS_SETCTRLBREAKHANDLER}
 
 {$ifdef FPC_USE_WIN32_SEH}
   {$define FPC_SYSTEM_HAS_RAISEEXCEPTION}

rtl/win64/system.pp

@@ -27,6 +27,7 @@ interface
 {$define HAS_WIDESTRINGMANAGER}
 {$define DISABLE_NO_DYNLIBS_MANAGER}
 {$define FPC_SYSTEM_HAS_SYSDLH}
+{$define FPC_HAS_SETCTRLBREAKHANDLER}
 
 {$ifdef FPC_USE_WIN64_SEH}
   {$define FPC_SYSTEM_HAS_RAISEEXCEPTION}