paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-05 23:58:06 +02:00
Code Issues Packages Projects Releases Wiki Activity

LazDebuggerGdbmi, Windows: New app to send signal to target when cross-debugging

Browse Source 
git-svn-id: trunk@61088 -
This commit is contained in:
martin 2019-04-30 17:38:13 +00:00
parent 03a5db19e3
commit 76489254d5
3 changed files with 168 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitattributes vendored
View File

@ -2591,6 +2591,8 @@ components/lazcontrols/treefilteredit.pas svneol=native#text/plain
components/lazdebuggergdbmi/Makefile svneol=native#text/plain
components/lazdebuggergdbmi/Makefile.compiled svneol=native#text/plain
components/lazdebuggergdbmi/Makefile.fpc svneol=native#text/plain
components/lazdebuggergdbmi/apps/lazgdebugcontrol/LazGDeBugControl.lpi svneol=native#text/plain
components/lazdebuggergdbmi/apps/lazgdebugcontrol/LazGDeBugControl.lpr svneol=native#text/plain
components/lazdebuggergdbmi/cmdlinedebugger.pp svneol=native#text/pascal
components/lazdebuggergdbmi/debugutils.pp svneol=native#text/pascal
components/lazdebuggergdbmi/fpmake.pp svneol=native#text/plain

85
components/lazdebuggergdbmi/apps/lazgdebugcontrol/LazGDeBugControl.lpi Normal file
View File

@ -0,0 +1,85 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="12"/>
<PathDelim Value="\"/>
<General>
<Flags>
<MainUnitHasCreateFormStatements Value="False"/>
<MainUnitHasTitleStatement Value="False"/>
<MainUnitHasScaledStatement Value="False"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<Title Value="LazGDeBugControl"/>
<UseAppBundle Value="False"/>
<ResourceType Value="res"/>
</General>
<BuildModes>
<Item Name="32Bit" Default="True"/>
<Item Name="64Bit">
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="LazGDeBugControl"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<CodeGeneration>
<TargetCPU Value="x86_64"/>
<TargetOS Value="win64"/>
</CodeGeneration>
</CompilerOptions>
</Item>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<UseFileFilters Value="True"/>
</PublishOptions>
<RunParams>
<FormatVersion Value="2"/>
<Modes Count="0"/>
</RunParams>
<RequiredPackages Count="1">
<Item1>
<PackageName Value="LazUtils"/>
</Item1>
</RequiredPackages>
<Units>
<Unit>
<Filename Value="LazGDeBugControl.lpr"/>
<IsPartOfProject Value="True"/>
</Unit>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="LazGDeBugControl"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<CodeGeneration>
<TargetCPU Value="i386"/>
<TargetOS Value="win32"/>
</CodeGeneration>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

81
components/lazdebuggergdbmi/apps/lazgdebugcontrol/LazGDeBugControl.lpr Normal file
View File

@ -0,0 +1,81 @@
program LazGDeBugControl;
{off $DEFINE OLD_DebugBreak}
uses sysutils, windows;
var
s: string;
{$IFDEF OLD_DebugBreak}
DebugBreakAddr: Pointer = nil;
_CreateRemoteThread: function(hProcess: THandle; lpThreadAttributes: Pointer; dwStackSize: DWORD; lpStartAddress: TFNThreadStartRoutine; lpParameter: Pointer; dwCreationFlags: DWORD; var lpThreadId: DWORD): THandle; stdcall = nil;
PauseRequestInThreadID: DWORD;
hThread: HANDLE;
{$ELSE}
DebugBreakProcess: function(hProcess: THandle): WINBOOL; stdcall = nil;
{$ENDIF}
pid: LongInt;
hMod: HMODULE;
hProcess: HANDLE;
begin
hProcess := 0;
try
hMod := GetModuleHandle(kernel32);
if hMod = 0 then
Exit;
{$IFDEF OLD_DebugBreak}
DebugBreakAddr := GetProcAddress(hMod, 'DebugBreak');
Pointer(_CreateRemoteThread) := GetProcAddress(hMod, 'CreateRemoteThread');
if (DebugBreakAddr = nil) or (_CreateRemoteThread = nil) then
exit;
{$ELSE}
Pointer(DebugBreakProcess) := GetProcAddress(hMod, 'DebugBreakProcess');
if (DebugBreakProcess = nil) then
exit;
{$ENDIF}
writeln('Ready');
while true do begin
readln(s);
if s = 'exit' then
exit;
pid := StrToInt(s);
if pid = 0 then
exit;
hProcess := OpenProcess(PROCESS_CREATE_THREAD or PROCESS_QUERY_INFORMATION or PROCESS_VM_OPERATION or PROCESS_VM_WRITE or PROCESS_VM_READ, False, pid);
if hProcess = 0 then
exit;
{$IFDEF OLD_DebugBreak}
hThread := _CreateRemoteThread(hProcess, nil, 0, DebugBreakAddr, nil, 0, PauseRequestInThreadID);
if hThread = 0
then begin
writeln('Error: ', GetLastError);
Exit;
end;
writeln('OK');
CloseHandle(hThread);
{$ELSE}
if DebugBreakProcess(hProcess) then
writeln('OK')
else
begin
writeln('Error: ', GetLastError);
exit;
end;
{$ENDIF}
CloseHandle(hProcess);
hProcess := 0;
end;
finally
writeln('Bye');
if hProcess <> 0 then
CloseHandle(hProcess);
end;
end.