mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-12-05 17:19:18 +01:00
* Re factorization to move windows-specific code from fpdcommand.pas to fpdbgwinclasses.pas
git-svn-id: trunk@44349 -
This commit is contained in:
joost
parent
51c51a18b9
commit
1d789ef144
@ -141,10 +141,6 @@ end;
|
||||
|
||||
|
||||
procedure HandleRun(AParams: String);
|
||||
var
|
||||
StartupInfo: TStartupInfo;
|
||||
ProcessInformation: TProcessInformation;
|
||||
ThreadAttributes: TSecurityAttributes;
|
||||
begin
|
||||
if GState <> dsStop
|
||||
then begin
|
||||
@ -158,26 +154,14 @@ begin
|
||||
Exit;
|
||||
end;
|
||||
|
||||
ZeroMemory(@StartUpInfo, SizeOf(StartupInfo));
|
||||
StartUpInfo.cb := SizeOf(StartupInfo);
|
||||
StartUpInfo.dwFlags := {STARTF_USESTDHANDLES or} STARTF_USESHOWWINDOW;
|
||||
StartUpInfo.wShowWindow := SW_SHOWNORMAL or SW_SHOW;
|
||||
GCurrentProcess := OSDbgClasses.DbgProcessClass.StartInstance(GFileName, AParams);
|
||||
if assigned(GCurrentProcess) then
|
||||
begin
|
||||
WriteLN('Got PID:', GCurrentProcess.Handle, ', TID: ', GCurrentProcess.Handle);
|
||||
|
||||
// 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: ', GetLastErrorText);
|
||||
Exit;
|
||||
end;
|
||||
|
||||
WriteLN('Got PID:', ProcessInformation.dwProcessId, ', TID: ',ProcessInformation.dwThreadId);
|
||||
|
||||
GState := dsRun;
|
||||
DebugLoop;
|
||||
GState := dsRun;
|
||||
DebugLoop;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure HandleBreak(AParams: String);
|
||||
|
||||
@ -39,7 +39,6 @@ uses
|
||||
SysUtils, FPDType, Maps, FpDbgUtil, FpDbgClasses, FpDbgWinExtra;
|
||||
|
||||
type
|
||||
TFPDState = (dsStop, dsRun, dsPause, dsQuit, dsEvent);
|
||||
TFPDMode = (dm32, dm64);
|
||||
TFPDImageInfo = (iiNone, iiName, iiDetail);
|
||||
|
||||
|
||||
@ -48,12 +48,8 @@ implementation
|
||||
uses
|
||||
FPDGlobal, FPDPEImage, FPDType;
|
||||
|
||||
var
|
||||
MDebugEvent: TDebugEvent;
|
||||
|
||||
procedure HandleCreateProcess(const AEvent: TDebugEvent);
|
||||
var
|
||||
Proc: TDbgProcess;
|
||||
S: String;
|
||||
begin
|
||||
WriteLN(Format('hFile: 0x%x', [AEvent.CreateProcessInfo.hFile]));
|
||||
@ -66,15 +62,14 @@ begin
|
||||
if AEvent.CreateProcessInfo.lpBaseOfImage <> nil
|
||||
then DumpPEImage(AEvent.CreateProcessInfo.hProcess, TDbgPtr(AEvent.CreateProcessInfo.lpBaseOfImage));
|
||||
|
||||
if GMainProcess = nil
|
||||
then S := GFileName;
|
||||
Proc := TDbgWinProcess.Create(S, AEvent.dwProcessId, AEvent.dwThreadId, AEvent.CreateProcessInfo);
|
||||
if GMainProcess = nil
|
||||
then GMainProcess := Proc;
|
||||
GProcessMap.Add(AEvent.dwProcessId, Proc);
|
||||
if not assigned(GCurrentProcess) then
|
||||
GCurrentProcess := GMainProcess;
|
||||
|
||||
(GCurrentProcess as TDbgWinProcess).StartProcess(GFileName, AEvent.CreateProcessInfo);
|
||||
|
||||
GProcessMap.Add(AEvent.dwProcessId, GCurrentProcess);
|
||||
if GBreakOnLibraryLoad
|
||||
then GState := dsPause;
|
||||
GCurrentProcess := proc;
|
||||
end;
|
||||
|
||||
procedure HandleCreateThread(const AEvent: TDebugEvent);
|
||||
@ -462,29 +457,29 @@ procedure DebugLoop;
|
||||
S.Free;
|
||||
end;
|
||||
|
||||
var
|
||||
AFirstLoop: boolean;
|
||||
|
||||
begin
|
||||
repeat
|
||||
if (GCurrentProcess <> nil) and (GState = dsPause)
|
||||
if (GState in [dsStop, dsPause, dsEvent])
|
||||
then begin
|
||||
(GCurrentProcess as TDbgWinProcess).ContinueDebugEvent(GCurrentThread, MDebugEvent);
|
||||
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;
|
||||
GCurrentProcess.Continue(GCurrentProcess, GCurrentThread, GState);
|
||||
GState := dsRun;
|
||||
end;
|
||||
|
||||
if not WaitForDebugEvent(MDebugEvent, 10) then Continue;
|
||||
|
||||
if assigned(GCurrentProcess) and not assigned(GMainProcess) then
|
||||
begin
|
||||
GMainProcess:=GCurrentProcess;
|
||||
AFirstLoop:=true;
|
||||
end
|
||||
else
|
||||
AFirstLoop:=false;
|
||||
GCurrentProcess := nil;
|
||||
GCurrentThread := nil;
|
||||
if not GetProcess(MDebugEvent.dwProcessId, GCurrentPRocess) and (GMainProcess <> nil) then Continue;
|
||||
if not GetProcess(MDebugEvent.dwProcessId, GCurrentPRocess) and not AFirstLoop then Continue;
|
||||
|
||||
GState := dsEvent;
|
||||
if GCurrentProcess <> nil
|
||||
|
||||
@ -41,6 +41,8 @@ uses
|
||||
FpDbgInfo, FpdMemoryTools, LazLoggerBase, LazClasses, DbgIntfBaseTypes;
|
||||
|
||||
type
|
||||
TFPDState = (dsStop, dsRun, dsPause, dsQuit, dsEvent);
|
||||
|
||||
TDbgProcess = class;
|
||||
|
||||
TDbgThread = class(TObject)
|
||||
@ -86,39 +88,39 @@ type
|
||||
private
|
||||
FName: String;
|
||||
FProcess: TDbgProcess;
|
||||
FModuleHandle: THandle;
|
||||
FBaseAddr: TDbgPtr;
|
||||
FBreakList: TList;
|
||||
FDbgInfo: TDbgInfo;
|
||||
FLoader: TDbgImageLoader;
|
||||
|
||||
procedure LoadInfo; virtual;
|
||||
procedure CheckName;
|
||||
procedure SetName(const AValue: String);
|
||||
protected
|
||||
procedure LoadInfo; virtual;
|
||||
function InitializeLoader: TDbgImageLoader; virtual;
|
||||
function GetModuleFileName(AModuleHandle: THandle): string; virtual;
|
||||
procedure SetName(const AValue: String);
|
||||
public
|
||||
constructor Create(const AProcess: TDbgProcess; const ADefaultName: String; const AModuleHandle: THandle; const ABaseAddr, ANameAddr: TDbgPtr; const AUnicode: Boolean); virtual;
|
||||
constructor Create(const AProcess: TDbgProcess); virtual;
|
||||
destructor Destroy; override;
|
||||
|
||||
function AddBreak(const AFileName: String; ALine: Cardinal): TDbgBreakpoint;
|
||||
function AddrOffset: Int64; // gives the offset between the loaded addresses and the compiled addresses
|
||||
function AddrOffset: Int64; virtual; // gives the offset between the loaded addresses and the compiled addresses
|
||||
function FindSymbol(AAdress: TDbgPtr): TFpDbgSymbol;
|
||||
function RemoveBreak(const AFileName: String; ALine: Cardinal): Boolean;
|
||||
|
||||
property Process: TDbgProcess read FProcess;
|
||||
property ModuleHandle: THandle read FModuleHandle;
|
||||
property BaseAddr: TDbgPtr read FBaseAddr;
|
||||
property DbgInfo: TDbgInfo read FDbgInfo;
|
||||
end;
|
||||
|
||||
{ TDbgLibrary }
|
||||
|
||||
TDbgLibrary = class(TDbgInstance)
|
||||
private
|
||||
FModuleHandle: THandle;
|
||||
FBaseAddr: TDBGPtr;
|
||||
public
|
||||
constructor Create(const AProcess: TDbgProcess; const ADefaultName: String; const AModuleHandle: THandle; const ABaseAddr, ANameAddr: TDbgPtr; const AUnicode: Boolean);
|
||||
constructor Create(const AProcess: TDbgProcess; const ADefaultName: String; const AModuleHandle: THandle; const ABaseAddr: TDbgPtr);
|
||||
property Name: String read FName;
|
||||
property ModuleHandle: THandle read FModuleHandle;
|
||||
property BaseAddr: TDBGPtr read FBaseAddr;
|
||||
end;
|
||||
|
||||
{ TDbgProcess }
|
||||
@ -128,7 +130,6 @@ type
|
||||
FProcessID: Integer;
|
||||
FThreadID: Integer;
|
||||
|
||||
procedure SetName(const AValue: String);
|
||||
procedure ThreadDestroyed(const AThread: TDbgThread);
|
||||
protected
|
||||
FCurrentBreakpoint: TDbgBreakpoint; // set if we are executing the code at the break
|
||||
@ -143,10 +144,10 @@ type
|
||||
FBreakMap: TMap; // map BreakAddr -> BreakObject
|
||||
|
||||
FMainThread: TDbgThread;
|
||||
property ProcessID: integer read FProcessID;
|
||||
function GetHandle: THandle; virtual;
|
||||
public
|
||||
constructor Create(const ADefaultName: String; const AProcessID, AThreadID: Integer; const AModuleHandle: THandle; const ABaseAddr, ANameAddr: TDbgPtr; const AUnicode: boolean);
|
||||
class function StartInstance(AFileName: string; AParams: string): TDbgProcess; virtual;
|
||||
constructor Create(const AProcessID, AThreadID: Integer);
|
||||
destructor Destroy; override;
|
||||
function AddBreak(const ALocation: TDbgPtr): TDbgBreakpoint;
|
||||
function FindSymbol(const AName: String): TFpDbgSymbol;
|
||||
@ -161,10 +162,14 @@ type
|
||||
function ReadString(const AAdress: TDbgPtr; const AMaxSize: Cardinal; out AData: String): Boolean; virtual;
|
||||
function ReadWString(const AAdress: TDbgPtr; const AMaxSize: Cardinal; out AData: WideString): Boolean; virtual;
|
||||
|
||||
function Continue(AProcess: TDbgProcess; AThread: TDbgThread; AState: TFPDState): boolean; virtual;
|
||||
|
||||
function WriteData(const AAdress: TDbgPtr; const ASize: Cardinal; const AData): Boolean; virtual;
|
||||
|
||||
property Handle: THandle read GetHandle;
|
||||
property Name: String read FName write SetName;
|
||||
property ProcessID: integer read FProcessID;
|
||||
property ThreadID: integer read FThreadID;
|
||||
end;
|
||||
TDbgProcessClass = class of TDbgProcess;
|
||||
|
||||
@ -217,52 +222,15 @@ end;
|
||||
|
||||
function TDbgInstance.AddrOffset: Int64;
|
||||
begin
|
||||
Result := FLoader.ImageBase - BaseAddr;
|
||||
Result := FLoader.ImageBase;
|
||||
end;
|
||||
|
||||
procedure TDbgInstance.CheckName;
|
||||
constructor TDbgInstance.Create(const AProcess: TDbgProcess);
|
||||
begin
|
||||
if FName = ''
|
||||
then FName := Format('@%p', [Pointer(PtrUInt(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;
|
||||
begin
|
||||
FBaseAddr := ABaseAddr;
|
||||
FModuleHandle := AModuleHandle;
|
||||
FBreakList := TList.Create;
|
||||
FProcess := AProcess;
|
||||
|
||||
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
|
||||
W := GetModuleFileName(FModuleHandle);
|
||||
end;
|
||||
|
||||
if W = ''
|
||||
then W := ADefaultName;
|
||||
|
||||
SetName(W);
|
||||
|
||||
LoadInfo;
|
||||
end;
|
||||
|
||||
destructor TDbgInstance.Destroy;
|
||||
@ -308,7 +276,6 @@ end;
|
||||
procedure TDbgInstance.SetName(const AValue: String);
|
||||
begin
|
||||
FName := AValue;
|
||||
CheckName;
|
||||
end;
|
||||
|
||||
function TDbgInstance.InitializeLoader: TDbgImageLoader;
|
||||
@ -323,9 +290,12 @@ end;
|
||||
|
||||
{ TDbgLibrary }
|
||||
|
||||
constructor TDbgLibrary.Create(const AProcess: TDbgProcess; const ADefaultName: String; const AModuleHandle: THandle; const ABaseAddr, ANameAddr: TDbgPtr; const AUnicode: Boolean);
|
||||
constructor TDbgLibrary.Create(const AProcess: TDbgProcess; const ADefaultName: String; const AModuleHandle: THandle; const ABaseAddr: TDbgPtr);
|
||||
|
||||
begin
|
||||
inherited Create(AProcess, ADefaultName, AModuleHandle, ABaseAddr, ANameAddr, AUnicode);
|
||||
inherited Create(AProcess);
|
||||
FModuleHandle:=AModuleHandle;
|
||||
FBaseAddr:=ABaseAddr;
|
||||
end;
|
||||
|
||||
{ TDbgProcess }
|
||||
@ -336,7 +306,7 @@ begin
|
||||
FBreakMap.Add(ALocation, Result);
|
||||
end;
|
||||
|
||||
constructor TDbgProcess.Create(const ADefaultName: String; const AProcessID, AThreadID: Integer; const AModuleHandle: THandle; const ABaseAddr, ANameAddr: TDbgPtr; const AUnicode: boolean);
|
||||
constructor TDbgProcess.Create(const AProcessID, AThreadID: Integer);
|
||||
const
|
||||
{.$IFDEF CPU64}
|
||||
MAP_ID_SIZE = itu8;
|
||||
@ -354,17 +324,13 @@ begin
|
||||
|
||||
FSymInstances := TList.Create;
|
||||
|
||||
inherited Create(Self, ADefaultName, AModuleHandle, ABaseAddr, ANameAddr, AUnicode);
|
||||
inherited Create(Self);
|
||||
|
||||
FThreadMap.Add(AThreadID, FMainThread);
|
||||
|
||||
if FDbgInfo.HasInfo
|
||||
then FSymInstances.Add(Self);
|
||||
end;
|
||||
|
||||
destructor TDbgProcess.Destroy;
|
||||
begin
|
||||
// CloseHandle(FInfo.hThread);
|
||||
FreeAndNil(FBreakMap);
|
||||
FreeAndNil(FThreadMap);
|
||||
FreeAndNil(FLibMap);
|
||||
@ -442,6 +408,11 @@ begin
|
||||
result := false;
|
||||
end;
|
||||
|
||||
function TDbgProcess.Continue(AProcess: TDbgProcess; AThread: TDbgThread; AState: TFPDState): boolean;
|
||||
begin
|
||||
result := false;
|
||||
end;
|
||||
|
||||
function TDbgProcess.RemoveBreak(const ALocation: TDbgPtr): Boolean;
|
||||
begin
|
||||
if FBreakMap = nil
|
||||
@ -455,16 +426,17 @@ begin
|
||||
FThreadMap.Delete(AID);
|
||||
end;
|
||||
|
||||
procedure TDbgProcess.SetName(const AValue: String);
|
||||
begin
|
||||
FName := AValue;
|
||||
end;
|
||||
|
||||
function TDbgProcess.GetHandle: THandle;
|
||||
begin
|
||||
result := 0;
|
||||
end;
|
||||
|
||||
class function TDbgProcess.StartInstance(AFileName: string; AParams: string): TDbgProcess;
|
||||
begin
|
||||
Log('Debug support for this platform is not available.');
|
||||
result := nil;
|
||||
end;
|
||||
|
||||
procedure TDbgProcess.ThreadDestroyed(const AThread: TDbgThread);
|
||||
begin
|
||||
if AThread = FMainThread
|
||||
|
||||
@ -80,7 +80,6 @@ type
|
||||
function GetHandle: THandle; override;
|
||||
function InitializeLoader: TDbgImageLoader; override;
|
||||
public
|
||||
constructor Create(const ADefaultName: String; const AProcessID, AThreadID: Integer; const AInfo: TCreateProcessDebugInfo);
|
||||
destructor Destroy; override;
|
||||
|
||||
function ReadData(const AAdress: TDbgPtr; const ASize: Cardinal; out AData): Boolean; override;
|
||||
@ -92,11 +91,28 @@ type
|
||||
procedure ContinueDebugEvent(const AThread: TDbgThread; const ADebugEvent: TDebugEvent);
|
||||
function HandleDebugEvent(const ADebugEvent: TDebugEvent): Boolean;
|
||||
|
||||
class function StartInstance(AFileName: string; AParams: string): TDbgProcess; override;
|
||||
function Continue(AProcess: TDbgProcess; AThread: TDbgThread; AState: TFPDState): boolean; override;
|
||||
procedure StartProcess(const ADefaultName: String; const AInfo: TCreateProcessDebugInfo);
|
||||
|
||||
function AddrOffset: Int64; override;
|
||||
function AddLib(const AInfo: TLoadDLLDebugInfo): TDbgLibrary;
|
||||
procedure AddThread(const AID: Integer; const AInfo: TCreateThreadDebugInfo);
|
||||
procedure RemoveLib(const AInfo: TUnloadDLLDebugInfo);
|
||||
end;
|
||||
|
||||
{ tDbgWinLibrary }
|
||||
|
||||
tDbgWinLibrary = class(TDbgLibrary)
|
||||
private
|
||||
FInfo: TLoadDLLDebugInfo;
|
||||
protected
|
||||
function InitializeLoader: TDbgImageLoader; override;
|
||||
public
|
||||
constructor Create(const AProcess: TDbgProcess; const ADefaultName: String;
|
||||
const AModuleHandle: THandle; const ABaseAddr: TDbgPtr; AInfo: TLoadDLLDebugInfo);
|
||||
end;
|
||||
|
||||
|
||||
procedure RegisterDbgClasses;
|
||||
|
||||
@ -114,6 +130,52 @@ begin
|
||||
DebugLn('FpDbg-ERROR: ', GetLastErrorText);
|
||||
end;
|
||||
|
||||
{ tDbgWinLibrary }
|
||||
|
||||
function tDbgWinLibrary.InitializeLoader: TDbgImageLoader;
|
||||
begin
|
||||
result := TDbgImageLoader.Create(FInfo.hFile);
|
||||
end;
|
||||
|
||||
constructor tDbgWinLibrary.Create(const AProcess: TDbgProcess;
|
||||
const ADefaultName: String; const AModuleHandle: THandle;
|
||||
const ABaseAddr: TDbgPtr; AInfo: TLoadDLLDebugInfo);
|
||||
var
|
||||
NamePtr: TDbgPtr;
|
||||
S: String;
|
||||
W: WideString;
|
||||
begin
|
||||
inherited Create(AProcess, ADefaultName, AModuleHandle, ABaseAddr);
|
||||
FInfo := AInfo;
|
||||
|
||||
W := '';
|
||||
if Process.ReadOrdinal(TDbgPtr(FInfo.lpImageName), NamePtr)
|
||||
then begin
|
||||
if FInfo.fUnicode<>0
|
||||
then begin
|
||||
Process.ReadWString(NamePtr, MAX_PATH, W);
|
||||
end
|
||||
else begin
|
||||
if Process.ReadString(NamePtr, MAX_PATH, S)
|
||||
then W := S;
|
||||
end;
|
||||
end;
|
||||
|
||||
if W = ''
|
||||
then begin
|
||||
W := GetModuleFileName(AModuleHandle);
|
||||
end;
|
||||
|
||||
if W = ''
|
||||
then W := ADefaultName;
|
||||
|
||||
SetName(W);
|
||||
LoadInfo;
|
||||
|
||||
|
||||
|
||||
end;
|
||||
|
||||
{ TDbgWinProcess }
|
||||
|
||||
function TDbgWinProcess.GetModuleFileName(AModuleHandle: THandle): string;
|
||||
@ -139,14 +201,7 @@ end;
|
||||
|
||||
function TDbgWinProcess.InitializeLoader: TDbgImageLoader;
|
||||
begin
|
||||
result := TDbgImageLoader.Create(ModuleHandle);
|
||||
end;
|
||||
|
||||
constructor TDbgWinProcess.Create(const ADefaultName: String; const AProcessID, AThreadID: Integer; const AInfo: TCreateProcessDebugInfo);
|
||||
begin
|
||||
FInfo := AInfo;
|
||||
inherited Create(ADefaultName, AProcessID, AThreadID, AInfo.hFile, TDbgPtr(AInfo.lpBaseOfImage), TDbgPtr(AInfo.lpImageName), AInfo.fUnicode <> 0);
|
||||
FMainThread := OSDbgClasses.DbgThreadClass.Create(Self, AThreadID, AInfo.hThread, AInfo.lpThreadLocalBase, AInfo.lpStartAddress);
|
||||
result := TDbgImageLoader.Create(FInfo.hFile);
|
||||
end;
|
||||
|
||||
destructor TDbgWinProcess.Destroy;
|
||||
@ -352,11 +407,97 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
class function TDbgWinProcess.StartInstance(AFileName: string; AParams: string): TDbgProcess;
|
||||
var
|
||||
StartupInfo: TStartupInfo;
|
||||
ProcessInformation: TProcessInformation;
|
||||
ThreadAttributes: TSecurityAttributes;
|
||||
begin
|
||||
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 CreateProcess(nil, PChar(AFileName), nil, nil, True, DETACHED_PROCESS or DEBUG_PROCESS or CREATE_NEW_PROCESS_GROUP, nil, nil, StartUpInfo, ProcessInformation)
|
||||
then begin
|
||||
result := TDbgWinProcess.Create(ProcessInformation.dwProcessId,ProcessInformation.dwThreadId);
|
||||
end else begin
|
||||
WriteLN('Create process failed: ', GetLastErrorText);
|
||||
result := nil;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
function TDbgWinProcess.Continue(AProcess: TDbgProcess; AThread: TDbgThread; AState: TFPDState): boolean;
|
||||
begin
|
||||
if (AState = dsPause)
|
||||
then begin
|
||||
TDbgWinProcess(AProcess).ContinueDebugEvent(AThread, MDebugEvent);
|
||||
end;
|
||||
|
||||
case MDebugEvent.Exception.ExceptionRecord.ExceptionCode of
|
||||
EXCEPTION_BREAKPOINT,
|
||||
EXCEPTION_SINGLE_STEP: Windows.ContinueDebugEvent(MDebugEvent.dwProcessId, MDebugEvent.dwThreadId, DBG_CONTINUE);
|
||||
else
|
||||
Windows.ContinueDebugEvent(MDebugEvent.dwProcessId, MDebugEvent.dwThreadId, DBG_EXCEPTION_NOT_HANDLED);
|
||||
end;
|
||||
result := true;
|
||||
end;
|
||||
|
||||
procedure TDbgWinProcess.StartProcess(const ADefaultName: String; const AInfo: TCreateProcessDebugInfo);
|
||||
var
|
||||
NamePtr: TDbgPtr;
|
||||
S: String;
|
||||
W: WideString;
|
||||
begin
|
||||
FInfo := AInfo;
|
||||
|
||||
W := '';
|
||||
if Process.ReadOrdinal(TDbgPtr(AInfo.lpImageName), NamePtr)
|
||||
then begin
|
||||
if AInfo.fUnicode <> 0
|
||||
then begin
|
||||
Process.ReadWString(NamePtr, MAX_PATH, W);
|
||||
end
|
||||
else begin
|
||||
if Process.ReadString(NamePtr, MAX_PATH, S)
|
||||
then W := S;
|
||||
end;
|
||||
end;
|
||||
|
||||
if W = ''
|
||||
then begin
|
||||
W := GetModuleFileName(AInfo.hFile);
|
||||
end;
|
||||
|
||||
if W = ''
|
||||
then W := ADefaultName;
|
||||
|
||||
SetName(W);
|
||||
|
||||
LoadInfo;
|
||||
|
||||
if DbgInfo.HasInfo
|
||||
then FSymInstances.Add(Self);
|
||||
|
||||
FMainThread := OSDbgClasses.DbgThreadClass.Create(Self, ThreadID, AInfo.hThread, AInfo.lpThreadLocalBase, AInfo.lpStartAddress);
|
||||
end;
|
||||
|
||||
function TDbgWinProcess.AddrOffset: Int64;
|
||||
begin
|
||||
Result:=inherited AddrOffset - TDbgPtr(FInfo.lpBaseOfImage);
|
||||
end;
|
||||
|
||||
function TDbgWinProcess.AddLib(const AInfo: TLoadDLLDebugInfo): TDbgLibrary;
|
||||
var
|
||||
ID: TDbgPtr;
|
||||
begin
|
||||
Result := TDbgLibrary.Create(Self, HexValue(AInfo.lpBaseOfDll, SizeOf(Pointer), [hvfIncludeHexchar]), AInfo.hFile, TDbgPtr(AInfo.lpBaseOfDll), TDbgPtr(AInfo.lpImageName), AInfo.fUnicode <> 0);
|
||||
Result := TDbgWinLibrary.Create(Self, HexValue(AInfo.lpBaseOfDll, SizeOf(Pointer), [hvfIncludeHexchar]), AInfo.hFile, TDbgPtr(AInfo.lpBaseOfDll), AInfo);
|
||||
ID := TDbgPtr(AInfo.lpBaseOfDll);
|
||||
FLibMap.Add(ID, Result);
|
||||
if Result.DbgInfo.HasInfo
|
||||
|
||||
@ -50,6 +50,7 @@ function GetLastErrorText: String; {$IFNDEF FPC} overload; {$ENDIF}
|
||||
{$ifdef windows}
|
||||
var
|
||||
GCurrentContext: PContext;
|
||||
MDebugEvent: TDebugEvent;
|
||||
{$endif}
|
||||
|
||||
//function OpenThread(dwDesiredAccess: DWORD; bInheritHandle: BOOL; dwThreadId: DWORD): THandle; stdcall;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user