paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-11-19 18:53:30 +01:00
Code Issues Packages Projects Releases Wiki Activity

FpDebug: Windows (10 up), use WaitForDebugEventEx to support Utf16 OutputDebugStringW

Browse Source
This commit is contained in:
Martin 2023-02-04 08:52:29 +01:00
parent db4c129b21
commit e3a3d33c99
1 changed files with 6 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
components/fpdebug/fpdbgwinclasses.pas
View File

@ -328,6 +328,7 @@ var
_Wow64SuspendThread: function (hThread:HANDLE):DWORD; stdcall = nil;
_DebugBreakProcess: function(Process:HANDLE): WINBOOL; stdcall = nil;
_GetThreadDescription: function(hThread: THandle; ppszThreadDescription: PPWSTR): HResult; stdcall = nil;
_WaitForDebugEventEx: function(var lpDebugEvent: TDebugEvent; dwMilliseconds: DWORD): BOOL; stdcall = nil;
procedure LoadKernelEntryPoints;
var
@ -352,6 +353,7 @@ begin
Pointer(_Wow64SetThreadContext) := GetProcAddress(hMod, 'Wow64SetThreadContext');
Pointer(_Wow64SuspendThread) := GetProcAddress(hMod, 'Wow64SuspendThread');
{$endif}
Pointer(_WaitForDebugEventEx) := GetProcAddress(hMod, 'WaitForDebugEventEx');
DebugLn(DBG_WARNINGS and (DebugBreakAddr = nil), ['WARNING: Failed to get DebugBreakAddr']);
DebugLn(DBG_WARNINGS and (_CreateRemoteThread = nil), ['WARNING: Failed to get CreateRemoteThread']);
@ -954,7 +956,10 @@ var
begin
repeat
Done := True;
result := Windows.WaitForDebugEvent(MDebugEvent, INFINITE);
if _WaitForDebugEventEx <> nil then
result := _WaitForDebugEventEx(MDebugEvent, INFINITE)
else
result := Windows.WaitForDebugEvent(MDebugEvent, INFINITE);
DebugLn(FPDBG_WINDOWS and (not Result), 'WaitForDebugEvent failed: %d', [Windows.GetLastError]);
if Result and FTerminated and (MDebugEvent.dwDebugEventCode <> EXIT_PROCESS_DEBUG_EVENT)