paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-06 09:07:59 +02:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source 
git-svn-id: trunk@35050 -
This commit is contained in:
Tomas Hajny 2016-12-03 23:35:20 +00:00
parent 85e485826a
commit e5ceb04725
3 changed files with 30 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
rtl/win/syswin.inc
View File

@ -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;

1
rtl/win32/system.pp
View File

@ -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}

1
rtl/win64/system.pp
View File

@ -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}