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

* Added OnLog event to be able to log to something else then stdout

Browse Source 
git-svn-id: trunk@44551 -
This commit is contained in:
joost 2014-03-29 19:27:11 +00:00
parent 4e227f7e97
commit 2cb000b1be
1 changed files with 17 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
components/fpdebug/fpdbgclasses.pp
View File

@ -44,6 +44,7 @@ type
TFPDState = (dsStop, dsRun, dsPause, dsQuit, dsEvent);
TFPDEvent = (deExitProcess, deBreakpoint, deException, deCreateProcess, deLoadLibrary);
TFPDMode = (dm32, dm64);
TOnLog = procedure(AString: string) of object;
TDbgProcess = class;
@ -130,6 +131,7 @@ type
TDbgProcess = class(TDbgInstance)
private
FExitCode: DWord;
FOnLog: TOnLog;
FProcessID: Integer;
FThreadID: Integer;
@ -162,6 +164,8 @@ type
function GetThread(const AID: Integer; out AThread: TDbgThread): Boolean;
function RemoveBreak(const ALocation: TDbgPtr): Boolean;
procedure RemoveThread(const AID: DWord);
procedure Log(AString: string);
procedure Log(AString: string; Options: array of const);
function ReadData(const AAdress: TDbgPtr; const ASize: Cardinal; out AData): Boolean; virtual;
function ReadOrdinal(const AAdress: TDbgPtr; out AData): Boolean; virtual;
@ -185,6 +189,7 @@ type
property ThreadID: integer read FThreadID;
property ExitCode: DWord read FExitCode;
property LastEventProcessIdentifier: THandle read GetLastEventProcessIdentifier;
property OnLog: TOnLog read FOnLog write FOnLog;
end;
TDbgProcessClass = class of TDbgProcess;
@ -453,6 +458,17 @@ begin
FThreadMap.Delete(AID);
end;
procedure TDbgProcess.Log(AString: string);
begin
if assigned(FOnLog) then
FOnLog(AString);
end;
procedure TDbgProcess.Log(AString: string; Options: array of const);
begin
Log(Format(AString, Options));
end;
function TDbgProcess.GetHandle: THandle;
begin
result := 0;
@ -465,7 +481,7 @@ end;
class function TDbgProcess.StartInstance(AFileName: string; AParams: string): TDbgProcess;
begin
Log('Debug support for this platform is not available.');
DebugLn('Debug support for this platform is not available.');
result := nil;
end;