diff --git a/windows/src/desktop/kmshell/install/Keyman.Configuration.System.TIPMaintenance.pas b/windows/src/desktop/kmshell/install/Keyman.Configuration.System.TIPMaintenance.pas index c1289679e8..b91bc535e5 100644 --- a/windows/src/desktop/kmshell/install/Keyman.Configuration.System.TIPMaintenance.pas +++ b/windows/src/desktop/kmshell/install/Keyman.Configuration.System.TIPMaintenance.pas @@ -53,6 +53,7 @@ uses Keyman.System.KeymanSentryClient, Keyman.System.LanguageCodeUtils, + KLog, BCP47Tag, glossary, kmint, @@ -68,9 +69,14 @@ var i: Integer; begin Result := True; - for i := 0 to Packages.Count - 1 do - // We'll attempt every package but return failure if any of them have issues - Result := InstallTipForPackage(Packages.Names[i], Packages.ValueFromIndex[i]) and Result; + KL.MethodEnter(nil, 'TTIPMaintenance.InstallTipsForPackages', [Packages.Text]); + try + for i := 0 to Packages.Count - 1 do + // We'll attempt every package but return failure if any of them have issues + Result := InstallTipForPackage(Packages.Names[i], Packages.ValueFromIndex[i]) and Result; + finally + KL.MethodExit(nil, 'TTIPMaintenance.InstallTipsForPackages', [Result]); + end; end; class function TTIPMaintenance.InstallTipForPackage(const PackageFilename, BCP47Tag: string): Boolean; @@ -79,23 +85,29 @@ var n: Integer; pack: IKeymanPackageInstalled; begin - // This function has a known limitation: if a package contains more than one keyboard, - // then the BCP47 association will be made only for the first keyboard. This is - // considered an acceptable limitation at this time + Result := False; + KL.MethodEnter(nil, 'TTIPMaintenance.InstallTipForPackage', [PackageFilename, BCP47Tag]); + try + // This function has a known limitation: if a package contains more than one keyboard, + // then the BCP47 association will be made only for the first keyboard. This is + // considered an acceptable limitation at this time - PackageID := ChangeFileExt(ExtractFileName(PackageFilename), ''); - n := kmcom.Packages.IndexOf(PackageID); - if n < 0 then - Exit(False); + PackageID := ChangeFileExt(ExtractFileName(PackageFilename), ''); + n := kmcom.Packages.IndexOf(PackageID); + if n < 0 then + Exit(False); - pack := kmcom.Packages[n]; + pack := kmcom.Packages[n]; - if pack.Keyboards.Count = 0 then - Exit(False); + if pack.Keyboards.Count = 0 then + Exit(False); - if BCP47Tag = '' - then Result := DoInstall(pack.Keyboards[0].ID, GetFirstLanguage(pack.Keyboards[0] as IKeymanKeyboardInstalled)) - else Result := DoInstall(pack.Keyboards[0].ID, BCP47Tag); + if BCP47Tag = '' + then Result := DoInstall(pack.Keyboards[0].ID, GetFirstLanguage(pack.Keyboards[0] as IKeymanKeyboardInstalled)) + else Result := DoInstall(pack.Keyboards[0].ID, BCP47Tag); + finally + KL.MethodExit(nil, 'TTIPMaintenance.InstallTipForPackage', [Result]); + end; end; procedure AddDiagnosticBreadcrumb(const KeyboardID: string); @@ -125,18 +137,19 @@ class function TTIPMaintenance.InstallTip(LangID: Integer; const KeyboardID, BCP var lang: IKeymanKeyboardLanguageInstalled; begin - lang := GetKeyboardLanguage(KeyboardID, BCP47Tag); - if lang = nil then - Exit(False); - - // TODO: can this fail? + Result := False; + KL.MethodEnter(nil, 'TTIPMaintenance.InstallTip', [LangID, KeyboardID, BCP47Tag, KeyboardToRemove]); try + lang := GetKeyboardLanguage(KeyboardID, BCP47Tag); + if lang = nil then + Exit(False); + + // TODO: can this fail? (lang as IKeymanKeyboardLanguageInstalled2).InstallTip(LangID, KeyboardToRemove); - except - AddDiagnosticBreadcrumb(KeyboardID); - raise; + Result := True; + finally + KL.MethodExit(nil, 'TTIPMaintenance.InstallTip', [Result]); end; - Result := True; end; class function TTIPMaintenance.RegisterTip(LangID: Integer; const KeyboardID, @@ -144,13 +157,19 @@ class function TTIPMaintenance.RegisterTip(LangID: Integer; const KeyboardID, var lang: IKeymanKeyboardLanguageInstalled; begin - lang := GetKeyboardLanguage(KeyboardID, BCP47Tag); - if lang = nil then - Exit(False); + Result := False; + KL.MethodEnter(nil, 'TTIPMaintenance.RegisterTip', [KeyboardID, BCP47Tag]); + try + lang := GetKeyboardLanguage(KeyboardID, BCP47Tag); + if lang = nil then + Exit(False); - // TODO: can this fail? + // TODO: can this fail? (lang as IKeymanKeyboardLanguageInstalled2).RegisterTip(LangID); - Result := True; + Result := True; + finally + KL.MethodExit(nil, 'TTIPMaintenance.RegisterTip', [Result]); + end; end; class function TTIPMaintenance.DoInstall(const KeyboardID, @@ -161,44 +180,59 @@ var TemporaryKeyboardID: WideString; LangID: Integer; childExitCode: Cardinal; + CanonicalTag, Command: string; begin - lang := GetKeyboardLanguage(KeyboardID, (kmcom as IKeymanBCP47Canonicalization).GetCanonicalTag(BCP47Tag)); - if lang = nil then - // The keyboard was not found - Exit(False); - - if lang.IsInstalled then - // After canonicalization, we may find the language is already installed - Exit(True); - - TemporaryKeyboardID := ''; - LangID := 0; - RegistrationRequired := False; - - if not (lang as IKeymanKeyboardLanguageInstalled2).FindInstallationLangID(LangID, TemporaryKeyboardID, RegistrationRequired, kifInstallTransientLanguage) then - begin - // We were not able to find a TIP, perhaps all transient TIPs have been used - Exit(False); - end; - - if RegistrationRequired then - begin - // This calls back into TTIPMaintenance.RegisterTip - if WaitForElevatedConfiguration(0, '-register-tip '+IntToHex(LangID,4)+' "'+KeyboardID+'" "'+lang.BCP47Code+'" '+GetUserDefaultLangParameterString) <> 0 then + Result := False; + KL.MethodEnter(nil, 'TTIPMaintenance.DoInstall', [KeyboardID, BCP47Tag]); + try + CanonicalTag := (kmcom as IKeymanBCP47Canonicalization).GetCanonicalTag(BCP47Tag); + lang := GetKeyboardLanguage(KeyboardID, CanonicalTag); + KL.Log('BCP47Tag = %s, CanonicalTag = %s, lang.BCP47Code = %s', [BCP47Tag, CanonicalTag, lang.BCP47Code]); + if lang = nil then + // The keyboard was not found Exit(False); - end; - // This calls back into TTIPMaintenance.InstallTip - if not TUtilExecute.WaitForProcess('"'+ParamStr(0)+'" -install-tip '+IntToHex(LangID,4)+' "'+KeyboardID+'" "'+lang.BCP47Code+'" "'+TemporaryKeyboardID+'"', - GetCurrentDir, childExitCode) or - (childExitCode <> 0) then - begin + if lang.IsInstalled then + // After canonicalization, we may find the language is already installed + Exit(True); + + TemporaryKeyboardID := ''; + LangID := 0; + RegistrationRequired := False; + + if not (lang as IKeymanKeyboardLanguageInstalled2).FindInstallationLangID(LangID, TemporaryKeyboardID, RegistrationRequired, kifInstallTransientLanguage) then + begin + KL.Log('Failed to find installation langid'); + // We were not able to find a TIP, perhaps all transient TIPs have been used + Exit(False); + end; + + KL.Log('LangID=%x, TemporaryKeyboardID=%s, RegistrationRequired=%s', [LangID, TemporaryKeyboardID, BoolToStr(RegistrationRequired, True)]); + + if RegistrationRequired then + begin + Command := '-register-tip '+IntToHex(LangID,4)+' "'+KeyboardID+'" "'+lang.BCP47Code+'" '+GetUserDefaultLangParameterString; + KL.Log('Calling elevated kmshell %s', [Command]); + // This calls back into TTIPMaintenance.RegisterTip + if WaitForElevatedConfiguration(0, Command) <> 0 then + Exit(False); + end; + + Command := '-install-tip '+IntToHex(LangID,4)+' "'+KeyboardID+'" "'+lang.BCP47Code+'" "'+TemporaryKeyboardID+'"'; + KL.Log('Calling user kmshell %s', [Command]); + // This calls back into TTIPMaintenance.InstallTip + if not TUtilExecute.WaitForProcess('"'+ParamStr(0)+'" '+Command, GetCurrentDir, childExitCode) or + (childExitCode <> 0) then + begin + kmcom.Refresh; + Exit(False); + end; + kmcom.Refresh; - Exit(False); + Result := True; + finally + KL.MethodExit(nil, 'TTIPMaintenance.DoInstall', [Result]); end; - - kmcom.Refresh; - Result := True; end; function GetDefaultHKL: HKL; @@ -215,25 +249,31 @@ var TemporaryKeyboardID: WideString; RegistrationRequired: WordBool; begin - lang := GetKeyboardLanguage(KeyboardID, (kmcom as IKeymanBCP47Canonicalization).GetCanonicalTag(BCP47Tag)); - if lang = nil then - // The keyboard was not found - Exit(False); + Result := False; + KL.MethodEnter(nil, 'TTIPMaintenance.DoRegister', [KeyboardID, BCP47Tag]); + try + lang := GetKeyboardLanguage(KeyboardID, (kmcom as IKeymanBCP47Canonicalization).GetCanonicalTag(BCP47Tag)); + if lang = nil then + // The keyboard was not found + Exit(False); - if lang.IsInstalled or (lang as IKeymanKeyboardLanguageInstalled2).IsRegistered then - // After canonicalization, we may find the language is already installed - Exit(True); + if lang.IsInstalled or (lang as IKeymanKeyboardLanguageInstalled2).IsRegistered then + // After canonicalization, we may find the language is already installed + Exit(True); - TemporaryKeyboardID := ''; - LangID := 0; - RegistrationRequired := False; + TemporaryKeyboardID := ''; + LangID := 0; + RegistrationRequired := False; - if (lang as IKeymanKeyboardLanguageInstalled2).FindInstallationLangID(LangID, TemporaryKeyboardID, RegistrationRequired, 0) then - begin - Result := not RegistrationRequired or RegisterTip(LangID, KeyboardID, lang.BCP47Code); - end - else - Result := False; + if (lang as IKeymanKeyboardLanguageInstalled2).FindInstallationLangID(LangID, TemporaryKeyboardID, RegistrationRequired, 0) then + begin + Result := not RegistrationRequired or RegisterTip(LangID, KeyboardID, lang.BCP47Code); + end + else + Result := False; + finally + KL.MethodExit(nil, 'TTIPMaintenance.DoRegister', [Result]); + end; end; class function TTIPMaintenance.GetUserDefaultLangParameterString: string; @@ -241,15 +281,25 @@ var LangID: Integer; BCP47: string; begin - GetUserDefaultLanguage(BCP47, LangID); - Result := '-default-lang '+BCP47+' '+IntToHex(LangID,4); + KL.MethodEnter(nil, 'TTIPMaintenance.GetUserDefaultLangParameterString', []); + try + GetUserDefaultLanguage(BCP47, LangID); + Result := '-default-lang '+BCP47+' '+IntToHex(LangID,4); + finally + KL.MethodExit(nil, 'TTIPMaintenance.GetUserDefaultLangParameterString', [Result]); + end; end; class function TTIPMaintenance.GetUserDefaultLanguage: string; var LangID: Integer; begin - GetUserDefaultLanguage(Result, LangID); + KL.MethodEnter(nil, 'TTIPMaintenance.GetUserDefaultLanguage', []); + try + GetUserDefaultLanguage(Result, LangID); + finally + KL.MethodExit(nil, 'TTIPMaintenance.GetUserDefaultLanguage', [Result]); + end; end; class procedure TTIPMaintenance.GetUserDefaultLanguage(var BCP47: string; var LangID: Integer); @@ -288,54 +338,60 @@ var end; begin - // Fallback result - LangID := HKLToLanguageID(GetDefaultHKL); - BCP47 := TLanguageCodeUtils.TranslateWindowsLanguagesToBCP47(LangID); - - // For Win10, look in CPL/International/UserProfile - r := TRegistry.Create; + KL.MethodEnter(nil, 'TTIPMaintenance.GetUserDefaultLanguage', []); try - if not r.OpenKeyReadOnly(SRegKey_ControlPanelInternationalUserProfile) then - Exit; - if r.ValueExists(SRegValue_CPIUP_InputMethodOverride) then - begin - // Lookup the override input method BCP 47 tag - v := r.ReadString(SRegValue_CPIUP_InputMethodOverride); - keys := TStringList.Create; - try - r.GetKeyNames(keys); - for key in keys do - begin - if r.OpenKeyReadOnly('\' + SRegKey_ControlPanelInternationalUserProfile + '\' + key) and - r.ValueExists(v) then + // Fallback result + LangID := HKLToLanguageID(GetDefaultHKL); + BCP47 := TLanguageCodeUtils.TranslateWindowsLanguagesToBCP47(LangID); + + // For Win10, look in CPL/International/UserProfile + r := TRegistry.Create; + try + if not r.OpenKeyReadOnly(SRegKey_ControlPanelInternationalUserProfile) then + Exit; + if r.ValueExists(SRegValue_CPIUP_InputMethodOverride) then + begin + // Lookup the override input method BCP 47 tag + v := r.ReadString(SRegValue_CPIUP_InputMethodOverride); + keys := TStringList.Create; + try + r.GetKeyNames(keys); + for key in keys do begin - BCP47 := key; - LangID := GetLangIDFromValueName; - Break; + if r.OpenKeyReadOnly('\' + SRegKey_ControlPanelInternationalUserProfile + '\' + key) and + r.ValueExists(v) then + begin + BCP47 := key; + LangID := GetLangIDFromValueName; + Break; + end; end; + finally + keys.Free; end; - finally - keys.Free; - end; - end - else if r.ValueExists(SRegValue_CPIUP_Languages) then - begin - // The first tag is the default language tag - tags := TStringList.Create; - try - r.ReadMultiString(SRegValue_CPIUP_Languages, tags); - if tags.Count > 0 then - begin - BCP47 := tags[0].Trim; - if r.OpenKeyReadOnly('\' + SRegKey_ControlPanelInternationalUserProfile + '\' + BCP47) then - LangID := GetLangIDFromValueName; + end + else if r.ValueExists(SRegValue_CPIUP_Languages) then + begin + // The first tag is the default language tag + tags := TStringList.Create; + try + r.ReadMultiString(SRegValue_CPIUP_Languages, tags); + if tags.Count > 0 then + begin + BCP47 := tags[0].Trim; + if r.OpenKeyReadOnly('\' + SRegKey_ControlPanelInternationalUserProfile + '\' + BCP47) then + LangID := GetLangIDFromValueName; + end; + finally + tags.Free; end; - finally - tags.Free; end; + finally + r.Free; end; finally - r.Free; + KL.Log('TTIPMaintenance.GetUserDefaultLanguage = BCP47:%s LangID:%d', [BCP47, LangID]); + KL.MethodExit(nil, 'TTIPMaintenance.GetUserDefaultLanguage'); end; end; diff --git a/windows/src/desktop/kmshell/install/UfrmInstallKeyboard.pas b/windows/src/desktop/kmshell/install/UfrmInstallKeyboard.pas index 8e780442e6..34421ca37e 100644 --- a/windows/src/desktop/kmshell/install/UfrmInstallKeyboard.pas +++ b/windows/src/desktop/kmshell/install/UfrmInstallKeyboard.pas @@ -118,6 +118,7 @@ uses System.Win.ComObj, Winapi.ShellApi, + KLog, custinterfaces, GetOSVersion, MessageIdentifierConsts, @@ -270,7 +271,6 @@ end; procedure TfrmInstallKeyboard.FireCommand(const command: WideString; params: TStringList); var - t: TTempFile; BCP47Tag: string; begin BCP47Tag := ''; @@ -297,28 +297,38 @@ begin BCP47Tag := params.ValueFromIndex[0]; TfrmProgress.Execute(Self, function(Manager: IProgressManager): Boolean + var + t: TTempFile; + ExecParams: string; begin - Manager.Title := 'Installing Keyboard'; - Manager.CanCancel := False; - Manager.UpdateProgress('Installing Keyboard', 0, 0); - t := TTempFileManager.Get('.log'); + KL.MethodEnter(Self, '"keyboard_install"', [params.Text]); try - if WaitForElevatedConfiguration(GetForegroundWindow, '-log "'+t.Name+'" -s -i "'+FInstallFile+'='+BCP47Tag+'"'+ - ' -nowelcome '+TTIPMaintenance.GetUserDefaultLangParameterString) = 0 then - begin - // install the keyboard tip - if not InstallTipForKeyboard(BCP47Tag) then - Exit(False); + Manager.Title := 'Installing Keyboard'; + Manager.CanCancel := False; + Manager.UpdateProgress('Installing Keyboard', 0, 0); + t := TTempFileManager.Get('.log'); + try + ExecParams := '-log "'+t.Name+'" -s -i "'+FInstallFile+'='+BCP47Tag+'"'+ + ' -nowelcome '+TTIPMaintenance.GetUserDefaultLangParameterString; + KL.Log('Calling elevated kmshell %s', [ExecParams]); + if WaitForElevatedConfiguration(GetForegroundWindow, ExecParams) = 0 then + begin + // install the keyboard tip + if not InstallTipForKeyboard(BCP47Tag) then + Exit(False); - CheckForMitigationWarningFor_Win10_1803(False, ''); - ModalResult := mrOk; - end - else - ModalResult := mrCancel; + CheckForMitigationWarningFor_Win10_1803(False, ''); + ModalResult := mrOk; + end + else + ModalResult := mrCancel; - CheckLogFileForWarnings(t.Name, False); + CheckLogFileForWarnings(t.Name, False); + finally + t.Free; + end; finally - t.Free; + KL.MethodExit(Self, '"keyboard_install"'); end; Result := True; end diff --git a/windows/src/global/delphi/general/Keyman.System.CanonicalLanguageCodeUtils.pas b/windows/src/global/delphi/general/Keyman.System.CanonicalLanguageCodeUtils.pas index 3d13b07a8a..4da9557054 100644 --- a/windows/src/global/delphi/general/Keyman.System.CanonicalLanguageCodeUtils.pas +++ b/windows/src/global/delphi/general/Keyman.System.CanonicalLanguageCodeUtils.pas @@ -14,6 +14,7 @@ implementation uses BCP47Tag, + GetOsVersion, Keyman.System.LanguageCodeUtils, Keyman.System.Standards.LangTagsRegistry, System.SysUtils; @@ -34,6 +35,12 @@ var t: TBCP47Tag; LangTag: TLangTag; begin + // We do not try and canonicalize language tags on Windows 7, because it does + // not follow the same patterns as for later versions of Windows. For example, + // zh-CN is not canonicalized to zh-Hans-CN + if GetOs = osWin7 then + Exit(Tag); + if Tag = '' then Exit(''); diff --git a/windows/src/global/delphi/general/klog.pas b/windows/src/global/delphi/general/klog.pas index 0915696743..2787f8b347 100644 --- a/windows/src/global/delphi/general/klog.pas +++ b/windows/src/global/delphi/general/klog.pas @@ -1,18 +1,18 @@ (* Name: klog Copyright: Copyright (C) SIL International. - Documentation: - Description: + Documentation: + Description: Create Date: 1 Aug 2006 Modified Date: 8 Jun 2012 Authors: mcdurdin - Related Files: - Dependencies: + Related Files: + Dependencies: - Bugs: - Todo: - Notes: + Bugs: + Todo: + Notes: History: 01 Aug 2006 - mcdurdin - Disable logging with KLOGGING define 14 Sep 2006 - mcdurdin - Add Current Tick Count to logs (for correlation with system.log) 04 May 2012 - mcdurdin - I3309 - V9.0 - Migrate to Delphi XE2, VS2010, svn 1.7 @@ -23,8 +23,6 @@ unit klog; // I3309 interface -{TNT-IGNORE-UNIT} - {DEFINE KLOGGING} {$IFDEF KLOGGING} @@ -41,6 +39,7 @@ type FLogFile: TextFile; FMethodStack: TStringList; FFileOpen: Boolean; + function VarRecToString(const vr: TVarRec): string; {$ENDIF} public constructor Create; @@ -50,7 +49,8 @@ type procedure LogError(const msg: string); overload; procedure LogError(const msg: string; const fmt: array of const); overload; procedure MethodEnter(instance: TObject; const name: string; const parameters: array of const); - procedure MethodExit(instance: TObject; const name: string); + procedure MethodExit(instance: TObject; const name: string); overload; + procedure MethodExit(instance: TObject; const name: string; const result: array of const); overload; end; function KL: TKLog; @@ -60,8 +60,7 @@ implementation {$IFDEF KLOGGING} uses - Variants, Windows, SysUtils, ErrorControlledRegistry, ErrLogPath, VersionInfo, Unicode; - + Variants, Windows, SysUtils, ErrorControlledRegistry, KeymanPaths, VersionInfo, Unicode; {$ENDIF} var @@ -75,6 +74,7 @@ end; { TKLog } +{$WARN SYMBOL_PLATFORM OFF} constructor TKLog.Create; {$IFDEF KLOGGING} @@ -88,21 +88,21 @@ constructor TKLog.Create; var buf: array[0..260] of char; - FRootPath: string; begin inherited Create; - FRootPath := GetErrLogPath; FMethodStack := TStringList.Create; - GetModuleFileName(hInstance, buf, 260); FAppName := buf; - FLogFileName := FRootPath+ChangeFileExt(ExtractFileName(FAppName), '') + IntToStr(GetCurrentProcessId) + '.log'; + GetModuleFileName(hInstance, buf, 260); FAppName := ChangeFileExt(ExtractFileName(buf),''); + FLogFileName := TKeymanPaths.ErrorLogPath(FAppName); Log(StringOfChar('=', 160)); - Log('Starting application '+FAppName+', version '+GetFileVersionString(FAppName)); + Log('Starting application %s, version %s', [FAppName, GetFileVersionString(FAppName)]); + Log('Command line: %s', [String(CmdLine)]); {$ELSE} begin inherited Create; {$ENDIF} end; +{$WARN SYMBOL_PLATFORM DEFAULT} destructor TKLog.Destroy; {$IFDEF KLOGGING} @@ -163,26 +163,7 @@ begin begin vr := TVarRec(parameters[i]); if i > Low(parameters) then s := s + ', '; - case vr.VType of - vtInteger: s := s + IntToStr(vr.VInteger); - vtBoolean: if vr.VBoolean then s := s + 'True' else s := s + 'False'; - vtChar: s := s + ''''+Char(vr.VChar)+''''; // I3310 - vtExtended: s := s + FloatToStr(vr.VExtended^); - vtString: s := s + ''''+String_AtoU(vr.VString^)+''''; // I3310 // I3310 - vtPointer: s := s + '$'+IntToHex(Integer(vr.VPointer), 8); - vtPChar: s := s + ''''+String_AtoU(vr.VPChar)+''''; // I3310 - vtObject: if vr.VObject = nil then s := s + 'object ' else s := s + 'object '+vr.VObject.ClassName+' [$'+IntToHex(Integer(Pointer(vr.VObject)), 8)+']'; - vtClass: if vr.VClass = nil then s := s + 'class ' else s := s + 'class '+vr.VClass.ClassName; - vtWideChar: s := s + ''''+vr.VWideChar+''''; - vtPWideChar: s := s + ''''+vr.VPWideChar+''''; - vtAnsiString: s := s + ''''+string(vr.VAnsiString)+''''; - vtCurrency: s := s + CurrToStr(vr.VCurrency^); - vtVariant: try s := s + VarToStr(vr.VVariant^); except s := s + ''; end; - vtInterface: s := s + 'interface $'+IntToHex(Integer(vr.VInterface), 8); - vtWideString: s := s + ''''+widestring(vr.VWideString)+''''; - vtInt64: s := s + IntToStr(vr.VInt64^); - vtUnicodeString: s := s + ''''+WideString(vr.VUnicodeString)+''''; // I3309 - end; + s := s + VarRecToString(vr); end; if Assigned(instance) then begin @@ -199,6 +180,26 @@ begin {$ENDIF} end; +procedure TKLog.MethodExit(instance: TObject; const name: string; const result: array of const); +{$IFDEF KLOGGING} +var + s: string; +begin + if Assigned(instance) + then s := instance.ClassName+'.'+name + else s := name; + while (FMethodStack.Count > 0) and (FMethodStack[FMethodStack.Count-1] <> s) do + begin + Log(FMethodStack[FMethodStack.Count-1] + ' not exiting properly!'); + FMethodStack.Delete(FMethodStack.Count-1); + end; + if FMethodStack.Count > 0 then FMethodStack.Delete(FMethodStack.Count-1); + Log(s+'() exit('+VarRecToString(TVarRec(result[0]))+')'); +{$ELSE} +begin +{$ENDIF} +end; + procedure TKLog.MethodExit(instance: TObject; const name: string); {$IFDEF KLOGGING} var @@ -226,6 +227,33 @@ begin {$ENDIF} end; +{$IFDEF KLOGGING} +function TKLog.VarRecToString(const vr: TVarRec): string; +begin + case vr.VType of + vtInteger: Result := IntToStr(vr.VInteger); + vtBoolean: if vr.VBoolean then Result := 'True' else Result := 'False'; + vtChar: Result := ''''+Char(vr.VChar)+''''; // I3310 + vtExtended: Result := FloatToStr(vr.VExtended^); + vtString: Result := ''''+String_AtoU(vr.VString^)+''''; // I3310 // I3310 + vtPointer: Result := '$'+IntToHex(Integer(vr.VPointer), 8); + vtPChar: Result := ''''+String_AtoU(vr.VPChar)+''''; // I3310 + vtObject: if vr.VObject = nil then Result := 'object ' else Result := 'object '+vr.VObject.ClassName+' [$'+IntToHex(Integer(Pointer(vr.VObject)), 8)+']'; + vtClass: if vr.VClass = nil then Result := 'class ' else Result := 'class '+vr.VClass.ClassName; + vtWideChar: Result := ''''+vr.VWideChar+''''; + vtPWideChar: Result := ''''+vr.VPWideChar+''''; + vtAnsiString: Result := ''''+string(vr.VAnsiString)+''''; + vtCurrency: Result := CurrToStr(vr.VCurrency^); + vtVariant: try Result := VarToStr(vr.VVariant^); except Result := ''; end; + vtInterface: Result := 'interface $'+IntToHex(Integer(vr.VInterface), 8); + vtWideString: Result := ''''+widestring(vr.VWideString)+''''; + vtInt64: Result := IntToStr(vr.VInt64^); + vtUnicodeString: Result := ''''+UnicodeString(vr.VUnicodeString)+''''; // I3309 + else Result := '???'; + end; +end; +{$ENDIF} + function KLEnabled: Boolean; begin {$IFDEF KLOGGING}