paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-11-04 12:49:42 +01:00
Code Issues Packages Projects Releases Wiki Activity

* Initial release

Browse Source 
git-svn-id: trunk@9133 -
This commit is contained in:
marc 2006-04-17 00:42:06 +00:00
parent e6b1bcdea6
commit b0be3088b7
11 changed files with 3275 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
.gitattributes vendored
View File

@ -565,6 +565,16 @@ debugger/watchesdlg.pp svneol=native#text/pascal
debugger/watchpropertydlg.lfm svneol=native#text/plain
debugger/watchpropertydlg.lrs svneol=native#text/pascal
debugger/watchpropertydlg.pp svneol=native#text/pascal
debugger/windebug/fpwd/README svneol=native#text/plain
debugger/windebug/fpwd/fpwd.lpi svneol=native#text/plain
debugger/windebug/fpwd/fpwd.lpr svneol=native#text/pascal
debugger/windebug/fpwd/fpwdcommand.pas svneol=native#text/pascal
debugger/windebug/fpwd/fpwdglobal.pas svneol=native#text/pascal
debugger/windebug/fpwd/fpwdloop.pas svneol=native#text/pascal
debugger/windebug/fpwd/fpwdpeimage.pas svneol=native#text/pascal
debugger/windebug/fpwd/fpwdtype.pas svneol=native#text/pascal
debugger/windebug/windebugger.pp svneol=native#text/pascal
debugger/windebug/windextra.pp svneol=native#text/pascal
designer/abstractcompiler.pp svneol=native#text/pascal
designer/abstracteditor.pp svneol=native#text/pascal
designer/abstractfilesystem.pp svneol=native#text/pascal

10
debugger/windebug/fpwd/README Normal file
View File

@ -0,0 +1,10 @@
---------------------------------------------------------------------------
fpwd - FP standalone windows debugger
---------------------------------------------------------------------------
fpwd is a concept Free Pascal Windows Debugger. It is mainly used to thest
the windebugger classes, but it may grow someday to a fully functional
debugger written in pascal. I hope you enjoy it.
Marc Weustink

389
debugger/windebug/fpwd/fpwd.lpi Normal file
View File

@ -0,0 +1,389 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<PathDelim Value="\"/>
<Version Value="5"/>
<General>
<MainUnit Value="0"/>
<IconPath Value="./"/>
<TargetFileExt Value=".exe"/>
<ActiveEditorIndexAtStart Value="3"/>
</General>
<LazDoc Paths=""/>
<PublishOptions>
<Version Value="2"/>
<IgnoreBinaries Value="False"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
</local>
</RunParams>
<RequiredPackages Count="1">
<Item1>
<PackageName Value="LCL"/>
</Item1>
</RequiredPackages>
<Units Count="18">
<Unit0>
<Filename Value="fpwd.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="fpwd"/>
<CursorPos X="3" Y="47"/>
<TopLine Value="25"/>
<EditorIndex Value="3"/>
<UsageCount Value="25"/>
<Loaded Value="True"/>
</Unit0>
<Unit1>
<Filename Value="fpwdcommand.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="FPWDCommand"/>
<CursorPos X="1" Y="7"/>
<TopLine Value="1"/>
<EditorIndex Value="7"/>
<UsageCount Value="25"/>
<Loaded Value="True"/>
</Unit1>
<Unit2>
<Filename Value="..\windebugger.pp"/>
<IsPartOfProject Value="True"/>
<UnitName Value="WinDebugger"/>
<CursorPos X="1" Y="34"/>
<TopLine Value="34"/>
<EditorIndex Value="0"/>
<UsageCount Value="24"/>
<Loaded Value="True"/>
</Unit2>
<Unit3>
<Filename Value="fpwdtype.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="FPWDType"/>
<CursorPos X="2" Y="1"/>
<TopLine Value="1"/>
<EditorIndex Value="4"/>
<UsageCount Value="25"/>
<Loaded Value="True"/>
</Unit3>
<Unit4>
<Filename Value="fpwdutil.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="FPWDUtil"/>
<CursorPos X="26" Y="4"/>
<TopLine Value="1"/>
<UsageCount Value="25"/>
</Unit4>
<Unit5>
<Filename Value="fpwdglobal.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="FPWDGlobal"/>
<CursorPos X="1" Y="34"/>
<TopLine Value="14"/>
<EditorIndex Value="2"/>
<UsageCount Value="25"/>
<Loaded Value="True"/>
</Unit5>
<Unit6>
<Filename Value="..\..\..\..\fpc\fpc.2.0.2\rtl\win32\classes.pp"/>
<UnitName Value="Classes"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<UsageCount Value="11"/>
</Unit6>
<Unit7>
<Filename Value="..\..\..\..\fpc\fpc.2.0.2\rtl\win32\windows.pp"/>
<UnitName Value="windows"/>
<CursorPos X="47" Y="1"/>
<TopLine Value="1"/>
<UsageCount Value="11"/>
</Unit7>
<Unit8>
<Filename Value="..\..\..\lcl\maps.pp"/>
<UnitName Value="maps"/>
<CursorPos X="57" Y="36"/>
<TopLine Value="25"/>
<UsageCount Value="11"/>
</Unit8>
<Unit9>
<Filename Value="..\windextra.pp"/>
<IsPartOfProject Value="True"/>
<UnitName Value="WindExtra"/>
<CursorPos X="25" Y="19"/>
<TopLine Value="31"/>
<EditorIndex Value="1"/>
<UsageCount Value="24"/>
<Loaded Value="True"/>
</Unit9>
<Unit10>
<Filename Value="fpwdbreak.pas"/>
<UnitName Value="FPWDBreak"/>
<CursorPos X="1" Y="2"/>
<TopLine Value="1"/>
<EditorIndex Value="8"/>
<UsageCount Value="11"/>
<Loaded Value="True"/>
</Unit10>
<Unit11>
<Filename Value="..\..\..\..\fpc\fpc.2.0.2\rtl\objpas\types.pp"/>
<UnitName Value="types"/>
<CursorPos X="1" Y="130"/>
<TopLine Value="108"/>
<UsageCount Value="10"/>
</Unit11>
<Unit12>
<Filename Value="..\..\..\..\fpc\fpc.2.0.2\rtl\win32\wininc\base.inc"/>
<CursorPos X="33" Y="80"/>
<TopLine Value="62"/>
<UsageCount Value="10"/>
</Unit12>
<Unit13>
<Filename Value="..\..\..\..\fpc\fpc.2.0.2\rtl\win32\wininc\struct.inc"/>
<CursorPos X="1" Y="1629"/>
<TopLine Value="1619"/>
<UsageCount Value="10"/>
</Unit13>
<Unit14>
<Filename Value="..\..\..\..\fpc\fpc.2.0.2\rtl\inc\objpash.inc"/>
<CursorPos X="23" Y="118"/>
<TopLine Value="107"/>
<UsageCount Value="10"/>
</Unit14>
<Unit15>
<Filename Value="fpwdloop.pas"/>
<UnitName Value="FPWDLoop"/>
<CursorPos X="1" Y="9"/>
<TopLine Value="1"/>
<EditorIndex Value="5"/>
<UsageCount Value="11"/>
<Loaded Value="True"/>
</Unit15>
<Unit16>
<Filename Value="fpwdpeimage.pas"/>
<UnitName Value="FPWDPEImage"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<EditorIndex Value="6"/>
<UsageCount Value="11"/>
<Loaded Value="True"/>
</Unit16>
<Unit17>
<Filename Value="..\..\..\lcl\lclproc.pas"/>
<UnitName Value="LCLProc"/>
<CursorPos X="57" Y="32"/>
<TopLine Value="14"/>
<EditorIndex Value="9"/>
<UsageCount Value="11"/>
<Loaded Value="True"/>
</Unit17>
</Units>
<JumpHistory Count="30" HistoryIndex="29">
<Position1>
<Filename Value="..\windebugger.pp"/>
<Caret Line="6" Column="32" TopLine="3"/>
</Position1>
<Position2>
<Filename Value="..\windebugger.pp"/>
<Caret Line="33" Column="1" TopLine="22"/>
</Position2>
<Position3>
<Filename Value="..\windebugger.pp"/>
<Caret Line="21" Column="1" TopLine="11"/>
</Position3>
<Position4>
<Filename Value="..\windextra.pp"/>
<Caret Line="25" Column="1" TopLine="12"/>
</Position4>
<Position5>
<Filename Value="..\windextra.pp"/>
<Caret Line="34" Column="1" TopLine="12"/>
</Position5>
<Position6>
<Filename Value="..\windebugger.pp"/>
<Caret Line="34" Column="1" TopLine="15"/>
</Position6>
<Position7>
<Filename Value="fpwdglobal.pas"/>
<Caret Line="34" Column="1" TopLine="12"/>
</Position7>
<Position8>
<Filename Value="..\windebugger.pp"/>
<Caret Line="4" Column="1" TopLine="1"/>
</Position8>
<Position9>
<Filename Value="..\windebugger.pp"/>
<Caret Line="162" Column="1" TopLine="144"/>
</Position9>
<Position10>
<Filename Value="fpwd.lpr"/>
<Caret Line="10" Column="1" TopLine="1"/>
</Position10>
<Position11>
<Filename Value="fpwdcommand.pas"/>
<Caret Line="560" Column="49" TopLine="549"/>
</Position11>
<Position12>
<Filename Value="fpwdloop.pas"/>
<Caret Line="14" Column="15" TopLine="1"/>
</Position12>
<Position13>
<Filename Value="fpwdloop.pas"/>
<Caret Line="4" Column="1" TopLine="1"/>
</Position13>
<Position14>
<Filename Value="fpwdloop.pas"/>
<Caret Line="28" Column="28" TopLine="17"/>
</Position14>
<Position15>
<Filename Value="fpwdcommand.pas"/>
<Caret Line="13" Column="46" TopLine="1"/>
</Position15>
<Position16>
<Filename Value="fpwdcommand.pas"/>
<Caret Line="273" Column="43" TopLine="262"/>
</Position16>
<Position17>
<Filename Value="fpwdglobal.pas"/>
<Caret Line="34" Column="1" TopLine="24"/>
</Position17>
<Position18>
<Filename Value="fpwd.lpr"/>
<Caret Line="21" Column="1" TopLine="1"/>
</Position18>
<Position19>
<Filename Value="fpwd.lpr"/>
<Caret Line="34" Column="1" TopLine="12"/>
</Position19>
<Position20>
<Filename Value="fpwdtype.pas"/>
<Caret Line="79" Column="1" TopLine="64"/>
</Position20>
<Position21>
<Filename Value="fpwdtype.pas"/>
<Caret Line="34" Column="1" TopLine="12"/>
</Position21>
<Position22>
<Filename Value="fpwdtype.pas"/>
<Caret Line="62" Column="1" TopLine="56"/>
</Position22>
<Position23>
<Filename Value="fpwdloop.pas"/>
<Caret Line="6" Column="1" TopLine="1"/>
</Position23>
<Position24>
<Filename Value="fpwdloop.pas"/>
<Caret Line="32" Column="1" TopLine="12"/>
</Position24>
<Position25>
<Filename Value="fpwdloop.pas"/>
<Caret Line="194" Column="1" TopLine="188"/>
</Position25>
<Position26>
<Filename Value="fpwdloop.pas"/>
<Caret Line="385" Column="5" TopLine="363"/>
</Position26>
<Position27>
<Filename Value="fpwdpeimage.pas"/>
<Caret Line="10" Column="1" TopLine="1"/>
</Position27>
<Position28>
<Filename Value="fpwdpeimage.pas"/>
<Caret Line="34" Column="1" TopLine="12"/>
</Position28>
<Position29>
<Filename Value="fpwdcommand.pas"/>
<Caret Line="6" Column="1" TopLine="1"/>
</Position29>
<Position30>
<Filename Value="fpwdbreak.pas"/>
<Caret Line="2" Column="10" TopLine="1"/>
</Position30>
</JumpHistory>
</ProjectOptions>
<CompilerOptions>
<Version Value="5"/>
<PathDelim Value="\"/>
<SearchPaths>
<OtherUnitFiles Value="..\;$(LazarusDir)\lcl\units\$(TargetCPU)-$(TargetOS)\;c:\fpc\rtl\units\$(TargetCPU)-$(TargetOS)\"/>
<SrcPath Value="$(LazarusDir)\lcl\"/>
</SearchPaths>
<CodeGeneration>
<Generate Value="Faster"/>
</CodeGeneration>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Debugging>
<BreakPoints Count="11">
<Item1>
<Source Value="..\..\..\lcl\interfaces\gtk\gtklistsl.inc"/>
<InitialEnabled Value="False"/>
<Line Value="358"/>
</Item1>
<Item2>
<Source Value="..\..\..\lcl\interfaces\gtk\gtklistsl.inc"/>
<InitialEnabled Value="False"/>
<Line Value="324"/>
</Item2>
<Item3>
<Source Value="..\..\gdbmidebugger.pp"/>
<Line Value="2039"/>
</Item3>
<Item4>
<Source Value="..\..\..\ideintf\objectinspector.pp"/>
<InitialEnabled Value="False"/>
<Line Value="1908"/>
</Item4>
<Item5>
<Source Value="..\..\..\ide\msgview.pp"/>
<InitialEnabled Value="False"/>
<Line Value="506"/>
</Item5>
<Item6>
<Source Value="..\..\..\ide\msgview.pp"/>
<InitialEnabled Value="False"/>
<Line Value="457"/>
</Item6>
<Item7>
<Source Value="..\..\gdbmidebugger.pp"/>
<InitialEnabled Value="False"/>
<Line Value="803"/>
</Item7>
<Item8>
<Source Value="..\..\..\lcl\include\customcombobox.inc"/>
<Line Value="796"/>
</Item8>
<Item9>
<Source Value="..\..\..\lcl\interfaces\gtk\gtkobject.inc"/>
<Line Value="4763"/>
</Item9>
<Item10>
<Source Value="..\..\..\lcl\interfaces\gtk\gtkobject.inc"/>
<Line Value="4142"/>
</Item10>
<Item11>
<Source Value="..\..\..\test\maptest.lpr"/>
<Line Value="41"/>
</Item11>
</BreakPoints>
<Watches Count="3">
<Item1>
<Expression Value="Item^"/>
</Item1>
<Item2>
<Expression Value="c"/>
</Item2>
<Item3>
<Expression Value="FCurrent"/>
</Item3>
</Watches>
<Exceptions Count="1">
<Item1>
<Name Value="ECodeToolError"/>
</Item1>
</Exceptions>
</Debugging>
</CONFIG>

85
debugger/windebug/fpwd/fpwd.lpr Normal file
View File

@ -0,0 +1,85 @@
{ $Id: $ }
{
---------------------------------------------------------------------------
fpwd - FP standalone windows debugger
---------------------------------------------------------------------------
fpwd is a concept Free Pascal Windows Debugger. It is mainly used to thest
the windebugger classes, but it may grow someday to a fully functional
debugger written in pascal.
---------------------------------------------------------------------------
@created(Mon Apr 10th WET 2006)
@lastmod($Date: $)
@author(Marc Weustink <marc@@dommelstein.nl>)
***************************************************************************
* *
* This source is free software; you can redistribute it and/or modify *
* it under the terms of the GNU General Public License as published by *
* the Free Software Foundation; either version 2 of the License, or *
* (at your option) any later version. *
* *
* This code is distributed in the hope that it will be useful, but *
* WITHOUT ANY WARRANTY; without even the implied warranty of *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
* General Public License for more details. *
* *
* A copy of the GNU General Public License is available on the World *
* Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
* obtain it by writing to the Free Software Foundation, *
* Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *
* *
***************************************************************************
}
program fpwd;
{$mode objfpc}{$H+}
{$APPTYPE CONSOLE}
uses
SysUtils,
Windows,
FPWDCommand,
FPWDGlobal,
FPWDLoop,
FPWDPEImage,
FPWDType,
WinDebugger, WindExtra;
function CtrlCHandler(CtrlType: Cardinal): BOOL; stdcall;
begin
Result := False;
case CtrlType of
CTRL_C_EVENT,
CTRL_BREAK_EVENT: begin
if GState <> dsRun then Exit;
if GMainProcess = nil then Exit;
GMainProcess.Interrupt;
Result := True;
end;
CTRL_CLOSE_EVENT: begin
if (GState in [dsRun, dsPause]) and (GMainProcess <> nil)
then TerminateProcess(GMainProcess.Handle, 0);
// GState := dsQuit;
end;
end;
end;
var
S, Last: String;
begin
WriteLN('MWDebugger starting...');
SetConsoleCtrlHandler(@CtrlCHandler, True);
repeat
Write('MWD>');
ReadLn(S);
if S <> ''
then Last := S;
if Last = '' then Continue;
HandleCommand(Last);
until GState = dsQuit;
SetConsoleCtrlHandler(@CtrlCHandler, False);
end.

609
debugger/windebug/fpwd/fpwdcommand.pas Normal file
View File

@ -0,0 +1,609 @@
{ $Id: $ }
{
---------------------------------------------------------------------------
fpwdcommand.pas - FP standalone windows debugger - Command interpreter
---------------------------------------------------------------------------
This unit contains handles all debugger commands
---------------------------------------------------------------------------
@created(Mon Apr 10th WET 2006)
@lastmod($Date: $)
@author(Marc Weustink <marc@@dommelstein.nl>)
***************************************************************************
* *
* This source is free software; you can redistribute it and/or modify *
* it under the terms of the GNU General Public License as published by *
* the Free Software Foundation; either version 2 of the License, or *
* (at your option) any later version. *
* *
* This code is distributed in the hope that it will be useful, but *
* WITHOUT ANY WARRANTY; without even the implied warranty of *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
* General Public License for more details. *
* *
* A copy of the GNU General Public License is available on the World *
* Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
* obtain it by writing to the Free Software Foundation, *
* Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *
* *
***************************************************************************
}
unit FPWDCommand;
{$mode objfpc}{$H+}
interface
uses
SysUtils, Classes, Windows, WinDebugger, WinDExtra, LCLProc;
procedure HandleCommand(ACommand: String);
implementation
uses
FPWDGlobal, FPWDLoop, FPWDPEImage, FPWDType;
type
TMWDCommandHandler = procedure(AParams: String);
TMWDCommand = class
private
FCommand: String;
FHandler: TMWDCommandHandler;
FHelp: String;
public
constructor Create(const AHandler: TMWDCommandHandler; const ACommand, AHelp: String);
property Command: String read FCommand;
property Handler: TMWDCommandHandler read FHandler;
property Help: String read FHelp;
end;
TMWDCommandList = class
private
FCommands: TStringList;
function GetItem(const AIndex: Integer): TMWDCommand;
public
procedure AddCommand(const ACommands: array of String; const AHandler: TMWDCommandHandler; const AHelp: String);
function Count: Integer;
constructor Create;
destructor Destroy; override;
function FindCommand(const ACommand: String): TMWDCommand;
procedure HandleCommand(ACommand: String);
property Items[const AIndex: Integer]: TMWDCommand read GetItem; default;
end;
var
MCommands: TMWDCommandList;
MShowCommands: TMWDCommandList;
MSetCommands: TMWDCommandList;
procedure HandleCommand(ACommand: String);
begin
MCommands.HandleCommand(ACommand);
end;
procedure HandleHelp(AParams: String);
var
n: Integer;
cmd: TMWDCommand;
begin
if AParams = ''
then begin
WriteLN('Available commands:');
for n := 0 to MCommands.Count - 1 do
WriteLN(' ', MCommands[n].Command);
end
else begin
cmd := MCommands.FindCommand(AParams);
if cmd = nil
then WriteLN('Unknown command: "', AParams, '"')
else WriteLN(cmd.Help);
end;
end;
procedure HandleFile(AParams: String);
begin
if AParams <> ''
then GFileName := AParams;
// TODO separate exec from args
end;
procedure HandleShow(AParams: String);
var
cmd: TMWDCommand;
S: String;
begin
S := GetPart([], [' ', #9], AParams);
if S = '' then S := 'help';
cmd := MShowCommands.FindCommand(S);
if cmd = nil
then WriteLN('Unknown item: "', S, '"')
else cmd.Handler(Trim(AParams));
end;
procedure HandleSet(AParams: String);
var
cmd: TMWDCommand;
S: String;
begin
S := GetPart([], [' ', #9], AParams);
if S = '' then S := 'help';
cmd := MSetCommands.FindCommand(S);
if cmd = nil
then WriteLN('Unknown param: "', S, '"')
else cmd.Handler(Trim(AParams));
end;
procedure HandleRun(AParams: String);
var
StartupInfo: TStartupInfo;
ProcessInformation: TProcessInformation;
ThreadAttributes: TSecurityAttributes;
begin
if GState <> dsStop
then begin
WriteLN('The debuggee is already running');
Exit;
end;
if GFileName = ''
then begin
WriteLN('No filename set');
Exit;
end;
ZeroMemory(@StartUpInfo, SizeOf(StartupInfo));
StartUpInfo.cb := SizeOf(StartupInfo);
StartUpInfo.dwFlags := {STARTF_USESTDHANDLES or} STARTF_USESHOWWINDOW;
StartUpInfo.wShowWindow := SW_SHOWNORMAL or SW_SHOW;
// ZeroMemory(@ThreadAttributes, SizeOf(ThreadAttributes));
// ThreadAttributes.nLength := SizeOf(ThreadAttributes);
// ThreadAttributes.lpSecurityDescriptor
ZeroMemory(@ProcessInformation, SizeOf(ProcessInformation));
if not CreateProcess(nil, PChar(GFileName), nil, nil, True, DETACHED_PROCESS or DEBUG_PROCESS or CREATE_NEW_PROCESS_GROUP, nil, nil, StartUpInfo, ProcessInformation)
then begin
WriteLN('Create process failed');
Exit;
end;
WriteLN('Got PID:', ProcessInformation.dwProcessId, ', TID: ',ProcessInformation.dwThreadId);
GState := dsRun;
DebugLoop;
end;
procedure HandleBreak(AParams: String);
begin
WriteLN('not implemented: break');
end;
procedure HandleContinue(AParams: String);
begin
if GState <> dsPause
then begin
WriteLN('The process is not paused');
Exit;
end;
DebugLoop;
end;
procedure HandleKill(AParams: String);
begin
if not (GState in [dsRun, dsPause]) or (GMainProcess = nil)
then begin
WriteLN('No process');
Exit;
end;
WriteLN('Terminating...');
TerminateProcess(GMainProcess.Handle, 0);
if GState = dsPause
then DebugLoop; // continue runnig so we can terminate
end;
procedure HandleNext(AParams: String);
begin
if GState <> dsPause
then begin
WriteLN('The process is not paused');
Exit;
end;
if GCurrentThread = nil
then begin
WriteLN('No current thread');
Exit;
end;
GCurrentThread.SingleStep;
DebugLoop;
end;
procedure HandleList(AParams: String);
begin
WriteLN('not implemented: list');
end;
procedure HandleMemory(AParams: String);
// memory [-<size>] [<adress> <count>|<location> <count>]
var
P: array[1..3] of String;
Size, Count: Integer;
Adress: QWord;
e, idx: Integer;
buf: array[0..256*16 - 1] of Byte;
BytesRead: Cardinal;
begin
if GMainProcess = nil
then begin
WriteLN('No process');
Exit;
end;
P[1] := GetPart([], [' ', #9], AParams);
P[2] := GetPart([' ', #9], [' ', #9], AParams);
P[3] := GetPart([' ', #9], [' ', #9], AParams);
idx := 1;
Count := 1;
Size := 4;
case GMode of
dm32: Adress := GCurrentContext.Eip;
dm64: Adress := GCurrentContext64.Rip;
end;
if P[idx] <> ''
then begin
if P[idx][1] = '-'
then begin
Size := -StrToIntDef(P[idx], -Size);
if not (Size in [1,2,4,8,16])
then begin
WriteLN('Illegal size: "', P[idx], '"');
Exit;
end;
Inc(idx);
end;
if P[idx] <> ''
then begin
if P[idx][1] = '%'
then begin
end
else begin
Val(P[idx], Adress, e);
if e <> 0
then begin
WriteLN('Location "',P[idx],'": Symbol resolving not implemented');
Exit;
end;
end;
Inc(idx);
end;
if P[idx] <> ''
then begin
Count := StrToIntDef(P[idx], Count);
if Count > 256
then begin
WriteLN('Limiting count to 256');
Count := 256;
end;
Inc(idx);
end;
end;
BytesRead := Count * Size;
if not GMainProcess.ReadData(Adress, BytesRead, buf)
then begin
WriteLN('Could not read memory at: ', FormatAdress(Adress));
Exit;
end;
e := 0;
while BytesRead >= size do
begin
if e and ((32 div Size) - 1) = 0
then Write('[', FormatAdress(Adress), '] ');
for idx := Size - 1 downto 0 do Write(IntToHex(buf[e * size + idx], 2));
Inc(e);
if e = 32 div Size
then WriteLn
else Write(' ');
Dec(BytesRead, Size);
Inc(Adress, Size);
end;
if e <> 32 div Size
then WriteLn;
end;
procedure HandleDisas(AParams: String);
begin
WriteLN('not implemented: disassemble');
end;
procedure HandleEval(AParams: String);
begin
WriteLN('not implemented: evaluate');
end;
procedure HandleQuit(AParams: String);
begin
WriteLN('Quitting...');
GState := dsQuit;
end;
//=================
// S H O W
//=================
procedure HandleShowHelp(AParams: String);
var
n: Integer;
cmd: TMWDCommand;
begin
if AParams = ''
then begin
WriteLN('Available items:');
for n := 0 to MShowCommands.Count - 1 do
WriteLN(' ', MShowCommands[n].Command);
end
else begin
cmd := MShowCommands.FindCommand(AParams);
if cmd = nil
then WriteLN('Unknown item: "', AParams, '"')
else WriteLN(cmd.Help);
end;
end;
procedure HandleShowFile(AParams: String);
var
hFile, hMap: THandle;
FilePtr: Pointer;
begin
if GFileName = ''
then begin
WriteLN('No filename set');
Exit;
end;
hFile := CreateFile(PChar(GFileName), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, FILE_FLAG_RANDOM_ACCESS, 0);
if hFile = INVALID_HANDLE_VALUE
then begin
WriteLN('File "', GFileName, '" does not exist');
Exit;
end;
hMap := 0;
FilePtr := nil;
try
hMap := CreateFileMapping(hFile, nil, PAGE_READONLY{ or SEC_IMAGE}, 0, 0, nil);
if hMap = 0
then begin
WriteLN('Map error');
Exit;
end;
FilePtr := MapViewOfFile(hMap, FILE_MAP_READ, 0, 0, 0);
DumpPEImage(GetCurrentProcess, TDbgPtr(FilePtr));
finally
UnmapViewOfFile(FilePtr);
CloseHandle(hMap);
CloseHandle(hFile);
end;
end;
procedure HandleShowCallStack(AParams: String);
var
Adress, Frame, LastFrame: QWord;
Size, Count: integer;
begin
if (GMainProcess = nil) or (GCurrentProcess = nil)
then begin
WriteLN('No process');
Exit;
end;
if GState <> dsPause
then begin
WriteLN('Process not paused');
Exit;
end;
case GMode of
dm32: begin
Adress := GCurrentContext.Eip;
Frame := GCurrentContext.Ebp;
Size := 4;
end;
dm64: begin
Adress := GCurrentContext64.Rip;
Frame := GCurrentContext64.Rdi;
Size := 8;
end;
end;
WriteLN('Callstack:');
WriteLn(' ', FormatAdress(Adress));
LastFrame := 0;
Count := 25;
while (Frame <> 0) and (Frame > LastFrame) do
begin
if not GCurrentProcess.ReadData(Frame + Size, Size, Adress) or (Adress = 0) then Break;
WriteLn(' ', FormatAdress(Adress));
Dec(count);
if Count <= 0 then Exit;
if not GCurrentProcess.ReadData(Frame, Size, Frame) then Break;
end;
end;
//=================
// S E T
//=================
procedure HandleSetHelp(AParams: String);
var
n: Integer;
cmd: TMWDCommand;
begin
if AParams = ''
then begin
WriteLN('Usage: set param [<value>] When no value is given, the current value is shown.');
WriteLN('Available params:');
for n := 0 to MSetCommands.Count - 1 do
WriteLN(' ', MSetCommands[n].Command);
end
else begin
cmd := MSetCommands.FindCommand(AParams);
if cmd = nil
then WriteLN('Unknown param: "', AParams, '"')
else WriteLN(cmd.Help);
end;
end;
procedure HandleSetMode(AParams: String);
const
MODE: array[TMWDMode] of String = ('32', '64');
begin
if AParams = ''
then WriteLN(' Mode: ', MODE[GMode])
else if AParams = '32'
then GMode := dm32
else if AParams = '64'
then GMode := dm64
else WriteLN('Unknown mode: "', AParams, '"')
end;
//=================
//=================
//=================
{ TMWDCommand }
constructor TMWDCommand.Create(const AHandler: TMWDCommandHandler; const ACommand, AHelp: String);
begin
inherited Create;
FCommand := ACommand;
FHandler := AHandler;
FHelp := AHelp;
end;
{ TMWDCommandList }
procedure TMWDCommandList.AddCommand(const ACommands: array of String; const AHandler: TMWDCommandHandler; const AHelp: String);
var
n: Integer;
begin
for n := Low(ACommands) to High(ACommands) do
FCommands.AddObject(ACommands[n], TMWDCommand.Create(AHandler, ACommands[n], AHelp));
end;
function TMWDCommandList.Count: Integer;
begin
Result := FCommands.Count;
end;
constructor TMWDCommandList.Create;
begin
inherited;
FCommands := TStringList.Create;
FCommands.Duplicates := dupError;
FCommands.Sorted := True;
end;
destructor TMWDCommandList.Destroy;
var
n: integer;
begin
for n := 0 to FCommands.Count - 1 do
FCommands.Objects[n].Free;
FreeAndNil(FCommands);
inherited;
end;
function TMWDCommandList.FindCommand(const ACommand: String): TMWDCommand;
var
idx: Integer;
begin
idx := FCommands.IndexOf(ACommand);
if idx = -1
then Result := nil
else Result := TMWDCommand(FCommands.Objects[idx]);
end;
function TMWDCommandList.GetItem(const AIndex: Integer): TMWDCommand;
begin
Result := TMWDCommand(FCommands.Objects[AIndex]);
end;
procedure TMWDCommandList.HandleCommand(ACommand: String);
var
cmd: TMWDCommand;
S: String;
begin
S := GetPart([], [' ', #9], ACommand);
cmd := FindCommand(S);
if cmd = nil
then WriteLN('Unknown command: "', S, '"')
else cmd.Handler(Trim(ACommand));
end;
//=================
//=================
//=================
procedure Initialize;
begin
MCommands := TMWDCommandList.Create;
MCommands.AddCommand(['help', 'h', '?'], @HandleHelp, 'help [<command>]: Shows help on a command, or this help if no command given');
MCommands.AddCommand(['quit', 'q'], @HandleQuit, 'quit: Quits the debugger');
MCommands.AddCommand(['file', 'f'], @HandleFile, 'file <filename>: Loads the debuggee <filename>');
MCommands.AddCommand(['show', 's'], @HandleShow, 'show <info>: Enter show help for more info');
MCommands.AddCommand(['set'], @HandleSet, 'set param: Enter set help for more info');
MCommands.AddCommand(['run', 'r'], @HandleRun, 'run: Starts the loaded debuggee');
MCommands.AddCommand(['break', 'b'], @HandleBreak, 'break [-d] <adress>: Set a breakpoint at <adress>. -d removes');
MCommands.AddCommand(['continue', 'cont', 'c'], @HandleContinue, 'continue: Continues execution');
MCommands.AddCommand(['kill', 'k'], @HandleKill, 'kill: Stops execution of the debuggee');
MCommands.AddCommand(['next', 'n'], @HandleNext, 'next: Steps one instruction');
MCommands.AddCommand(['list', 'l'], @HandleList, 'list [<adress>|<location>]: Lists the source for <adress> or <location>');
MCommands.AddCommand(['memory', 'mem', 'm'], @HandleMemory, 'memory [-<size>] [<adress> <count>|<location> <count>]: Dump <count> (default: 1) from memory <adress> or <location> (default: current) of <size> (default: 4) bytes, where size is 1,2,4,8 or 16.');
MCommands.AddCommand(['disassemble', 'dis', 'd'], @HandleDisas, 'disassemble [<adress>|<location>] [<count>]: Disassemble <count> instructions from <adress> or <location> or current IP if none given');
MCommands.AddCommand(['evaluate', 'eval', 'e'], @HandleEval, 'evaluate <symbol>: Evaluate <symbol>');
MShowCommands := TMWDCommandList.Create;
MShowCommands.AddCommand(['help', 'h', '?'], @HandleShowHelp, 'show help [<info>]: Shows help for info or this help if none given');
MShowCommands.AddCommand(['file', 'f'], @HandleShowFile, 'show file: Shows the info for the current file');
MShowCommands.AddCommand(['callstack', 'c'], @HandleShowCallStack, 'show callstack: Shows the callstack');
MSetCommands := TMWDCommandList.Create;
MSetCommands.AddCommand(['help', 'h', '?'], @HandleSetHelp, 'set help [<param>]: Shows help for param or this help if none given');
MSetCommands.AddCommand(['mode', 'm'], @HandleSetMode, 'set mode 32|64: Set the mode for retrieving process info');
end;
procedure Finalize;
begin
FreeAndNil(MCommands);
FreeAndNil(MSetCommands);
FreeAndNil(MShowCommands);
end;
initialization
Initialize;
finalization
Finalize;
end.

77
debugger/windebug/fpwd/fpwdglobal.pas Normal file
View File

@ -0,0 +1,77 @@
{ $Id: $ }
{
---------------------------------------------------------------------------
fpwdglobal.pas - FP standalone windows debugger - Globals
---------------------------------------------------------------------------
This unit contains global types / vars
---------------------------------------------------------------------------
@created(Mon Apr 10th WET 2006)
@lastmod($Date: $)
@author(Marc Weustink <marc@@dommelstein.nl>)
***************************************************************************
* *
* This source is free software; you can redistribute it and/or modify *
* it under the terms of the GNU General Public License as published by *
* the Free Software Foundation; either version 2 of the License, or *
* (at your option) any later version. *
* *
* This code is distributed in the hope that it will be useful, but *
* WITHOUT ANY WARRANTY; without even the implied warranty of *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
* General Public License for more details. *
* *
* A copy of the GNU General Public License is available on the World *
* Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
* obtain it by writing to the Free Software Foundation, *
* Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *
* *
***************************************************************************
}
unit FPWDGlobal;
{$mode objfpc}{$H+}
interface
uses
SysUtils, Windows, FPWDType, Maps, WinDebugger;
type
TMWDState = (dsStop, dsRun, dsPause, dsQuit, dsEvent);
TMWDMode = (dm32, dm64);
var
GState: TMWDState;
GFileName: String;
GMode: TMWDMode = dm32;
GCurrentContext64: TContextAMD64;
GCurrentContext: TContext absolute GCurrentContext64;
GMainProcess: TDbgProcess = nil;
GCurrentProcess: TDbgProcess = nil;
GCurrentThread: TDbgThread = nil;
GProcessMap: TMap;
function GetProcess(const AID: Integer; var AProcess: TDbgProcess): Boolean;
implementation
function GetProcess(const AID: Integer; var AProcess: TDbgProcess): Boolean;
begin
Result := GProcessMap.GetData(AID, AProcess) and (AProcess <> nil);
// if not Result
// then Log('Unknown Process ID %u', [AID]);
end;
initialization
GState := dsStop;
GProcessMap := TMap.Create(itu4, SizeOf(TDbgProcess));;
finalization
FreeAndNil(GProcessMap)
end.

419
debugger/windebug/fpwd/fpwdloop.pas Normal file
View File

@ -0,0 +1,419 @@
{ $Id: $ }
{
---------------------------------------------------------------------------
fpwdloop.pas - FP standalone windows debugger - Debugger main loop
---------------------------------------------------------------------------
This unit contains the main loop of the debugger. It waits for a debug
event and handles it
---------------------------------------------------------------------------
@created(Mon Apr 10th WET 2006)
@lastmod($Date: $)
@author(Marc Weustink <marc@@dommelstein.nl>)
***************************************************************************
* *
* This source is free software; you can redistribute it and/or modify *
* it under the terms of the GNU General Public License as published by *
* the Free Software Foundation; either version 2 of the License, or *
* (at your option) any later version. *
* *
* This code is distributed in the hope that it will be useful, but *
* WITHOUT ANY WARRANTY; without even the implied warranty of *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
* General Public License for more details. *
* *
* A copy of the GNU General Public License is available on the World *
* Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
* obtain it by writing to the Free Software Foundation, *
* Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *
* *
***************************************************************************
}
unit FPWDLoop;
{$mode objfpc}{$H+}
interface
uses
Windows, SysUtils, WinDebugger, WinDExtra;
procedure DebugLoop;
implementation
uses
FPWDGlobal, FPWDPEImage, FPWDType;
var
MDebugEvent: TDebugEvent64;
MDebugEvent32: TDebugEvent absolute MDebugEvent;
procedure HandleCreateProcess(const AEvent: TDebugEvent64);
var
Proc: TDbgProcess;
S: String;
begin
WriteLN(Format('hFile: 0x%x', [AEvent.CreateProcessInfo.hFile]));
WriteLN(Format('hProcess: 0x%x', [AEvent.CreateProcessInfo.hProcess]));
WriteLN(Format('hThread: 0x%x', [AEvent.CreateProcessInfo.hThread]));
WriteLN('Base adress: ', FormatAdress(AEvent.CreateProcessInfo.lpBaseOfImage));
WriteLN('Base adress64: $', IntToHex(PInt64(@AEvent.CreateProcessInfo.lpBaseOfImage)^, 16));
WriteLN(Format('Debugsize: %d', [AEvent.CreateProcessInfo.nDebugInfoSize]));
WriteLN(Format('Debugoffset: %d', [AEvent.CreateProcessInfo.dwDebugInfoFileOffset]));
if AEvent.CreateProcessInfo.lpBaseOfImage <> nil
then DumpPEImage(AEvent.CreateProcessInfo.hProcess, TDbgPtr(AEvent.CreateProcessInfo.lpBaseOfImage));
if GMainProcess = nil
then S := GFileName;
Proc := TDbgProcess.Create(S, AEvent.dwProcessId, AEvent.dwThreadId, AEvent.CreateProcessInfo);
if GMainProcess = nil
then GMainProcess := Proc;
GProcessMap.Add(AEvent.dwProcessId, Proc);
end;
procedure HandleCreateThread(const AEvent: TDebugEvent64);
begin
WriteLN(Format('Start adress: 0x%p', [AEvent.CreateThread.lpStartAddress]));
end;
procedure HandleException(const AEvent: TDebugEvent64);
var
N: Integer;
Info0: QWORD;
Info1: QWORD;
Info1Str: String;
P: PByte;
begin
if AEvent.Exception.dwFirstChance = 0
then Write('Exception: ')
else Write('First chance exception: ');
case AEvent.Exception.ExceptionRecord.ExceptionCode of
EXCEPTION_ACCESS_VIOLATION : Write('ACCESS_VIOLATION');
EXCEPTION_ARRAY_BOUNDS_EXCEEDED : Write('ARRAY_BOUNDS_EXCEEDED');
EXCEPTION_BREAKPOINT : Write('BREAKPOINT');
EXCEPTION_DATATYPE_MISALIGNMENT : Write('DATATYPE_MISALIGNMENT');
EXCEPTION_FLT_DENORMAL_OPERAND : Write('FLT_DENORMAL_OPERAND');
EXCEPTION_FLT_DIVIDE_BY_ZERO : Write('FLT_DIVIDE_BY_ZERO');
EXCEPTION_FLT_INEXACT_RESULT : Write('FLT_INEXACT_RESULT');
EXCEPTION_FLT_INVALID_OPERATION : Write('FLT_INVALID_OPERATION');
EXCEPTION_FLT_OVERFLOW : Write('FLT_OVERFLOW');
EXCEPTION_FLT_STACK_CHECK : Write('FLT_STACK_CHECK');
EXCEPTION_FLT_UNDERFLOW : Write('FLT_UNDERFLOW');
EXCEPTION_ILLEGAL_INSTRUCTION : Write('ILLEGAL_INSTRUCTION');
EXCEPTION_IN_PAGE_ERROR : Write('IN_PAGE_ERROR');
EXCEPTION_INT_DIVIDE_BY_ZERO : Write('INT_DIVIDE_BY_ZERO');
EXCEPTION_INT_OVERFLOW : Write('INT_OVERFLOW');
EXCEPTION_INVALID_DISPOSITION : Write('INVALID_DISPOSITION');
EXCEPTION_NONCONTINUABLE_EXCEPTION : Write('NONCONTINUABLE_EXCEPTION');
EXCEPTION_PRIV_INSTRUCTION : Write('PRIV_INSTRUCTION');
EXCEPTION_SINGLE_STEP : Write('SINGLE_STEP');
EXCEPTION_STACK_OVERFLOW : Write('STACK_OVERFLOW');
else
Write(' Unknown code: ', AEvent.Exception.ExceptionRecord.ExceptionCode);
end;
case GMode of
dm64: Info0 := AEvent.Exception64.ExceptionRecord.ExceptionAddress;
dm32: Info0 := Cardinal(AEvent.Exception.ExceptionRecord.ExceptionAddress);
else
Info0 := 0;
end;
Write(' at: ', FormatAdress(Info0));
Write(' Flags:', Format('%x', [AEvent.Exception.ExceptionRecord.ExceptionFlags]), ' [');
if AEvent.Exception.ExceptionRecord.ExceptionFlags = 0
then Write('Continuable')
else Write('Not continuable');
Write(']');
case GMode of
dm64: Write(' ParamCount:', AEvent.Exception64.ExceptionRecord.NumberParameters);
dm32: Write(' ParamCount:', AEvent.Exception.ExceptionRecord.NumberParameters);
end;
case AEvent.Exception.ExceptionRecord.ExceptionCode of
EXCEPTION_ACCESS_VIOLATION: begin
case GMode of
dm64: begin
Info0 := AEvent.Exception64.ExceptionRecord.ExceptionInformation[0];
Info1Str := IntToHex(AEvent.Exception64.ExceptionRecord.ExceptionInformation[1], 16);
end;
dm32: begin
Info0 := AEvent.Exception.ExceptionRecord.ExceptionInformation[0];
Info1Str := IntToHex(AEvent.Exception.ExceptionRecord.ExceptionInformation[1], 8);
end;
end;
case Info0 of
0: begin
Write(' Read of address: $', Info1Str);
end;
1: begin
Write(' Write of address: $', Info1Str);
end;
end;
end;
end;
WriteLN;
Write(' Info: ');
case GMode of
dm64: begin
with AEvent.Exception64.ExceptionRecord do
for n := Low(ExceptionInformation) to high(ExceptionInformation) do
begin
Write(IntToHex(ExceptionInformation[n], 16), ' ');
if n and 3 = 3
then begin
WriteLN;
Write(' ');
end;
end;
end;
dm32: begin
with AEvent.Exception.ExceptionRecord do
for n := Low(ExceptionInformation) to high(ExceptionInformation) do
begin
Write(IntToHex(ExceptionInformation[n], 8), ' ');
if n and 7 = 7
then begin
WriteLN;
Write(' ');
end;
end;
end;
end;
WriteLn;
GState := dsPause;
end;
procedure HandleExitProcess(const AEvent: TDebugEvent64);
var
Proc: TDbgProcess;
begin
if not GetProcess(AEvent.dwProcessId, Proc) then Exit;
if Proc = GMainProcess then GMainProcess := nil;
GProcessMap.Delete(AEvent.dwProcessId);
GState := dsStop;
WriteLN('Process stopped with exitcode: ', AEvent.ExitProcess.dwExitCode);
end;
procedure HandleExitThread(const AEvent: TDebugEvent64);
begin
WriteLN('Exitcode: ', AEvent.ExitThread.dwExitCode);
end;
procedure HandleLoadDll(const AEvent: TDebugEvent64);
//var
// Proc: TDbgProcess;
// Lib: TDbgLibrary;
begin
WriteLN('Base adress: ', FormatAdress(AEvent.LoadDll.lpBaseOfDll));
// if GetProcess(AEvent.dwProcessId, Proc)
// then begin
// Lib := Proc.AddLib(AEvent.LoadDll);
// WriteLN('Name: ', Lib.Name);
// DumpPEImage(Proc.Handle, Lib.BaseAddr);
// end;
end;
procedure HandleOutputDebug(const AEvent: TDebugEvent64);
var
Proc: TDbgProcess;
S: String;
W: WideString;
begin
if not GetProcess(AEvent.dwProcessId, Proc) then Exit;
if AEvent.DebugString.fUnicode <> 0
then begin
if not Proc.ReadWString(TDbgPtr(AEvent.DebugString.lpDebugStringData), AEvent.DebugString.nDebugStringLength, W)
then Exit;
S := W;
end
else begin
if not Proc.ReadString(TDbgPtr(AEvent.DebugString.lpDebugStringData), AEvent.DebugString.nDebugStringLength, S)
then Exit;
end;
WriteLN('[', AEvent.dwProcessId, ':', AEvent.dwThreadId, '] ', S);
end;
procedure HandleRipEvent(const AEvent: TDebugEvent64);
begin
WriteLN('Error: ', AEvent.RipInfo.dwError);
WriteLN('Type: ', AEvent.RipInfo.dwType);
end;
procedure HandleUnloadDll(const AEvent: TDebugEvent64);
begin
WriteLN('Base adress: ', FormatAdress(AEvent.UnloadDll.lpBaseOfDll));
end;
procedure DebugLoop;
procedure DumpEvent(const AEvent: String);
var
f: Cardinal;
n: integer;
begin
WriteLN('===');
WriteLN(AEvent);
WriteLN('---');
WriteLN('Process ID: ', MDebugEvent.dwProcessId);
WriteLN('Thread ID: ', MDebugEvent.dwThreadId);
if GCurrentThread = nil then Exit;
case GMode of
dm64: begin
with GCurrentContext64 do WriteLN(Format('SegDS: 0x%4.4x, SegES: 0x%4.4x, SegFS: 0x%4.4x, SegGS: 0x%4.4x', [SegDs, SegEs, SegFs, SegGs]));
with GCurrentContext64 do WriteLN(Format('RAX: 0x%16.16x, RBX: 0x%16.16x, RCX: 0x%16.16x, RDX: 0x%16.16x, RDI: 0x%16.16x, RSI: 0x%16.16x, R9: 0x%16.16x, R10: 0x%16.16x, R11: 0x%16.16x, R12: 0x%16.16x, R13: 0x%16.16x, R14: 0x%16.16x, R15: 0x%16.16x', [Rax, Rbx, Rcx, Rdx, Rdi, Rsi, R9, R10, R11, R12, R13, R14, R15]));
with GCurrentContext64 do WriteLN(Format('SegCS: 0x%4.4x, SegSS: 0x%4.4x, RBP: 0x%16.16x, RIP: 0x%16.16x, RSP: 0x%16.16x, EFlags: 0x%8.8x', [SegCs, SegSs, Rbp, Rip, Rsp, EFlags]));
end;
dm32: begin
with GCurrentContext do WriteLN(Format('DS: 0x%x, ES: 0x%x, FS: 0x%x, GS: 0x%x', [SegDs, SegEs, SegFs, SegGs]));
with GCurrentContext do WriteLN(Format('EAX: 0x%x, EBX: 0x%x, ECX: 0x%x, EDX: 0x%x, EDI: 0x%x, ESI: 0x%x', [Eax, Ebx, Ecx, Edx, Edi, Esi]));
with GCurrentContext do WriteLN(Format('CS: 0x%x, SS: 0x%x, EBP: 0x%x, EIP: 0x%x, ESP: 0x%x, EFlags: 0x%x', [SegCs, SegSs, Ebp, Eip, Esp, EFlags]));
with GCurrentContext do begin
Write(Format('DR0: 0x%x, DR1: 0x%x, DR2: 0x%x, DR3: 0x%x', [Dr0, Dr1, Dr2, Dr3]));
Write(' DR6: 0x', IntToHex(Dr6, 8), ' [');
if Dr6 and $0001 <> 0 then Write('B0 ');
if Dr6 and $0002 <> 0 then Write('B1 ');
if Dr6 and $0004 <> 0 then Write('B2 ');
if Dr6 and $0008 <> 0 then Write('B3 ');
if Dr6 and $2000 <> 0 then Write('BD ');
if Dr6 and $4000 <> 0 then Write('BS ');
if Dr6 and $8000 <> 0 then Write('BT ');
Write('] DR7: 0x', IntToHex(Dr7, 8), ' [');
if Dr7 and $01 <> 0 then Write('L0 ');
if Dr7 and $02 <> 0 then Write('G0 ');
if Dr7 and $04 <> 0 then Write('L1 ');
if Dr7 and $08 <> 0 then Write('G1 ');
if Dr7 and $10 <> 0 then Write('L2 ');
if Dr7 and $20 <> 0 then Write('G2 ');
if Dr7 and $40 <> 0 then Write('L3 ');
if Dr7 and $80 <> 0 then Write('G3 ');
if Dr7 and $100 <> 0 then Write('LE ');
if Dr7 and $200 <> 0 then Write('GE ');
if Dr7 and $2000 <> 0 then Write('GD ');
f := Dr7 shr 16;
for n := 0 to 3 do
begin
Write('R/W', n,':');
case f and 3 of
0: Write('ex');
1: Write('wo');
2: Write('IO');
3: Write('rw');
end;
f := f shr 2;
Write(' LEN', n,':', f and 3 + 1, ' ');
f := f shr 2;
end;
WriteLN(']');
end;
end;
end;
WriteLN('---');
end;
begin
repeat
if (GCurrentProcess <> nil) and (GState = dsPause)
then begin
GCurrentProcess.ContinueDebugEvent(GCurrentThread, MDebugEvent32);
end;
if GState in [dsStop, dsPause, dsEvent]
then begin
case MDebugEvent.Exception.ExceptionRecord.ExceptionCode of
EXCEPTION_BREAKPOINT,
EXCEPTION_SINGLE_STEP: ContinueDebugEvent(MDebugEvent.dwProcessId, MDebugEvent.dwThreadId, DBG_CONTINUE);
else
ContinueDebugEvent(MDebugEvent.dwProcessId, MDebugEvent.dwThreadId, DBG_EXCEPTION_NOT_HANDLED);
end;
GState := dsRun;
end;
if not WaitForDebugEvent(MDebugEvent32, 10) then Continue;
GCurrentProcess := nil;
GCurrentThread := nil;
if not GetProcess(MDebugEvent.dwProcessId, GCurrentPRocess) and (GMainProcess <> nil) then Continue;
GState := dsEvent;
if GCurrentProcess <> nil
then begin
if GCurrentProcess.HandleDebugEvent(MDebugEvent32) then Continue;
if not GCurrentProcess.GetThread(MDebugEvent.dwTHreadID, GCurrentThread)
then WriteLN('LOOP: Unable to retrieve current thread')
else WriteLN('LOOP: ID:', MDebugEvent.dwTHreadID, ' -> H:', GCurrentThread.Handle);
end;
FillChar(GCurrentContext64, SizeOf(GCurrentContext64), $EE);
if GCurrentThread <> nil
then begin
// TODO: move to TDbgThread
case GMode of
dm64: GCurrentContext64.ContextFlags := CONTEXT_SEGMENTS_AMD64 or CONTEXT_INTEGER_AMD64 or CONTEXT_CONTROL_AMD64;
dm32: GCurrentContext.ContextFlags := CONTEXT_SEGMENTS or CONTEXT_INTEGER or CONTEXT_CONTROL {or CONTEXT_DEBUG_REGISTERS};
else
WriteLN('LOOP: Unknown mode');
end;
SetLastError(0);
// SuspendTHread(GCurrentThread.Handle);
if not GetThreadContext(GCurrentThread.Handle, GCurrentContext)
then WriteLN('LOOP: Unable to retrieve thread context')
else WriteLN('LOOP context: ', IntToHex(GCurrentContext.ContextFlags, 8), ' error: ', GetLastErrorText);
// ResumeThread(GCurrentThread.Handle);
end;
case MDebugEvent.dwDebugEventCode of
EXCEPTION_DEBUG_EVENT: begin
DumpEvent('EXCEPTION_DEBUG_EVENT');
HandleException(MDebugEvent);
end;
CREATE_THREAD_DEBUG_EVENT: begin
DumpEvent('CREATE_THREAD_DEBUG_EVENT');
HandleCreateThread(MDebugEvent);
end;
CREATE_PROCESS_DEBUG_EVENT: begin
DumpEvent('CREATE_PROCESS_DEBUG_EVENT');
HandleCreateProcess(MDebugEvent);
end;
EXIT_THREAD_DEBUG_EVENT: begin
DumpEvent('EXIT_THREAD_DEBUG_EVENT');
HandleExitThread(MDebugEvent);
end;
EXIT_PROCESS_DEBUG_EVENT: begin
DumpEvent('EXIT_PROCESS_DEBUG_EVENT');
HandleExitProcess(MDebugEvent);
end;
LOAD_DLL_DEBUG_EVENT: begin
DumpEvent('LOAD_DLL_DEBUG_EVENT');
HandleLoadDll(MDebugEvent);
end;
UNLOAD_DLL_DEBUG_EVENT: begin
DumpEvent('UNLOAD_DLL_DEBUG_EVENT');
HandleUnloadDll(MDebugEvent);
end;
OUTPUT_DEBUG_STRING_EVENT: begin
DumpEvent('OUTPUT_DEBUG_STRING_EVENT');
HandleOutputDebug(MDebugEvent);
end;
RIP_EVENT: begin
DumpEvent('RIP_EVENT');
HandleRipEvent(MDebugEvent);
end;
end;
until (GState in [dsStop, dsPause, dsQuit]);
end;
end.

461
debugger/windebug/fpwd/fpwdpeimage.pas Normal file
View File

@ -0,0 +1,461 @@
{ $Id: $ }
{
---------------------------------------------------------------------------
fpwdpeimage.pas - FP standalone windows debugger - PE Image
---------------------------------------------------------------------------
This unit contains routines to access or dump the PE header of a executable
loaded in memory.
---------------------------------------------------------------------------
@created(Mon Apr 10th WET 2006)
@lastmod($Date: $)
@author(Marc Weustink <marc@@dommelstein.nl>)
***************************************************************************
* *
* This source is free software; you can redistribute it and/or modify *
* it under the terms of the GNU General Public License as published by *
* the Free Software Foundation; either version 2 of the License, or *
* (at your option) any later version. *
* *
* This code is distributed in the hope that it will be useful, but *
* WITHOUT ANY WARRANTY; without even the implied warranty of *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
* General Public License for more details. *
* *
* A copy of the GNU General Public License is available on the World *
* Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
* obtain it by writing to the Free Software Foundation, *
* Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *
* *
***************************************************************************
}
unit FPWDPEImage;
{$mode objfpc}{$H+}
interface
{$IF DECLARED(TImageNtHeaders)}
{$DEFINE _headers_translated_in_rtl_}
{$ENDIF}
uses
Windows, SysUtils, FPWDGLobal, WinDebugger;
const
IMAGE_FILE_MACHINE_IA64 = $0200; { Intel IPF }
IMAGE_FILE_MACHINE_AMD64 = $8664; { x64 }
IMAGE_FILE_LARGE_ADDRESS_AWARE = $0020; { The application can handle addresses larger than 2 GB. }
IMAGE_DIRECTORY_ENTRY_DELAY_IMPORT = 13; { Delay import table }
IMAGE_DIRECTORY_ENTRY_COM_DECRIPTOR = 14; { COM descriptor table }
IMAGE_NT_OPTIONAL_HDR32_MAGIC = $010B;
IMAGE_NT_OPTIONAL_HDR64_MAGIC = $020B;
IMAGE_SUBSYSTEM_WINDOWS_CE_GUI = 8; { Windows CE system }
IMAGE_SUBSYSTEM_XBOX = 9; { Xbox system }
IMAGE_LIBRARY_PROCESS_INIT = $0001; // Reserved.
IMAGE_LIBRARY_PROCESS_TERM = $0002; // Reserved.
IMAGE_LIBRARY_THREAD_INIT = $0004; // Reserved.
IMAGE_LIBRARY_THREAD_TERM = $0008; // Reserved.
IMAGE_DLLCHARACTERISTICS_NO_ISOLATION = $0200; { Image understands isolation and doesn't want it }
IMAGE_DLLCHARACTERISTICS_NO_SEH = $0400; { Image does not use SEH. No SE handler may reside in this image }
IMAGE_DLLCHARACTERISTICS_NO_BIND = $0800; { do not bind this image }
// $1000; { Reserved. }
IMAGE_DLLCHARACTERISTICS_WDM_DRIVER = $2000; { dll is a WDM driver }
// $4000; { Reserved. }
IMAGE_DLLCHARACTERISTICS_TERMINAL_SERVER_AWARE = $8000;
// Reserved section characteristics
IMAGE_SCN_TYPE_REG = $00000000; // Reserved.
IMAGE_SCN_TYPE_DSECT = $00000001; // Reserved.
IMAGE_SCN_TYPE_NOLOAD = $00000002; // Reserved.
IMAGE_SCN_TYPE_GROUP = $00000004; // Reserved.
IMAGE_SCN_TYPE_COPY = $00000010; // Reserved.
IMAGE_SCN_TYPE_OVER = $00000400; // Reserved.
IMAGE_SCN_MEM_PROTECTED = $00004000; // Obsolete
IMAGE_SCN_MEM_SYSHEAP = $00010000; // Obsolete
{$IFDEF _headers_translated_in_rtl_}
type
(*
typedef struct _IMAGE_OPTIONAL_HEADER64 {
WORD Magic;
BYTE MajorLinkerVersion;
BYTE MinorLinkerVersion;
DWORD SizeOfCode;
DWORD SizeOfInitializedData;
DWORD SizeOfUninitializedData;
DWORD AddressOfEntryPoint;
DWORD BaseOfCode;
ULONGLONG ImageBase;
DWORD SectionAlignment;
DWORD FileAlignment;
WORD MajorOperatingSystemVersion;
WORD MinorOperatingSystemVersion;
WORD MajorImageVersion;
WORD MinorImageVersion;
WORD MajorSubsystemVersion;
WORD MinorSubsystemVersion;
DWORD Win32VersionValue;
DWORD SizeOfImage;
DWORD SizeOfHeaders;
DWORD CheckSum;
WORD Subsystem;
WORD DllCharacteristics;
ULONGLONG SizeOfStackReserve;
ULONGLONG SizeOfStackCommit;
ULONGLONG SizeOfHeapReserve;
ULONGLONG SizeOfHeapCommit;
DWORD LoaderFlags;
DWORD NumberOfRvaAndSizes;
IMAGE_DATA_DIRECTORY DataDirectory[IMAGE_NUMBEROF_DIRECTORY_ENTRIES];
} IMAGE_OPTIONAL_HEADER64, *PIMAGE_OPTIONAL_HEADER64;
*)
PImageOptionalHeader64 = ^TImageOptionalHeader64;
_IMAGE_OPTIONAL_HEADER64 = packed record
Magic: Word;
MajorLinkerVersion: Byte;
MinorLinkerVersion: Byte;
SizeOfCode: DWORD;
SizeOfInitializedData: DWORD;
SizeOfUninitializedData: DWORD;
AddressOfEntryPoint: DWORD;
BaseOfCode: DWORD;
// BaseOfData: DWORD;
ImageBase: Int64;
SectionAlignment: DWORD;
FileAlignment: DWORD;
MajorOperatingSystemVersion: Word;
MinorOperatingSystemVersion: Word;
MajorImageVersion: Word;
MinorImageVersion: Word;
MajorSubsystemVersion: Word;
MinorSubsystemVersion: Word;
Win32VersionValue: DWORD;
SizeOfImage: DWORD;
SizeOfHeaders: DWORD;
CheckSum: DWORD;
Subsystem: Word;
DllCharacteristics: Word;
SizeOfStackReserve: Int64;
SizeOfStackCommit: Int64;
SizeOfHeapReserve: Int64;
SizeOfHeapCommit: Int64;
LoaderFlags: DWORD;
NumberOfRvaAndSizes: DWORD;
DataDirectory: packed array[0..IMAGE_NUMBEROF_DIRECTORY_ENTRIES-1] of TImageDataDirectory;
end;
TImageOptionalHeader64 = _IMAGE_OPTIONAL_HEADER64;
IMAGE_OPTIONAL_HEADER64 = _IMAGE_OPTIONAL_HEADER64;
(*
typedef struct _IMAGE_NT_HEADERS64 {
DWORD Signature;
IMAGE_FILE_HEADER FileHeader;
IMAGE_OPTIONAL_HEADER64 OptionalHeader;
} IMAGE_NT_HEADERS64, *PIMAGE_NT_HEADERS64;
*)
PImageNtHeaders64 = ^TImageNtHeaders64;
_IMAGE_NT_HEADERS64 = packed record
Signature: DWORD;
FileHeader: TImageFileHeader;
OptionalHeader: TImageOptionalHeader64;
end;
TImageNtHeaders64 = _IMAGE_NT_HEADERS64;
IMAGE_NT_HEADERS64 = _IMAGE_NT_HEADERS64;
{$ENDIF}
procedure DumpPEImage(const AProcessHandle: THandle; const AAdress: TDbgPtr);
implementation
{$IFDEF _headers_translated_in_rtl_}
const
DIR_NAMES: array[0..IMAGE_NUMBEROF_DIRECTORY_ENTRIES-1] of string = (
'EXPORT',
'IMPORT',
'RESOURCE',
'EXCEPTION',
'SECURITY',
'BASERELOC',
'DEBUG',
'COPYRIGHT',
'GLOBALPTR',
'TLS',
'LOAD_CONFIG',
'BOUND_IMPORT',
'IAT',
'DELAY_IMPORT',
'COM_DECRIPTOR',
'Unknown(15)'
);
procedure DumpPEImage(const AProcessHandle: THandle; const AAdress: TDbgPtr);
var
DosHeader: TImageDosHeader;
NtHeaders: TImageNtHeaders64; // read it as 64 bit, so there is enough room. The fields will be decoded manually
SectionHeader: TImageSectionHeader;
OH: PImageOptionalHeader64;
BytesRead: Cardinal;
R: Boolean;
n: Integer;
Is64: Boolean;
SectionName: array[0..IMAGE_SIZEOF_SHORT_NAME] of Char;
begin
if not ReadProcessMemory(AProcessHandle, Pointer(AAdress), @DosHeader, SizeOf(DosHeader), BytesRead)
then begin
WriteLN('Unable to retrieve DOS header');
Exit;
end;
if (DosHeader.e_magic <> IMAGE_DOS_SIGNATURE)
or (DosHeader._lfanew = 0)
then begin
WriteLN('Invalid DOS header');
Exit;
end;
if not ReadProcessMemory(AProcessHandle, Pointer(PChar(AAdress) + DosHeader._lfanew), @NTHeaders, SizeOf(NTHeaders), BytesRead)
then begin
WriteLN('Unable to retrieve NT headers');
Exit;
end;
if NTHeaders.Signature <> IMAGE_NT_SIGNATURE
then begin
WriteLN('Invalid NT header: ', IntToHex(NTHeaders.Signature, 8));
Exit;
end;
WriteLN('FileHeader: ');
with NTHeaders.FileHeader do
begin
Write(' Machine: ', IntToHex(Machine, 4));
case Machine of
IMAGE_FILE_MACHINE_I386: WriteLN(' (Intel 386)');
IMAGE_FILE_MACHINE_R3000: WriteLN(' (MIPS little-endian, 0x160 big-endian)');
IMAGE_FILE_MACHINE_R4000: WriteLN(' (MIPS little-endian)');
IMAGE_FILE_MACHINE_R10000: WriteLN(' (MIPS little-endian)');
IMAGE_FILE_MACHINE_ALPHA: WriteLN(' (Alpha_AXP)');
IMAGE_FILE_MACHINE_POWERPC: WriteLN(' (IBM PowerPC Little-Endian)');
IMAGE_FILE_MACHINE_IA64: WriteLN(' (Intel IPF)');
IMAGE_FILE_MACHINE_AMD64: WriteLN(' (x64)');
else
WriteLN;
end;
WriteLN(' NumberOfSections: ', NumberOfSections);
WriteLN(' TimeDateStamp: ', TimeDateStamp);
WriteLN(' PointerToSymbolTable: ', PointerToSymbolTable);
WriteLN(' NumberOfSymbols: ', NumberOfSymbols);
WriteLN(' SizeOfOptionalHeader: ', SizeOfOptionalHeader);
Write(' Characteristics: ', IntToHex(Characteristics, 4), ' [');
if Characteristics and IMAGE_FILE_RELOCS_STRIPPED <> 0 then Write('RELOCS_STRIPPED ');
if Characteristics and IMAGE_FILE_EXECUTABLE_IMAGE <> 0 then Write('EXECUTABLE_IMAGE ');
if Characteristics and IMAGE_FILE_LINE_NUMS_STRIPPED <> 0 then Write('LINE_NUMS_STRIPPED ');
if Characteristics and IMAGE_FILE_LOCAL_SYMS_STRIPPED <> 0 then Write('LOCAL_SYMS_STRIPPED ');
if Characteristics and IMAGE_FILE_AGGRESIVE_WS_TRIM <> 0 then Write('AGGRESIVE_WS_TRIM ');
if Characteristics and IMAGE_FILE_LARGE_ADDRESS_AWARE <> 0 then Write('LARGE_ADDRESS_AWARE ');
if Characteristics and IMAGE_FILE_BYTES_REVERSED_LO <> 0 then Write('BYTES_REVERSED_LO ');
if Characteristics and IMAGE_FILE_32BIT_MACHINE <> 0 then Write('32BIT_MACHINE ');
if Characteristics and IMAGE_FILE_DEBUG_STRIPPED <> 0 then Write('DEBUG_STRIPPED ');
if Characteristics and IMAGE_FILE_REMOVABLE_RUN_FROM_SWAP <> 0 then Write('REMOVABLE_RUN_FROM_SWAP ');
if Characteristics and IMAGE_FILE_NET_RUN_FROM_SWAP <> 0 then Write('NET_RUN_FROM_SWAP ');
if Characteristics and IMAGE_FILE_SYSTEM <> 0 then Write('SYSTEM ');
if Characteristics and IMAGE_FILE_DLL <> 0 then Write('DLL ');
if Characteristics and IMAGE_FILE_UP_SYSTEM_ONLY <> 0 then Write('UP_SYSTEM_ONLY ');
if Characteristics and IMAGE_FILE_BYTES_REVERSED_HI <> 0 then Write('BYTES_REVERSED_HI ');
WriteLN(']');
end;
WriteLN('OptionalHeader: ');
OH := @NTHeaders.OptionalHeader;
Is64 := OH^.Magic = IMAGE_NT_OPTIONAL_HDR64_MAGIC;
Write(' Magic: ', IntToHex(OH^.Magic, 4));
case OH^.Magic of
IMAGE_NT_OPTIONAL_HDR32_MAGIC : WriteLN(' (HDR32)');
IMAGE_NT_OPTIONAL_HDR64_MAGIC : WriteLN(' (HDR64)');
IMAGE_ROM_OPTIONAL_HDR_MAGIC : WriteLN(' (ROM)');
else
WriteLN;
end;
WriteLN(' MajorLinkerVersion: ', OH^.MajorLinkerVersion);
WriteLN(' MinorLinkerVersion: ', OH^.MinorLinkerVersion);
WriteLN(' SizeOfCode: ', OH^.SizeOfCode);
WriteLN(' SizeOfInitializedData: ', OH^.SizeOfInitializedData);
WriteLN(' SizeOfUninitializedData: ', OH^.SizeOfUninitializedData);
WriteLN(' AddressOfEntryPoint: ', FormatAdress(OH^.AddressOfEntryPoint));
WriteLN(' BaseOfCode: ', FormatAdress(OH^.BaseOfCode));
if Is64
then begin
WriteLN(' ImageBase: $', IntToHex(OH^.ImageBase, 16));
end
else begin
WriteLN(' BaseOfData: $', IntToHex(Integer(OH^.ImageBase), 8));
WriteLN(' ImageBase: $', IntToHex(Integer(OH^.ImageBase shr 32), 8));
end;
WriteLN(' SectionAlignment: ', OH^.SectionAlignment);
WriteLN(' FileAlignment: ', OH^.FileAlignment);
WriteLN(' MajorOperatingSystemVersion: ', OH^.MajorOperatingSystemVersion);
WriteLN(' MinorOperatingSystemVersion: ', OH^.MinorOperatingSystemVersion);
WriteLN(' MajorImageVersion: ', OH^.MajorImageVersion);
WriteLN(' MinorImageVersion: ', OH^.MinorImageVersion);
WriteLN(' MajorSubsystemVersion: ', OH^.MajorSubsystemVersion);
WriteLN(' MinorSubsystemVersion: ', OH^.MinorSubsystemVersion);
WriteLN(' Win32VersionValue: ', OH^.Win32VersionValue);
WriteLN(' SizeOfImage: ', OH^.SizeOfImage);
WriteLN(' SizeOfHeaders: ', OH^.SizeOfHeaders);
WriteLN(' CheckSum: ', OH^.CheckSum);
Write(' Subsystem: ', OH^.Subsystem);
case OH^.Subsystem of
IMAGE_SUBSYSTEM_UNKNOWN: WriteLN(' (Unknown)');
IMAGE_SUBSYSTEM_NATIVE: WriteLN(' (Native)');
IMAGE_SUBSYSTEM_WINDOWS_CUI: WriteLN(' (Windows CUI)');
IMAGE_SUBSYSTEM_WINDOWS_GUI: WriteLN(' (Windows GUI)');
IMAGE_SUBSYSTEM_OS2_CUI: WriteLN(' (OS2_CUI)');
IMAGE_SUBSYSTEM_POSIX_CUI: WriteLN(' (POSIX CUI)');
IMAGE_SUBSYSTEM_WINDOWS_CE_GUI: WriteLN(' (Windows CE GUI)');
IMAGE_SUBSYSTEM_XBOX: WriteLN(' (XBOX)');
else
WriteLN;
end;
Write(' DllCharacteristics: ', IntToHex(OH^.DllCharacteristics, 4), ' [');
if OH^.DllCharacteristics and IMAGE_LIBRARY_PROCESS_INIT <> 0 then Write('PROCESS_INIT (reserved) ');
if OH^.DllCharacteristics and IMAGE_LIBRARY_PROCESS_TERM <> 0 then Write('PROCESS_TERM (reserved) ');
if OH^.DllCharacteristics and IMAGE_LIBRARY_THREAD_INIT <> 0 then Write('THREAD_INIT (reserved) ');
if OH^.DllCharacteristics and IMAGE_LIBRARY_THREAD_TERM <> 0 then Write('THREAD_TERM (reserved) ');
if OH^.DllCharacteristics and IMAGE_DLLCHARACTERISTICS_NO_ISOLATION <> 0 then Write('NO_ISOLATION ');
if OH^.DllCharacteristics and IMAGE_DLLCHARACTERISTICS_NO_SEH <> 0 then Write('NO_SEH ');
if OH^.DllCharacteristics and IMAGE_DLLCHARACTERISTICS_NO_BIND <> 0 then Write('NO_BIND ');
if OH^.DllCharacteristics and IMAGE_DLLCHARACTERISTICS_WDM_DRIVER <> 0 then Write('WDM_DRIVER ');
if OH^.DllCharacteristics and IMAGE_DLLCHARACTERISTICS_TERMINAL_SERVER_AWARE <> 0 then Write('TERMINAL_SERVER_AWARE ');
WriteLN(']');
Write(' SizeOfStackReserve: $');
if Is64
then begin
WriteLN(IntToHex(OH^.SizeOfStackReserve, 16));
end
else begin
WriteLN(IntToHex(Integer(OH^.SizeOfStackReserve), 8));
Dec(PChar(OH), 4); // adjust with 4 bytes so the next record matches again
end;
Write(' SizeOfStackCommit: $');
if Is64
then begin
WriteLN(IntToHex(OH^.SizeOfStackCommit, 16));
end
else begin
WriteLN(IntToHex(Integer(OH^.SizeOfStackCommit), 8));
Dec(PChar(OH), 4); // adjust with 4 bytes so the next record matches again
end;
Write(' SizeOfHeapReserve: $');
if Is64
then begin
WriteLN(IntToHex(OH^.SizeOfHeapReserve, 16));
end
else begin
WriteLN(IntToHex(Integer(OH^.SizeOfHeapReserve), 8));
Dec(PChar(OH), 4); // adjust with 4 bytes so the next record matches again
end;
Write(' SizeOfHeapCommit: $');
if Is64
then begin
WriteLN(IntToHex(OH^.SizeOfHeapCommit, 16));
end
else begin
WriteLN(IntToHex(Integer(OH^.SizeOfHeapCommit), 8));
Dec(PChar(OH), 4); // adjust with 4 bytes so the next record matches again
end;
WriteLN(' LoaderFlags: ', OH^.LoaderFlags);
WriteLN(' NumberOfRvaAndSizes: ', OH^.NumberOfRvaAndSizes);
WriteLN(' DataDirectory:');
for n := 0 to IMAGE_NUMBEROF_DIRECTORY_ENTRIES-1 do
begin
WriteLN(' [', DIR_NAMES[n]+']':14, ' Adress: $', IntToHex(OH^.DataDirectory[n].VirtualAddress, 8), ' Size: ', OH^.DataDirectory[n]. Size);
end;
WriteLN('Sections: ');
for n := 0 to NtHeaders.FileHeader.NumberOfSections - 1 do
begin
if not ReadProcessMemory(AProcessHandle, Pointer(Cardinal(AAdress) + DosHeader._lfanew + SizeOF(NTHeaders) - SizeOF(NTHeaders.OptionalHeader) + NTHeaders.FileHeader.SizeOfOptionalHeader + SizeOf(SectionHeader) * n), @SectionHeader, SizeOf(SectionHeader), BytesRead)
then begin
WriteLN('Unable to retrieve section: ', n);
Continue;
end;
with SectionHeader do
begin
Move(Name, SectionName, IMAGE_SIZEOF_SHORT_NAME);
SectionName[IMAGE_SIZEOF_SHORT_NAME] := #0;
WriteLN(' Name: ',SectionName);
WriteLN(' Misc.PhysicalAddress: ',FormatAdress(Misc.PhysicalAddress));
WriteLN(' Misc.VirtualSize: ',Misc.VirtualSize);
WriteLN(' VirtualAddress: ',FormatAdress(VirtualAddress));
WriteLN(' SizeOfRawData: ',SizeOfRawData);
WriteLN(' PointerToRawData: ',FormatAdress(PointerToRawData));
WriteLN(' PointerToRelocations: ',FormatAdress(PointerToRelocations));
WriteLN(' PointerToLinenumbers: ',FormatAdress(PointerToLinenumbers));
WriteLN(' NumberOfRelocations: ',NumberOfRelocations);
WriteLN(' NumberOfLinenumbers: ',NumberOfLinenumbers);
Write(' Characteristics: ', IntToHex(Characteristics, 8), ' [');
if Characteristics and IMAGE_SCN_TYPE_REG <> 0 then Write('IMAGE_SCN_TYPE_REG(r) ');
if Characteristics and IMAGE_SCN_TYPE_DSECT <> 0 then Write('IMAGE_SCN_TYPE_DSECT(r) ');
if Characteristics and IMAGE_SCN_TYPE_NOLOAD <> 0 then Write('IMAGE_SCN_TYPE_NOLOAD(r) ');
if Characteristics and IMAGE_SCN_TYPE_GROUP <> 0 then Write('IMAGE_SCN_TYPE_GROUP(r) ');
if Characteristics and IMAGE_SCN_TYPE_NO_PAD <> 0 then Write('IMAGE_SCN_TYPE_NO_PAD(r) ');
if Characteristics and IMAGE_SCN_TYPE_COPY <> 0 then Write('IMAGE_SCN_TYPE_COPY(r) ');
if Characteristics and IMAGE_SCN_CNT_CODE <> 0 then Write('IMAGE_SCN_CNT_CODE ');
if Characteristics and IMAGE_SCN_CNT_INITIALIZED_DATA <> 0 then Write('IMAGE_SCN_CNT_INITIALIZED_DATA ');
if Characteristics and IMAGE_SCN_CNT_UNINITIALIZED_DATA <> 0 then Write('IMAGE_SCN_CNT_UNINITIALIZED_DATA ');
if Characteristics and IMAGE_SCN_LNK_OTHER <> 0 then Write('IMAGE_SCN_LNK_OTHER(r) ');
if Characteristics and IMAGE_SCN_LNK_INFO <> 0 then Write('IMAGE_SCN_LNK_INFO(r) ');
if Characteristics and IMAGE_SCN_TYPE_OVER <> 0 then Write('IMAGE_SCN_TYPE_OVER(r) ');
if Characteristics and IMAGE_SCN_LNK_COMDAT <> 0 then Write('IMAGE_SCN_LNK_COMDAT ');
if Characteristics and IMAGE_SCN_MEM_PROTECTED <> 0 then Write('IMAGE_SCN_MEM_PROTECTED(o) ');
if Characteristics and IMAGE_SCN_MEM_FARDATA <> 0 then Write('IMAGE_SCN_MEM_FARDATA(r) ');
if Characteristics and IMAGE_SCN_MEM_SYSHEAP <> 0 then Write('IMAGE_SCN_MEM_SYSHEAP(o) ');
if Characteristics and IMAGE_SCN_MEM_PURGEABLE <> 0 then Write('IMAGE_SCN_MEM_PURGEABLE(r) ');
if Characteristics and IMAGE_SCN_MEM_16BIT <> 0 then Write('IMAGE_SCN_MEM_16BIT(r) ');
if Characteristics and IMAGE_SCN_MEM_LOCKED <> 0 then Write('IMAGE_SCN_MEM_LOCKED(r) ');
if Characteristics and IMAGE_SCN_MEM_PRELOAD <> 0 then Write('IMAGE_SCN_MEM_PRELOAD(r) ');
// Align
if Characteristics and $00F00000 <> 0
then Write('IMAGE_SCN_ALIGN_', 1 shl (((Characteristics and $00F00000) shr 20) - 1),'BYTES ');
if Characteristics and IMAGE_SCN_LNK_NRELOC_OVFL <> 0 then Write('IMAGE_SCN_LNK_NRELOC_OVFL ');
if Characteristics and IMAGE_SCN_MEM_DISCARDABLE <> 0 then Write('IMAGE_SCN_MEM_DISCARDABLE ');
if Characteristics and IMAGE_SCN_MEM_NOT_CACHED <> 0 then Write('IMAGE_SCN_MEM_NOT_CACHED ');
if Characteristics and IMAGE_SCN_MEM_NOT_PAGED <> 0 then Write('IMAGE_SCN_MEM_NOT_PAGED ');
if Characteristics and IMAGE_SCN_MEM_SHARED <> 0 then Write('IMAGE_SCN_MEM_SHARED ');
if Characteristics and IMAGE_SCN_MEM_EXECUTE <> 0 then Write('IMAGE_SCN_MEM_EXECUTE ');
if Characteristics and IMAGE_SCN_MEM_READ <> 0 then Write('IMAGE_SCN_MEM_READ ');
if Characteristics and IMAGE_SCN_MEM_WRITE <> 0 then Write('IMAGE_SCN_MEM_WRITE ');
WriteLN(']');
end;
end;
end;
{$ELSE}
procedure DumpPEImage(const AProcessHandle: THandle; const AAdress: TDbgPtr);
begin
{$WARNING PEHeaders not yet translated}
end;
{$ENDIF}
end.

421
debugger/windebug/fpwd/fpwdtype.pas Normal file
View File

@ -0,0 +1,421 @@
{ $Id: $ }
{
---------------------------------------------------------------------------
fpwdtype.pas - FP standalone windows debugger - Type definitions
---------------------------------------------------------------------------
This unit contains types/consts not yet part of the RTL.
It also contains some experimental types for mixing win32 and win64
---------------------------------------------------------------------------
@created(Mon Apr 10th WET 2006)
@lastmod($Date: $)
@author(Marc Weustink <marc@@dommelstein.nl>)
***************************************************************************
* *
* This source is free software; you can redistribute it and/or modify *
* it under the terms of the GNU General Public License as published by *
* the Free Software Foundation; either version 2 of the License, or *
* (at your option) any later version. *
* *
* This code is distributed in the hope that it will be useful, but *
* WITHOUT ANY WARRANTY; without even the implied warranty of *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
* General Public License for more details. *
* *
* A copy of the GNU General Public License is available on the World *
* Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
* obtain it by writing to the Free Software Foundation, *
* Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *
* *
***************************************************************************
}
unit FPWDType;
{$mode objfpc}{$H+}
{$ALIGN ON}
// Additional 64bit types
interface
uses
Windows;
type
DWORD64 = QWORD;
ULONGLONG = QWORD;
// LONGLONG = int64;
//QWORD = type cardinal;
const
THREAD_TERMINATE = $0001;
THREAD_SUSPEND_RESUME = $0002;
THREAD_GET_CONTEXT = $0008;
THREAD_SET_CONTEXT = $0010;
THREAD_SET_INFORMATION = $0020;
THREAD_QUERY_INFORMATION = $0040;
THREAD_SET_THREAD_TOKEN = $0080;
THREAD_IMPERSONATE = $0100;
THREAD_DIRECT_IMPERSONATION = $0200;
THREAD_ALL_ACCESS = STANDARD_RIGHTS_REQUIRED or SYNCHRONIZE or $3FF;
type
PExceptionRecord64 = QWORD;
// PExceptionRecord64 = ^_EXCEPTION_RECORD64;
_EXCEPTION_RECORD64 = record
ExceptionCode: DWORD;
ExceptionFlags: DWORD;
ExceptionRecord: PExceptionRecord64;
ExceptionAddress: QWORD;
NumberParameters: DWORD;
__unusedAlignment: DWORD;
ExceptionInformation: array[0..EXCEPTION_MAXIMUM_PARAMETERS - 1] of QWORD;
end;
TExceptionRecord64 = _EXCEPTION_RECORD64;
EXCEPTION_RECORD64 = _EXCEPTION_RECORD64;
(*
PContext64 = QWORD;
PExceptionPointers64 = QWORD;
_EXCEPTION_POINTERS64 = record
ExceptionRecord : PExceptionRecord64;
ContextRecord : PContext64;
end;
TExceptionPointers64 = _EXCEPTION_POINTERS64;
EXCEPTION_POINTERS64 = _EXCEPTION_POINTERS64;
*)
// PExceptionDebugInfo64 = QWORD;
PExceptionDebugInfo64 = ^_EXCEPTION_DEBUG_INFO64;
_EXCEPTION_DEBUG_INFO64 = record
ExceptionRecord: TExceptionRecord64;
dwFirstChance: DWORD;
end;
TExceptionDebugInfo64 = _EXCEPTION_DEBUG_INFO64;
EXCEPTION_DEBUG_INFO64 = _EXCEPTION_DEBUG_INFO64;
(*
PCreateThreadDebugInfo64 = QWORD;
_CREATE_THREAD_DEBUG_INFO64 = record
hThread: QWORD;
lpThreadLocalBase: QWORD;
lpStartAddress: QWORD;
end;
TCreateThreadDebugInfo = _CREATE_THREAD_DEBUG_INFO;
CREATE_THREAD_DEBUG_INFO = _CREATE_THREAD_DEBUG_INFO;
PCreateProcessDebugInfo = QWORD;
_CREATE_PROCESS_DEBUG_INFO = record
hFile: THandle;
hProcess: THandle;
hThread: THandle;
lpBaseOfImage: Pointer;
dwDebugInfoFileOffset: DWORD;
nDebugInfoSize: DWORD;
lpThreadLocalBase: Pointer;
lpStartAddress: TFNThreadStartRoutine;
lpImageName: Pointer;
fUnicode: Word;
end;
TCreateProcessDebugInfo = _CREATE_PROCESS_DEBUG_INFO;
CREATE_PROCESS_DEBUG_INFO = _CREATE_PROCESS_DEBUG_INFO;
PExitThreadDebugInfo64 = QWORD;
PExitProcessDebugInfo64 = QWORD;
PLoadDLLDebugInfo64 = QWORD;
_LOAD_DLL_DEBUG_INFO64 = record
hFile: QWORD;
lpBaseOfDll: QWORD;
dwDebugInfoFileOffset: DWORD;
nDebugInfoSize: DWORD;
lpImageName: Pointer;
fUnicode: Word;
end;
{$EXTERNALSYM _LOAD_DLL_DEBUG_INFO}
TLoadDLLDebugInfo = _LOAD_DLL_DEBUG_INFO;
LOAD_DLL_DEBUG_INFO = _LOAD_DLL_DEBUG_INFO;
{$EXTERNALSYM LOAD_DLL_DEBUG_INFO}
PUnloadDLLDebugInfo = ^TUnloadDLLDebugInfo;
_UNLOAD_DLL_DEBUG_INFO = record
lpBaseOfDll: Pointer;
end;
{$EXTERNALSYM _UNLOAD_DLL_DEBUG_INFO}
TUnloadDLLDebugInfo = _UNLOAD_DLL_DEBUG_INFO;
UNLOAD_DLL_DEBUG_INFO = _UNLOAD_DLL_DEBUG_INFO;
{$EXTERNALSYM UNLOAD_DLL_DEBUG_INFO}
POutputDebugStringInfo = ^TOutputDebugStringInfo;
_OUTPUT_DEBUG_STRING_INFO = record
lpDebugStringData: LPSTR;
fUnicode: Word;
nDebugStringLength: Word;
end;
{$EXTERNALSYM _OUTPUT_DEBUG_STRING_INFO}
TOutputDebugStringInfo = _OUTPUT_DEBUG_STRING_INFO;
OUTPUT_DEBUG_STRING_INFO = _OUTPUT_DEBUG_STRING_INFO;
{$EXTERNALSYM OUTPUT_DEBUG_STRING_INFO}
PRIPInfo64 = QWORD;
*)
PDebugEvent64 = ^TDebugEvent64;
_DEBUG_EVENT64 = record
dwDebugEventCode: DWORD;
dwProcessId: DWORD;
dwThreadId: DWORD;
case Integer of
0: (Exception: TExceptionDebugInfo);
1: (CreateThread: TCreateThreadDebugInfo);
2: (CreateProcessInfo: TCreateProcessDebugInfo);
3: (ExitThread: TExitThreadDebugInfo);
4: (ExitProcess: TExitProcessDebugInfo);
5: (LoadDll: TLoadDLLDebugInfo);
6: (UnloadDll: TUnloadDLLDebugInfo);
7: (DebugString: TOutputDebugStringInfo);
8: (RipInfo: TRIPInfo);
9: (Exception64: TExceptionDebugInfo64);
end;
TDebugEvent64 = _DEBUG_EVENT64;
DEBUG_EVENT64 = _DEBUG_EVENT64;
const
CONTEXT_AMD64 = $100000;
// MWE: added _AMD64 postfix to distinguish between i386 and amd64
CONTEXT_CONTROL_AMD64 = (CONTEXT_AMD64 or $00000001);
CONTEXT_INTEGER_AMD64 = (CONTEXT_AMD64 or $00000002);
CONTEXT_SEGMENTS_AMD64 = (CONTEXT_AMD64 or $00000004);
CONTEXT_FLOATING_POINT_AMD64 = (CONTEXT_AMD64 or $00000008);
CONTEXT_DEBUG_REGISTERS_AMD64 = (CONTEXT_AMD64 or $00000010);
CONTEXT_FULL_AMD64 = (CONTEXT_CONTROL_AMD64 or CONTEXT_INTEGER_AMD64 or CONTEXT_FLOATING_POINT_AMD64);
CONTEXT_ALL_AMD64 = (CONTEXT_CONTROL_AMD64 or CONTEXT_INTEGER_AMD64 or CONTEXT_SEGMENTS_AMD64 or CONTEXT_FLOATING_POINT_AMD64 or CONTEXT_DEBUG_REGISTERS_AMD64);
CONTEXT_EXCEPTION_ACTIVE_AMD64 = $08000000;
CONTEXT_SERVICE_ACTIVE_AMD64 = $10000000;
CONTEXT_EXCEPTION_REQUEST_AMD64 = $40000000;
CONTEXT_EXCEPTION_REPORTING_AMD64 = $80000000;
//
// Define initial MxCsr and FpCsr control.
//
//#define INITIAL_MXCSR 0x1f80 // initial MXCSR value
//#define INITIAL_FPCSR 0x027f // initial FPCSR value
//
// Define 128-bit 16-byte aligned xmm register type.
//
//typedef struct DECLSPEC_ALIGN(16) _M128A {
type
_M128A = record
Low: ULONGLONG;
High: LONGLONG;
end;
M128A = _M128A;
TM128A = _M128A;
PM128A = TM128A;
//
// Format of data for 32-bit fxsave/fxrstor instructions.
//
//typedef struct _XMM_SAVE_AREA32 {
type
_XMM_SAVE_AREA32 = record
ControlWord: WORD;
StatusWord: WORD;
TagWord: BYTE;
Reserved1: BYTE;
ErrorOpcode: WORD;
ErrorOffset: DWORD;
ErrorSelector: WORD;
Reserved2: WORD;
DataOffset: DWORD;
DataSelector: WORD;
Reserved3: WORD;
MxCsr: DWORD;
MxCsr_Mask: DWORD;
FloatRegisters: array[0..7] of M128A;
XmmRegisters: array[0..16] of M128A;
Reserved4: array[0..95] of BYTE;
end;
XMM_SAVE_AREA32 = _XMM_SAVE_AREA32;
TXmmSaveArea = XMM_SAVE_AREA32;
PXmmSaveArea = ^TXmmSaveArea;
const
LEGACY_SAVE_AREA_LENGTH = sizeof(XMM_SAVE_AREA32);
//
// Context Frame
//
// This frame has a several purposes: 1) it is used as an argument to
// NtContinue, 2) is is used to constuct a call frame for APC delivery,
// and 3) it is used in the user level thread creation routines.
//
//
// The flags field within this record controls the contents of a CONTEXT
// record.
//
// If the context record is used as an input parameter, then for each
// portion of the context record controlled by a flag whose value is
// set, it is assumed that that portion of the context record contains
// valid context. If the context record is being used to modify a threads
// context, then only that portion of the threads context is modified.
//
// If the context record is used as an output parameter to capture the
// context of a thread, then only those portions of the thread's context
// corresponding to set flags will be returned.
//
// CONTEXT_CONTROL specifies SegSs, Rsp, SegCs, Rip, and EFlags.
//
// CONTEXT_INTEGER specifies Rax, Rcx, Rdx, Rbx, Rbp, Rsi, Rdi, and R8-R15.
//
// CONTEXT_SEGMENTS specifies SegDs, SegEs, SegFs, and SegGs.
//
// CONTEXT_DEBUG_REGISTERS specifies Dr0-Dr3 and Dr6-Dr7.
//
// CONTEXT_MMX_REGISTERS specifies the floating point and extended registers
// Mm0/St0-Mm7/St7 and Xmm0-Xmm15).
//
//typedef struct DECLSPEC_ALIGN(16) _CONTEXT {
type
_CONTEXTAMD64 = record
//
// Register parameter home addresses.
//
// N.B. These fields are for convience - they could be used to extend the
// context record in the future.
//
P1Home: DWORD64;
P2Home: DWORD64;
P3Home: DWORD64;
P4Home: DWORD64;
P5Home: DWORD64;
P6Home: DWORD64;
//
// Control flags.
//
ContextFlags: DWORD;
MxCsr: DWORD;
//
// Segment Registers and processor flags.
//
SegCs: WORD;
SegDs: WORD;
SegEs: WORD;
SegFs: WORD;
SegGs: WORD;
SegSs: WORD;
EFlags: DWORD;
//
// Debug registers
//
Dr0: DWORD64;
Dr1: DWORD64;
Dr2: DWORD64;
Dr3: DWORD64;
Dr6: DWORD64;
Dr7: DWORD64;
//
// Integer registers.
//
Rax: DWORD64;
Rcx: DWORD64;
Rdx: DWORD64;
Rbx: DWORD64;
Rsp: DWORD64;
Rbp: DWORD64;
Rsi: DWORD64;
Rdi: DWORD64;
R8: DWORD64;
R9: DWORD64;
R10: DWORD64;
R11: DWORD64;
R12: DWORD64;
R13: DWORD64;
R14: DWORD64;
R15: DWORD64;
//
// Program counter.
//
Rip: DWORD64;
//
// Floating point state.
//
FltSave: XMM_SAVE_AREA32; // MWE: only translated the FltSave part of the union
(*
union {
XMM_SAVE_AREA32 FltSave;
struct {
M128A Header[2];
M128A Legacy[8];
M128A Xmm0;
M128A Xmm1;
M128A Xmm2;
M128A Xmm3;
M128A Xmm4;
M128A Xmm5;
M128A Xmm6;
M128A Xmm7;
M128A Xmm8;
M128A Xmm9;
M128A Xmm10;
M128A Xmm11;
M128A Xmm12;
M128A Xmm13;
M128A Xmm14;
M128A Xmm15;
};
};
*)
//
// Vector registers.
//
VectorRegister: array[0..25] of M128A;
VectorControl: DWORD64;
//
// Special debug control registers.
//
DebugControl: DWORD64;
LastBranchToRip: DWORD64;
LastBranchFromRip: DWORD64;
LastExceptionToRip: DWORD64;
LastExceptionFromRip: DWORD64;
end;
CONTEXTAMD64 = _CONTEXTAMD64;
TContextAMD64 = _CONTEXTAMD64;
PContextAMD64 = ^TContextAMD64;
implementation
end.

690
debugger/windebug/windebugger.pp Normal file
View File

@ -0,0 +1,690 @@
{ $Id: $ }
{
---------------------------------------------------------------------------
windebugger.pp - Native windows debugger
---------------------------------------------------------------------------
This unit contains debugger classes for a native windows debugger
---------------------------------------------------------------------------
@created(Mon Apr 10th WET 2006)
@lastmod($Date: $)
@author(Marc Weustink <marc@@dommelstein.nl>)
***************************************************************************
* *
* This source is free software; you can redistribute it and/or modify *
* it under the terms of the GNU General Public License as published by *
* the Free Software Foundation; either version 2 of the License, or *
* (at your option) any later version. *
* *
* This code is distributed in the hope that it will be useful, but *
* WITHOUT ANY WARRANTY; without even the implied warranty of *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
* General Public License for more details. *
* *
* A copy of the GNU General Public License is available on the World *
* Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
* obtain it by writing to the Free Software Foundation, *
* Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *
* *
***************************************************************************
}
unit WinDebugger;
{$mode objfpc}{$H+}
interface
uses
Windows, Classes, Maps, WindExtra;
type
TDbgPtr = PtrUInt;
TDbgProcess = class;
TDbgThread = class(TObject)
private
FProcess: TDbgProcess;
FID: Integer;
FHandle: THandle;
FBaseAddr: Pointer;
FStartAddr: Pointer;
FSingleStepping: Boolean;
protected
public
constructor Create(const AProcess: TDbgProcess; const AID: Integer; const AHandle: THandle; const ABase, AStart: Pointer);
destructor Destroy; override;
function SingleStep: Boolean;
property ID: Integer read FID;
property Handle: THandle read FHandle;
property SingleStepping: boolean read FSingleStepping;
end;
(*
TDbgSymbol = class(TObject)
private
FName: String;
FOffset: Integer;
FLength: Integer;
function GetAddress: Pointer;
protected
public
constructor Create(const AName: String; const AOffset: Integer);
property Address: Pointer read GetAddress;
property Length: Integer read FLength;
end;
*)
TDbgBreakpoint = class;
TDbgBreakpointEvent = procedure(const ASender: TDbgBreakpoint; const AContext: TContext) of object;
TDbgBreakpoint = class(TObject)
private
FProcess: TDbgProcess;
FLocation: TDbgPtr;
FOrgValue: Byte;
procedure SetBreak;
procedure ResetBreak;
protected
public
constructor Create(const AProcess: TDbgProcess; const ALocation: TDbgPtr);
destructor Destroy; override;
function Hit(const AThreadID: Integer): Boolean;
end;
TDbgInstance = class(TObject)
private
FName: String;
FProcess: TDbgProcess;
FModuleHandle: THandle;
FBaseAddr: TDbgPtr;
FBreakList: TList;
procedure CheckName;
procedure SetName(const AValue: String);
public
constructor Create(const AProcess: TDbgProcess; const ADefaultName: String; const AModuleHandle: THandle; const ABaseAddr, ANameAddr: TDbgPtr; const AUnicode: Boolean);
destructor Destroy; override;
property Process: TDbgProcess read FProcess;
property ModuleHandle: THandle read FModuleHandle;
property BaseAddr: TDbgPtr read FBaseAddr;
end;
TDbgLibrary = class(TDbgInstance)
private
public
constructor Create(const AProcess: TDbgProcess; const ADefaultName: String; const AInfo: TLoadDLLDebugInfo);
property Name: String read FName;
end;
TDbgProcess = class(TDbgInstance)
private
FProcessID: Integer;
FThreadID: Integer;
FInfo: TCreateProcessDebugInfo;
FThreadMap: TMap; // map ThreadID -> ThreadObject
FLibMap: TMap; // map LibAddr -> LibObject
FBreakMap: TMap; // map BreakAddr -> BreakObject
FMainThread: TDbgThread;
FSingleStepBreak: TDbgBreakpoint; // set if we are executing the code at the break
// if the singlestep is done, set the break
FSingleStepSet: Boolean; // set if we set the singlestep to correct the BP
procedure SetName(const AValue: String);
procedure ThreadDestroyed(const AThread: TDbgThread);
protected
public
constructor Create(const ADefaultName: String; const AProcessID, AThreadID: Integer; const AInfo: TCreateProcessDebugInfo);
destructor Destroy; override;
function AddBreak(const ALocation: TDbgPtr): TDbgBreakpoint;
function AddLib(const AInfo: TLoadDLLDebugInfo): TDbgLibrary;
procedure AddThread(const AID: Integer; const AInfo: TCreateThreadDebugInfo);
// function GetLib(const AHandle: THandle; var ALib: TDbgLibrary): Boolean;
procedure Interrupt;
function GetThread(const AID: Integer; var AThread: TDbgThread): Boolean;
procedure ContinueDebugEvent(const AThread: TDbgThread; const ADebugEvent: TDebugEvent);
function HandleDebugEvent(const ADebugEvent: TDebugEvent): Boolean;
function RemoveBreak(const ALocation: TDbgPtr): TDbgBreakpoint;
procedure RemoveLib(const AInfo: TUnloadDLLDebugInfo);
procedure RemoveThread(const AID: DWord);
function ReadData(const AAdress: TDbgPtr; const ASize: Cardinal; out AData): Boolean;
function ReadOrdinal(const AAdress: TDbgPtr; out AData): Boolean;
function ReadString(const AAdress: TDbgPtr; const AMaxSize: Cardinal; out AData: String): Boolean;
function ReadWString(const AAdress: TDbgPtr; const AMaxSize: Cardinal; out AData: WideString): Boolean;
function WriteData(const AAdress: TDbgPtr; const ASize: Cardinal; const AData): Boolean;
property Handle: THandle read FInfo.hProcess;
property Name: String read FName write SetName;
end;
implementation
uses
SysUtils;
procedure Log(const AText: String; const AParams: array of const); overload;
begin
WriteLN(Format(AText, AParams));
end;
procedure Log(const AText: String); overload;
begin
WriteLN(AText);
end;
procedure LogLastError;
begin
WriteLN('ERROR: ', GetLastErrorText);
end;
{ TDbgInstance }
procedure TDbgInstance.CheckName;
begin
if FName = ''
then FName := Format('@%p', [FBaseAddr]);
end;
constructor TDbgInstance.Create(const AProcess: TDbgProcess; const ADefaultName: String; const AModuleHandle: THandle; const ABaseAddr, ANameAddr: TDbgPtr; const AUnicode: Boolean);
var
NamePtr: TDbgPtr;
S: String;
W: WideString;
len: Integer;
begin
FBaseAddr := ABaseAddr;
FModuleHandle := AModuleHandle;
FBreakList := TList.Create;
inherited Create;
W := '';
if AProcess.ReadOrdinal(ANameAddr, NamePtr)
then begin
if AUnicode
then begin
AProcess.ReadWString(NamePtr, MAX_PATH, W);
end
else begin
if AProcess.ReadString(NamePtr, MAX_PATH, S)
then W := S;
end;
end;
if W = ''
then begin
SetLength(S, MAX_PATH);
len := GetModuleFileName(FModuleHandle, @S[1], MAX_PATH);
if len > 0
then SetLength(S, len - 1)
else begin
S := '';
LogLastError;
end;
W := S;
end;
if W = ''
then W := ADefaultName;
SetName(W);
end;
destructor TDbgInstance.Destroy;
var
n: integer;
begin
for n := 0 to FBreakList.Count - 1 do
begin
Process.RemoveBreak(TDbgBreakpoint(FBreakList[n]).FLocation);
end;
FBreakList.Clear;
FreeAndNil(FBreakList);
inherited;
end;
procedure TDbgInstance.SetName(const AValue: String);
begin
FName := AValue;
CheckName;
end;
{ TDbgLibrary }
constructor TDbgLibrary.Create(const AProcess: TDbgProcess; const ADefaultName: String; const AInfo: TLoadDLLDebugInfo);
begin
inherited Create(AProcess, ADefaultName, AInfo.hFile, TDbgPtr(AInfo.lpBaseOfDll), TDbgPtr(AInfo.lpImageName), AInfo.fUnicode <> 0);
end;
{ TDbgProcess }
function TDbgProcess.AddBreak(const ALocation: TDbgPtr): TDbgBreakpoint;
begin
Result := TDbgBreakpoint.Create(Self, ALocation);
FBreakMap.Add(ALocation, Result);
end;
function TDbgProcess.AddLib(const AInfo: TLoadDLLDebugInfo): TDbgLibrary;
begin
Result := TDbgLibrary.Create(Self, FormatAdress(AInfo.lpBaseOfDll), AInfo);
FLibMap.Add(TDbgPtr(AInfo.lpBaseOfDll), Result);
end;
procedure TDbgProcess.AddThread(const AID: Integer; const AInfo: TCreateThreadDebugInfo);
var
Thread: TDbgThread;
begin
Thread := TDbgThread.Create(Self, AID, AInfo.hThread, AInfo.lpThreadLocalBase, AInfo.lpStartAddress);
FThreadMap.Add(AID, Thread);
end;
procedure TDbgProcess.ContinueDebugEvent(const AThread: TDbgThread; const ADebugEvent: TDebugEvent);
begin
case ADebugEvent.dwDebugEventCode of
EXCEPTION_DEBUG_EVENT: begin
case ADebugEvent.Exception.ExceptionRecord.ExceptionCode of
EXCEPTION_BREAKPOINT: begin
if AThread = nil then Exit;
if FSingleStepBreak = nil then Exit;
if AThread.SingleStepping then Exit;
AThread.SingleStep;
end;
end;
end;
end;
end;
constructor TDbgProcess.Create(const ADefaultName: String; const AProcessID, AThreadID: Integer; const AInfo: TCreateProcessDebugInfo);
const
{$IFDEF CPU64}
MAP_ID_SIZE = itu8;
{$ELSE}
MAP_ID_SIZE = itu4;
{$ENDIF}
begin
FProcessID := AProcessID;
FThreadID := AThreadID;
FInfo := AInfo;
FThreadMap := TMap.Create(itu4, SizeOf(TDbgThread));
FLibMap := TMap.Create(MAP_ID_SIZE, SizeOf(TDbgLibrary));
FBreakMap := TMap.Create(MAP_ID_SIZE, SizeOf(TDbgBreakpoint));
FSingleStepBreak := nil;
inherited Create(Self, ADefaultName, AInfo.hFile, TDbgPtr(AInfo.lpBaseOfImage), TDbgPtr(AInfo.lpImageName), AInfo.fUnicode <> 0);
FMainThread := TDbgThread.Create(Self, AThreadID, FInfo.hThread, FInfo.lpThreadLocalBase, FInfo.lpStartAddress);
FThreadMap.Add(AThreadID, FMainThread);
end;
destructor TDbgProcess.Destroy;
begin
// CloseHandle(FInfo.hThread);
CloseHandle(FInfo.hProcess);
FreeAndNil(FBreakMap);
FreeAndNil(FThreadMap);
FreeAndNil(FLibMap);
inherited;
end;
(*
function TDbgProcess.GetLib(const AHandle: THandle; var ALib: TDbgLibrary): Boolean;
var
n: Integer;
Lib: TDbgLibrary;
begin
for n := 0 to FLibraries.Count - 1 do
begin
Lib := TDbgLibrary(FLibraries[n]);
if Lib.ModuleHandle <> AHandle then Continue;
Result := True;
ALib := Lib;
Exit;
end;
Result := False;
end;
*)
function TDbgProcess.GetThread(const AID: Integer; var AThread: TDbgThread): Boolean;
var
Thread: TDbgThread;
begin
Result := FThreadMap.GetData(AID, Thread) and (Thread <> nil);
if Result
then AThread := Thread
else Log('Unknown thread ID %u for process %u', [AID, FProcessID]);
end;
function TDbgProcess.HandleDebugEvent(const ADebugEvent: TDebugEvent): Boolean;
var
Context: TContext;
begin
Result := False;
case ADebugEvent.dwDebugEventCode of
EXCEPTION_DEBUG_EVENT: begin
case ADebugEvent.Exception.ExceptionRecord.ExceptionCode of
EXCEPTION_BREAKPOINT: begin
if not FBreakMap.GetData(TDbgPtr(ADebugEvent.Exception.ExceptionRecord.ExceptionAddress), FSingleStepBreak) then Exit;
if FSingleStepBreak = nil then Exit;
Result := True;
if not FSingleStepBreak.Hit(ADebugEvent.dwThreadId)
then FSingleStepBreak := nil; // no need for a singlestep if we continue
end;
EXCEPTION_SINGLE_STEP: begin
// check if we are interupting
Context.ContextFlags := CONTEXT_DEBUG_REGISTERS;
if GetThreadContext(FInfo.hThread, Context)
then begin
if Context.Dr6 and 1 <> 0
then begin
// interrupt !
// disable break.
Context.Dr7 := Context.Dr7 and not $1;
Context.Dr0 := 0;
if not SetThreadContext(FInfo.hThread, Context)
then begin
// Heeellppp!!
Log('Thread %u: Unable to reset BR0', [ADebugEvent.dwThreadId]);
end;
// check if we are also singlestepping
// if not, then exit, else proceed to next check
if Context.Dr6 and $40 = 0
then Exit;
end;
end
else begin
// if we cant get the context, we probable weren't able to set it either
Log('Thread %u: Unable to get context', [ADebugEvent.dwThreadId]);
end;
// check if we are single stepping
if FSingleStepBreak = nil then Exit;
FSingleStepBreak.SetBreak;
FSingleStepBreak := nil;
Result := FSingleStepSet;
FSingleStepSet := False;
end;
end;
end;
CREATE_THREAD_DEBUG_EVENT: begin
AddThread(ADebugEvent.dwThreadId, ADebugEvent.CreateThread)
end;
EXIT_THREAD_DEBUG_EVENT: begin
RemoveThread(ADebugEvent.dwThreadId);
end;
LOAD_DLL_DEBUG_EVENT: begin
AddLib(ADebugEvent.LoadDll);
end;
UNLOAD_DLL_DEBUG_EVENT: begin
RemoveLib(ADebugEvent.UnloadDll);
end;
end;
end;
procedure TDbgProcess.Interrupt;
var
Context: TContext;
r: DWORD;
begin
r := SuspendThread(FInfo.hThread);
try
Context.ContextFlags := CONTEXT_CONTROL or CONTEXT_DEBUG_REGISTERS;
if not GetThreadContext(FInfo.hThread, Context)
then begin
// Log('Thread %u: Unable to get context', [FID]);
Exit;
end;
Context.ContextFlags := CONTEXT_DEBUG_REGISTERS;
Context.Dr0 := Context.Eip;
Context.Dr7 := (Context.Dr7 and $FFF0FFFF) or $1;
// Context.EFlags := Context.EFlags or $100;
if not SetThreadContext(FInfo.hThread, Context)
then begin
// Log('Thread %u: Unable to set context', [FID]);
Exit;
end;
finally
r := ResumeTHread(FInfo.hThread);
end;
end;
function TDbgProcess.ReadData(const AAdress: TDbgPtr; const ASize: Cardinal; out AData): Boolean;
var
BytesRead: Cardinal;
begin
Result := ReadProcessMemory(Handle, Pointer(AAdress), @AData, ASize, BytesRead) and (BytesRead = ASize);
if not Result then LogLastError;
end;
function TDbgProcess.ReadOrdinal(const AAdress: TDbgPtr; out AData): Boolean;
begin
Result := ReadData(AAdress, 4, AData);
end;
function TDbgProcess.ReadString(const AAdress: TDbgPtr; const AMaxSize: Cardinal; out AData: String): Boolean;
var
BytesRead: Cardinal;
buf: array of Char;
begin
SetLength(buf, AMaxSize + 1);
Result := ReadProcessMemory(Handle, Pointer(AAdress), @Buf[0], AMaxSize, BytesRead);
if not Result then Exit;
if BytesRead < AMaxSize
then Buf[BytesRead] := #0
else Buf[AMaxSize] := #0;
AData := PChar(@Buf[0]);
end;
function TDbgProcess.ReadWString(const AAdress: TDbgPtr; const AMaxSize: Cardinal; out AData: WideString): Boolean;
var
BytesRead: Cardinal;
buf: array of WChar;
begin
SetLength(buf, AMaxSize + 1);
Result := ReadProcessMemory(Handle, Pointer(AAdress), @Buf[0], SizeOf(WChar) * AMaxSize, BytesRead);
if not Result then Exit;
BytesRead := BytesRead div SizeOf(WChar);
if BytesRead < AMaxSize
then Buf[BytesRead] := #0
else Buf[AMaxSize] := #0;
AData := PWChar(@Buf[0]);
end;
function TDbgProcess.RemoveBreak(const ALocation: TDbgPtr): TDbgBreakpoint;
begin
if FBreakMap = nil then Exit;
FBreakMap.Delete(ALocation);
end;
procedure TDbgProcess.RemoveLib(const AInfo: TUnloadDLLDebugInfo);
begin
if FLibMap = nil then Exit;
FLibMap.Delete(TDbgPtr(AInfo.lpBaseOfDll));
end;
procedure TDbgProcess.RemoveThread(const AID: DWord);
begin
if FThreadMap = nil then Exit;
FThreadMap.Delete(AID);
end;
procedure TDbgProcess.SetName(const AValue: String);
begin
FName := AValue;
end;
procedure TDbgProcess.ThreadDestroyed(const AThread: TDbgThread);
begin
if AThread = FMainThread
then FMainThread := nil;
end;
function TDbgProcess.WriteData(const AAdress: TDbgPtr; const ASize: Cardinal; const AData): Boolean;
var
BytesWritten: Cardinal;
begin
Result := WriteProcessMemory(Handle, Pointer(AAdress), @AData, ASize, BytesWritten) and (BytesWritten = ASize);
if not Result then LogLastError;
end;
{ TDbgThread }
constructor TDbgThread.Create(const AProcess: TDbgProcess; const AID: Integer; const AHandle: THandle; const ABase, AStart: Pointer);
begin
FID := AID;
FHandle := AHandle;
FBaseAddr := ABase;
FStartAddr := AStart;
FProcess := AProcess;
inherited Create;
end;
destructor TDbgThread.Destroy;
begin
FProcess.ThreadDestroyed(Self);
inherited;
end;
function TDbgThread.SingleStep: Boolean;
var
Context: TContext;
begin
Context.ContextFlags := CONTEXT_CONTROL;
if not GetThreadContext(FHandle, Context)
then begin
Log('Thread %u: Unable to get context', [FID]);
Exit;
end;
Context.ContextFlags := CONTEXT_CONTROL;
Context.EFlags := Context.EFlags or $100;
if not SetThreadContext(FHandle, Context)
then begin
Log('Thread %u: Unable to set context', [FID]);
Exit;
end;
FSingleStepping := True;
end;
(*
{ TDbgSymbol }
constructor TDbgSymbol.Create(const AName: String; const ASection: TDbgSection; const AOffset: Integer);
begin
FName := AName;
FSection := ASection;
FOffset := AOffset;
FLength := 0;
inherited Create;
end;
function TDbgSymbol.GetAddress: Pointer;
begin
Result := PChar(FSection.StartAddr) + FOffset - FSection.FOffset;
end;
*)
{ TDbgBreak }
constructor TDbgBreakpoint.Create(const AProcess: TDbgProcess; const ALocation: TDbgPtr);
begin
FProcess := AProcess;
FLocation := ALocation;
inherited Create;
SetBreak;
end;
destructor TDbgBreakpoint.Destroy;
begin
ResetBreak;
inherited;
end;
function TDbgBreakpoint.Hit(const AThreadID: Integer): Boolean;
var
Thread: TDbgThread;
Context: TContext;
begin
Result := False;
if FOrgValue = $CC then Exit; // breakpoint on a hardcoded breakpoint
// no need to jum back and restore instruction
ResetBreak;
if not FProcess.GetThread(AThreadId, Thread) then Exit;
Context.ContextFlags := CONTEXT_CONTROL;
if not GetThreadContext(Thread.Handle, Context)
then begin
Log('Break $s: Unable to get context', [FormatAdress(FLocation)]);
Exit;
end;
Context.ContextFlags := CONTEXT_CONTROL;
Dec(Context.Eip);
if not SetThreadContext(Thread.Handle, Context)
then begin
Log('Break %s: Unable to set context', [FormatAdress(FLocation)]);
Exit;
end;
Result := True;
end;
procedure TDbgBreakpoint.ResetBreak;
begin
if FOrgValue = $CC then Exit; // breakpoint on a hardcoded breakpoint
if not FProcess.WriteData(FLocation, 1, FOrgValue)
then begin
Log('Unable to reset breakpoint at $%p', [FLocation]);
Exit;
end;
FlushInstructionCache(FProcess.FInfo.hProcess, Pointer(FLocation), 1);
end;
procedure TDbgBreakpoint.SetBreak;
const
Int3: Byte = $CC;
begin
if not FProcess.ReadData(FLocation, 1, FOrgValue)
then begin
Log('Unable to read breakpoint at $%p', [FLocation]);
Exit;
end;
if FOrgValue = $CC then Exit; // breakpoint on a hardcoded breakpoint
if not FProcess.WriteData(FLocation, 1, Int3)
then begin
Log('Unable to set breakpoint at $%p', [FLocation]);
Exit;
end;
FlushInstructionCache(FProcess.FInfo.hProcess, Pointer(FLocation), 1);
end;
end.

104
debugger/windebug/windextra.pp Normal file
View File

@ -0,0 +1,104 @@
{ $Id: $ }
{
---------------------------------------------------------------------------
windextra.pp - Native windows debugger - Extra utilities
---------------------------------------------------------------------------
This unit contains utility functions and missing win32/64 API
---------------------------------------------------------------------------
@created(Mon Apr 10th WET 2006)
@lastmod($Date: $)
@author(Marc Weustink <marc@@dommelstein.nl>)
***************************************************************************
* *
* This source is free software; you can redistribute it and/or modify *
* it under the terms of the GNU General Public License as published by *
* the Free Software Foundation; either version 2 of the License, or *
* (at your option) any later version. *
* *
* This code is distributed in the hope that it will be useful, but *
* WITHOUT ANY WARRANTY; without even the implied warranty of *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
* General Public License for more details. *
* *
* A copy of the GNU General Public License is available on the World *
* Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
* obtain it by writing to the Free Software Foundation, *
* Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *
* *
***************************************************************************
}
unit WindExtra;
{$mode objfpc}{$H+}
interface
uses
Windows;
function FormatAdress(const P): String;
function GetLastErrorText(AErrorCode: Cardinal): String; {$IFNDEF FPC} overload; {$ENDIF}
function GetLastErrorText: String; {$IFNDEF FPC} overload; {$ENDIF}
//function OpenThread(dwDesiredAccess: DWORD; bInheritHandle: BOOL; dwThreadId: DWORD): THandle; stdcall;
//function Wow64GetThreadContext(hThread: THandle; var lpContext: TContext): BOOL; stdcall;
implementation
uses
SysUtils, FPWDGLobal;
//function OpenThread(dwDesiredAccess: DWORD; bInheritHandle: BOOL; dwThreadId: DWORD): THandle; stdcall; external 'kernel32';
//function Wow64GetThreadContext(hThread: THandle; var lpContext: TContext): BOOL; stdcall; external 'kernel32';
function FormatAdress(const P): String;
begin
case GMode of
dm32: Result := '$' + IntToHex(DWord(p), 8);
dm64: Result := '$' + IntToHex(int64(p), 16);
else
Result := 'Unknown mode';
end;
end;
function GetLastErrorText: String;
begin
Result := GetLastErrorText(GetLastError);
end;
function GetLastErrorText(AErrorCode: Cardinal): String;
var
R: cardinal;
Temp: PChar;
begin
Temp := nil;
R := FormatMessage(
FORMAT_MESSAGE_ALLOCATE_BUFFER or FORMAT_MESSAGE_FROM_SYSTEM or FORMAT_MESSAGE_ARGUMENT_ARRAY,
nil,
AErrorCode,
LANG_NEUTRAL,
@Temp,
0,
nil);
if R = 0
then begin
Result := '';
end
else begin
Result := Temp;
SetLength(Result, Length(Result)-2);
end;
if Temp <> nil
then LocalFree(HLOCAL(Temp));
end;
end.