paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-17 20:59:12 +02:00
Code Issues Packages Projects Releases Wiki Activity

FpDbg: Refactored code to get module-name, to avoid double code for processes and libraries.

Browse Source 
git-svn-id: trunk@44387 -
This commit is contained in:
joost 2014-03-09 12:00:55 +00:00
parent 2947aab047
commit 607af213ac
2 changed files with 56 additions and 81 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
components/fpdebug/fpdbgclasses.pp
View File

@ -97,7 +97,6 @@ type
protected protected
procedure LoadInfo; virtual; procedure LoadInfo; virtual;
function InitializeLoader: TDbgImageLoader; virtual; function InitializeLoader: TDbgImageLoader; virtual;
function GetModuleFileName(AModuleHandle: THandle): string; virtual;
procedure SetName(const AValue: String); procedure SetName(const AValue: String);
public public
constructor Create(const AProcess: TDbgProcess); virtual; constructor Create(const AProcess: TDbgProcess); virtual;
@ -302,11 +301,6 @@ begin
result := nil; result := nil;
end; end;
function TDbgInstance.GetModuleFileName(AModuleHandle: THandle): string;
begin
result := '';
end;
{ TDbgLibrary } { TDbgLibrary }
constructor TDbgLibrary.Create(const AProcess: TDbgProcess; const ADefaultName: String; const AModuleHandle: THandle; const ABaseAddr: TDbgPtr); constructor TDbgLibrary.Create(const AProcess: TDbgProcess; const ADefaultName: String; const AModuleHandle: THandle; const ABaseAddr: TDbgPtr);

131
components/fpdebug/fpdbgwinclasses.pas
View File

@ -76,7 +76,6 @@ type
private private
FInfo: TCreateProcessDebugInfo; FInfo: TCreateProcessDebugInfo;
protected protected
function GetModuleFileName(AModuleHandle: THandle): string; override;
function GetHandle: THandle; override; function GetHandle: THandle; override;
function GetLastEventProcessIdentifier: THandle; override; function GetLastEventProcessIdentifier: THandle; override;
function InitializeLoader: TDbgImageLoader; override; function InitializeLoader: TDbgImageLoader; override;
@ -133,55 +132,7 @@ begin
DebugLn('FpDbg-ERROR: ', GetLastErrorText); DebugLn('FpDbg-ERROR: ', GetLastErrorText);
end; end;
{ tDbgWinLibrary } function GetModuleFileName(AModuleHandle: THandle): string;
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;
var var
s: string; s: string;
len: Integer; len: Integer;
@ -197,6 +148,57 @@ begin
result := s; result := s;
end; end;
function GetProcFilename(AProcess: TDbgProcess; lpImageName: LPVOID; fUnicode: word; hFile: handle): string;
var
NamePtr: TDbgPtr;
S: String;
W: WideString;
begin
W := '';
if (lpImageName<>nil) and AProcess.ReadOrdinal(TDbgPtr(lpImageName), NamePtr)
then begin
if fUnicode <> 0
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(hFile);
end;
result := W;
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
S: String;
begin
inherited Create(AProcess, ADefaultName, AModuleHandle, ABaseAddr);
FInfo := AInfo;
s := GetProcFilename(AProcess, AInfo.lpImageName, AInfo.fUnicode, AInfo.hFile);
if s <> ''
then SetName(s);
LoadInfo;
end;
{ TDbgWinProcess }
function TDbgWinProcess.GetHandle: THandle; function TDbgWinProcess.GetHandle: THandle;
begin begin
Result:=FInfo.hProcess; Result:=FInfo.hProcess;
@ -813,34 +815,13 @@ end;
procedure TDbgWinProcess.StartProcess(const AInfo: TCreateProcessDebugInfo); procedure TDbgWinProcess.StartProcess(const AInfo: TCreateProcessDebugInfo);
var var
NamePtr: TDbgPtr; s: string;
S: String;
W: WideString;
begin begin
FInfo := AInfo; FInfo := AInfo;
W := ''; s := GetProcFilename(Self, AInfo.lpImageName, AInfo.fUnicode, AInfo.hFile);
if Process.ReadOrdinal(TDbgPtr(AInfo.lpImageName), NamePtr) if s <> ''
then begin then SetName(s);
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; LoadInfo;