paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-13 11:39:13 +02:00
Code Issues Packages Projects Releases Wiki Activity

FpDebugger (pure): Retrieve the file-names of loaded processes and modules.

Browse Source 
git-svn-id: trunk@45400 -
This commit is contained in:
joost 2014-06-08 13:18:23 +00:00
parent a8fb1a0c44
commit 24a6aab526
1 changed files with 59 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

73
components/fpdebug/fpdbgwinclasses.pas
View File

@ -45,6 +45,7 @@ uses
FpDbgClasses,
process,
FpDbgWinExtra,
strutils,
FpDbgInfo,
FpDbgLoader, FpdMemoryTools,
DbgIntfBaseTypes,
@ -152,15 +153,17 @@ begin
DebugLn('FpDbg-ERROR: ', GetLastErrorText);
end;
function GetModuleFileName(AModuleHandle: THandle): string;
function QueryFullProcessImageName(hProcess:HANDLE; dwFlags: DWord; lpExeName:LPTSTR; var lpdwSize:DWORD):BOOL; stdcall; external 'kernel32' name 'QueryFullProcessImageNameA';
function GetFullProcessImageName(AProcessHandle: THandle): string;
var
s: string;
len: Integer;
len: DWORD;
begin
SetLength(S, MAX_PATH);
len := windows.GetModuleFileName(AModuleHandle, @S[1], MAX_PATH);
if len > 0
then SetLength(S, len - 1)
len := MAX_PATH;
SetLength(S, len);
if QueryFullProcessImageName(AProcessHandle, 0, @S[1], len)
then SetLength(S, len)
else begin
S := '';
LogLastError;
@ -168,30 +171,70 @@ begin
result := s;
end;
function GetModuleFileName(AModuleHandle: THandle): string;
var
s: string;
len: Integer;
hMod: THandle;
_GetFinalPathNameByHandle: function(hFile: HANDLE; lpFilename:LPTSTR; cchFilePath, dwFlags: DWORD):DWORD; stdcall;
begin
result := '';
// GetFinalPathNameByHandle is only available on Windows Vista / Server 2008
_GetFinalPathNameByHandle := nil;
// normally you would load a lib, but since kernel32 is
// always loaded we can use this (and we don't have to free it
hMod := GetModuleHandle(kernel32);
if hMod = 0 then Exit; //????
pointer(_GetFinalPathNameByHandle) := GetProcAddress(hMod, 'GetFinalPathNameByHandleA');
if assigned(_GetFinalPathNameByHandle) then begin
SetLength(S, MAX_PATH);
len := _GetFinalPathNameByHandle(AModuleHandle, @S[1], MAX_PATH, 0);
if len > 0
then SetLength(S, len - 1)
else begin
S := '';
LogLastError;
end;
// On some older Windows versions there's a bug in GetFinalPathNameByHandleA,
// which leads to a trailing #0.
if strutils.RightStr(S,1) =#0 then
SetLength(S,length(S)-1);
// Remove the \\?\ prefix
Delete(S,1,4);
result := S;
end;
end;
function GetProcFilename(AProcess: TDbgProcess; lpImageName: LPVOID; fUnicode: word; hFile: handle): string;
var
NamePtr: TDbgPtr;
S: String;
W: WideString;
begin
W := '';
S := '';
if (lpImageName<>nil) and AProcess.ReadOrdinal(TDbgPtr(lpImageName), NamePtr)
then begin
if fUnicode <> 0
then begin
AProcess.ReadWString(NamePtr, MAX_PATH, W);
if AProcess.ReadWString(NamePtr, MAX_PATH, W)
then S := W;
end
else begin
if AProcess.ReadString(NamePtr, MAX_PATH, S)
then W := S;
AProcess.ReadString(NamePtr, MAX_PATH, S);
end;
end;
if W = ''
if S = ''
then begin
W := GetModuleFileName(hFile);
if hFile=0 then
S := GetFullProcessImageName(AProcess.Handle)
else
S := GetModuleFileName(hFile);
end;
result := W;
result := S;
end;
{ tDbgWinLibrary }
@ -266,6 +309,7 @@ var
BytesRead: PtrUInt;
buf: array of Char;
begin
AData := '';
SetLength(buf, AMaxSize + 1);
Result := ReadProcessMemory(Handle, Pointer(PtrUInt(AAdress)), @Buf[0], AMaxSize, BytesRead);
if not Result then Exit;
@ -280,6 +324,7 @@ var
BytesRead: PtrUInt;
buf: array of WChar;
begin
AData := '';
SetLength(buf, AMaxSize + 1);
Result := ReadProcessMemory(Handle, Pointer(PtrUInt(AAdress)), @Buf[0], SizeOf(WChar) * AMaxSize, BytesRead);
if not Result then Exit;
@ -839,7 +884,7 @@ var
begin
FInfo := AInfo;
s := GetProcFilename(Self, AInfo.lpImageName, AInfo.fUnicode, AInfo.hFile);
s := GetProcFilename(Self, AInfo.lpImageName, AInfo.fUnicode, 0);
if s <> ''
then SetName(s);