From 7038bee3d117ccf93fd632f67b8828f9cad5140e Mon Sep 17 00:00:00 2001 From: mattias Date: Wed, 10 Feb 2016 19:37:26 +0000 Subject: [PATCH] fpdebug: using Windows W functions git-svn-id: branches/fixes_1_6@51582 - --- components/fpdebug/fpdbgclasses.pp | 18 ++++----- components/fpdebug/fpdbgcontroller.pas | 4 +- components/fpdebug/fpdbgwinclasses.pas | 53 +++++++++++++++----------- 3 files changed, 41 insertions(+), 34 deletions(-) diff --git a/components/fpdebug/fpdbgclasses.pp b/components/fpdebug/fpdbgclasses.pp index f10c029873..b685526008 100644 --- a/components/fpdebug/fpdbgclasses.pp +++ b/components/fpdebug/fpdbgclasses.pp @@ -195,7 +195,7 @@ type TDbgInstance = class(TObject) private FMode: TFPDMode; - FName: String; + FFileName: String; FProcess: TDbgProcess; FSymbolTableInfo: TFpSymbolInfo; FLoaderList: TDbgImageLoaderList; @@ -203,7 +203,7 @@ type protected FDbgInfo: TDbgInfo; procedure InitializeLoaders; virtual; - procedure SetName(const AValue: String); + procedure SetFileName(const AValue: String); property LoaderList: TDbgImageLoaderList read FLoaderList write FLoaderList; public constructor Create(const AProcess: TDbgProcess); virtual; @@ -229,7 +229,7 @@ type FBaseAddr: TDBGPtr; public constructor Create(const AProcess: TDbgProcess; const ADefaultName: String; const AModuleHandle: THandle; const ABaseAddr: TDbgPtr); - property Name: String read FName; + property Name: String read FFileName; property ModuleHandle: THandle read FModuleHandle; property BaseAddr: TDBGPtr read FBaseAddr; end; @@ -271,7 +271,7 @@ type function AnalyseDebugEvent(AThread: TDbgThread): TFPDEvent; virtual; abstract; public class function StartInstance(AFileName: string; AParams, AnEnvironment: TStrings; AWorkingDirectory, AConsoleTty: string; AOnLog: TOnLog; ReDirectOutput: boolean): TDbgProcess; virtual; - constructor Create(const AName: string; const AProcessID, AThreadID: Integer; AOnLog: TOnLog); virtual; + constructor Create(const AFileName: string; const AProcessID, AThreadID: Integer; AOnLog: TOnLog); virtual; destructor Destroy; override; function AddBreak(const ALocation: TDbgPtr): TDbgBreakpoint; overload; function FindSymbol(const AName: String): TFpDbgSymbol; @@ -312,7 +312,7 @@ type procedure TerminateProcess; virtual; abstract; property Handle: THandle read GetHandle; - property Name: String read FName write SetName; + property Name: String read FFileName write SetFileName; property ProcessID: integer read FProcessID; property ThreadID: integer read FThreadID; property ExitCode: DWord read FExitCode; @@ -689,9 +689,9 @@ begin Result := FProcess.RemoveBreak(addr - AddrOffset); end; -procedure TDbgInstance.SetName(const AValue: String); +procedure TDbgInstance.SetFileName(const AValue: String); begin - FName := AValue; + FFileName := AValue; end; procedure TDbgInstance.InitializeLoaders; @@ -727,7 +727,7 @@ begin end; end; -constructor TDbgProcess.Create(const AName: string; const AProcessID, AThreadID: Integer; AOnLog: TOnLog); +constructor TDbgProcess.Create(const AFileName: string; const AProcessID, AThreadID: Integer; AOnLog: TOnLog); const {.$IFDEF CPU64} MAP_ID_SIZE = itu8; @@ -747,7 +747,7 @@ begin FSymInstances := TList.Create; - SetName(AName); + SetFileName(AFileName); inherited Create(Self); end; diff --git a/components/fpdebug/fpdbgcontroller.pas b/components/fpdebug/fpdbgcontroller.pas index cc53e39fd8..942e1db8fd 100644 --- a/components/fpdebug/fpdbgcontroller.pas +++ b/components/fpdebug/fpdbgcontroller.pas @@ -164,7 +164,7 @@ type property RedirectConsoleOutput: boolean read FRedirectConsoleOutput write FRedirectConsoleOutput; property ConsoleTty: string read FConsoleTty write FConsoleTty; // With this parameter set a 'next' will only stop if the current - // instruction is the first inststruction of a line according to the + // instruction is the first instruction of a line according to the // debuginfo. // Due to a bug in fpc's debug-info, the line info for the first instruction // of a line, sometimes points the the prior line. This setting hides the @@ -697,7 +697,7 @@ begin begin FCurrentProcess.LoadInfo; if not FCurrentProcess.DbgInfo.HasInfo then - Log('No Dwarf-debug information available. The debugger will not function properly.',dllInfo); + Log('No Dwarf-debug information available. The debugger will not function properly. [CurrentProcess='+dbgsname(FCurrentProcess)+',DbgInfo='+dbgsname(FCurrentProcess.DbgInfo)+']',dllInfo); DoOnDebugInfoLoaded(self); diff --git a/components/fpdebug/fpdbgwinclasses.pas b/components/fpdebug/fpdbgwinclasses.pas index be5066842f..b239689ab5 100644 --- a/components/fpdebug/fpdbgwinclasses.pas +++ b/components/fpdebug/fpdbgwinclasses.pas @@ -159,55 +159,62 @@ begin log('FpDbg-ERROR: %s', [GetLastErrorText], dllDebug); end; -function QueryFullProcessImageName(hProcess:HANDLE; dwFlags: DWord; lpExeName:LPTSTR; var lpdwSize:DWORD):BOOL; stdcall; external 'kernel32' name 'QueryFullProcessImageNameA'; +function QueryFullProcessImageName(hProcess:HANDLE; dwFlags: DWord; lpExeName:LPWSTR; var lpdwSize:DWORD):BOOL; stdcall; external 'kernel32' name 'QueryFullProcessImageNameW'; function TDbgWinProcess.GetFullProcessImageName(AProcessHandle: THandle): string; var - s: string; + u: UnicodeString; len: DWORD; begin len := MAX_PATH; - SetLength(S, len); - if QueryFullProcessImageName(AProcessHandle, 0, @S[1], len) - then SetLength(S, len) - else begin - S := ''; + SetLength(u, len); + if QueryFullProcessImageName(AProcessHandle, 0, @u[1], len) + then begin + SetLength(u, len); + Result:=UTF8Encode(u); + end else begin + Result := ''; LogLastError; end; - result := s; end; function TDbgWinProcess.GetModuleFileName(AModuleHandle: THandle): string; var + u: UnicodeString; s: string; len: Integer; hMod: THandle; - _GetFinalPathNameByHandle: function(hFile: HANDLE; lpFilename:LPTSTR; cchFilePath, dwFlags: DWORD):DWORD; stdcall; + _GetFinalPathNameByHandle: function(hFile: HANDLE; lpFilename:LPWSTR; 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'); + // GetFinalPathNameByHandle is only available on Windows Vista / Server 2008 + _GetFinalPathNameByHandle := nil; + pointer(_GetFinalPathNameByHandle) := GetProcAddress(hMod, 'GetFinalPathNameByHandleW'); if assigned(_GetFinalPathNameByHandle) then begin - SetLength(S, MAX_PATH); + SetLength(u, MAX_PATH); - len := _GetFinalPathNameByHandle(AModuleHandle, @S[1], MAX_PATH, 0); + len := _GetFinalPathNameByHandle(AModuleHandle, @u[1], MAX_PATH, 0); + s:=''; if len > 0 - then SetLength(S, len - 1) - else begin - S := ''; + then begin + SetLength(u, len - 1); + if (u<>'') and (u[length(u)]=#0) then + begin + // On some older Windows versions there's a bug in GetFinalPathNameByHandleW, + // which leads to a trailing #0. + Delete(u,length(u),1); + end; + s:=UTF8Encode(u); + end else begin + u := ''; 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; @@ -261,7 +268,7 @@ begin s := TDbgWinProcess(AProcess).GetProcFilename(AProcess, AInfo.lpImageName, AInfo.fUnicode, AInfo.hFile); if s <> '' - then SetName(s); + then SetFileName(s); LoadInfo; end; @@ -876,7 +883,7 @@ begin s := GetProcFilename(Self, AInfo.lpImageName, AInfo.fUnicode, 0); if s <> '' - then SetName(s); + then SetFileName(s); end; function TDbgWinProcess.GetInstructionPointerRegisterValue: TDbgPtr;