erabo/spiegel-keyman
1
0
Fork 0
mirror of https://github.com/keymanapp/keyman.git synced 2026-09-17 05:07:40 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions 12

fix(windows): change canonicalization strategy for Windows 7

Browse source 
On Windows 7, we will no longer attempt to canonicalize BCP 47 tags in
the same was as on later OS versions, because there appear to be some
significant differences in how they work, for example, zh-CN is not
converted to zh-Hans-CN on Windows 7, whereas it is on Windows 10.

This commit also refreshes the `KLog` unit which is useful for debugging
these types of scenarios.
This commit is contained in:
Marc Durdin 2021-09-29 11:34:16 +10:00
parent 1aac15fec8
commit 66ddceadda
4 changed files with 278 additions and 177 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

300
windows/src/desktop/kmshell/install/Keyman.Configuration.System.TIPMaintenance.pas
View file

@ -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;

46
windows/src/desktop/kmshell/install/UfrmInstallKeyboard.pas
View file

@ -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

7
windows/src/global/delphi/general/Keyman.System.CanonicalLanguageCodeUtils.pas
View file

@ -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('');

102
windows/src/global/delphi/general/klog.pas
View file

@ -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 <nil>' else s := s + 'object '+vr.VObject.ClassName+' [$'+IntToHex(Integer(Pointer(vr.VObject)), 8)+']';
vtClass: if vr.VClass = nil then s := s + 'class <nil>' 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 + '<error reading variant>'; 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 <nil>' else Result := 'object '+vr.VObject.ClassName+' [$'+IntToHex(Integer(Pointer(vr.VObject)), 8)+']';
vtClass: if vr.VClass = nil then Result := 'class <nil>' 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 := '<error reading variant>'; 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}