diff --git a/windows/src/buildtools/buildpkg/buildpkg.dpr b/windows/src/buildtools/buildpkg/buildpkg.dpr index 0bf508a048..4b268d105b 100644 --- a/windows/src/buildtools/buildpkg/buildpkg.dpr +++ b/windows/src/buildtools/buildpkg/buildpkg.dpr @@ -35,7 +35,6 @@ uses CRC32 in '..\..\global\delphi\general\CRC32.pas', KeyNames in '..\..\global\delphi\general\KeyNames.pas', wininet5 in '..\..\global\delphi\general\wininet5.pas', - SystemDebugPath in '..\..\global\delphi\general\SystemDebugPath.pas', GlobalProxySettings in '..\..\global\delphi\general\GlobalProxySettings.pas', ErrorControlledRegistry in '..\..\global\delphi\vcl\ErrorControlledRegistry.pas', utilexecute in '..\..\global\delphi\general\utilexecute.pas', diff --git a/windows/src/buildtools/buildpkg/buildpkg.dproj b/windows/src/buildtools/buildpkg/buildpkg.dproj index 3b0ea201a8..b30a69513f 100644 --- a/windows/src/buildtools/buildpkg/buildpkg.dproj +++ b/windows/src/buildtools/buildpkg/buildpkg.dproj @@ -122,7 +122,6 @@ - diff --git a/windows/src/desktop/insthelp/insthelp.dpr b/windows/src/desktop/insthelp/insthelp.dpr index f3da601363..a184fde2db 100644 --- a/windows/src/desktop/insthelp/insthelp.dpr +++ b/windows/src/desktop/insthelp/insthelp.dpr @@ -7,7 +7,6 @@ uses klog in '..\..\global\delphi\general\klog.pas', utilfiletypes in '..\..\global\delphi\general\utilfiletypes.pas', RegistryKeys in '..\..\global\delphi\general\RegistryKeys.pas', - SystemDebugPath in '..\..\global\delphi\general\SystemDebugPath.pas', GetOsVersion in '..\..\global\delphi\general\GetOsVersion.pas', VersionInfo in '..\..\global\delphi\general\VersionInfo.pas', ErrorControlledRegistry in '..\..\global\delphi\vcl\ErrorControlledRegistry.pas', diff --git a/windows/src/desktop/insthelp/insthelp.dproj b/windows/src/desktop/insthelp/insthelp.dproj index d6dd863a77..8036956c57 100644 --- a/windows/src/desktop/insthelp/insthelp.dproj +++ b/windows/src/desktop/insthelp/insthelp.dproj @@ -7,7 +7,7 @@ 1 Console None - 18.2 + 18.4 Win32 @@ -90,7 +90,6 @@ - diff --git a/windows/src/desktop/kmshell/kmshell.dpr b/windows/src/desktop/kmshell/kmshell.dpr index db2fadbcee..d3e423a4f8 100644 --- a/windows/src/desktop/kmshell/kmshell.dpr +++ b/windows/src/desktop/kmshell/kmshell.dpr @@ -47,7 +47,6 @@ uses utilxml in '..\..\global\delphi\general\utilxml.pas', UfrmInstallKeyboardFromWeb in 'install\UfrmInstallKeyboardFromWeb.pas' {frmInstallKeyboardFromWeb}, UfrmWebContainer in '..\..\global\delphi\ui\UfrmWebContainer.pas' {frmWebContainer}, - SystemDebugPath in '..\..\global\delphi\general\SystemDebugPath.pas', MessageIdentifierConsts in '..\..\global\delphi\cust\MessageIdentifierConsts.pas', UfrmDownloadProgress in 'util\UfrmDownloadProgress.pas' {frmDownloadProgress}, kmcomapi_errors in '..\..\global\delphi\general\kmcomapi_errors.pas', diff --git a/windows/src/desktop/kmshell/kmshell.dproj b/windows/src/desktop/kmshell/kmshell.dproj index 057061fa82..759ef5a2ee 100644 --- a/windows/src/desktop/kmshell/kmshell.dproj +++ b/windows/src/desktop/kmshell/kmshell.dproj @@ -163,7 +163,6 @@
frmWebContainer
 -
frmDownloadProgress
@@ -391,18 +390,18 @@ true - - - .\ - true - - kmshell.exe true + + + .\ + true + + 1 diff --git a/windows/src/desktop/setup/setup.dpr b/windows/src/desktop/setup/setup.dpr index f613c8a6fd..71a67bcdec 100644 --- a/windows/src/desktop/setup/setup.dpr +++ b/windows/src/desktop/setup/setup.dpr @@ -11,7 +11,6 @@ uses Upload_Settings in '..\..\global\delphi\general\Upload_Settings.pas', DebugPaths in '..\..\global\delphi\general\DebugPaths.pas', GetOsVersion in '..\..\global\delphi\general\GetOsVersion.pas', - SystemDebugPath in '..\..\global\delphi\general\SystemDebugPath.pas', TntDialogHelp in 'TntDialogHelp.pas', httpuploader_messageprocessor_windows in 'httpuploader_messageprocessor_windows.pas', SetupForm in 'SetupForm.pas', diff --git a/windows/src/desktop/setup/setup.dproj b/windows/src/desktop/setup/setup.dproj index ca85f7544b..3733512acf 100644 --- a/windows/src/desktop/setup/setup.dproj +++ b/windows/src/desktop/setup/setup.dproj @@ -104,7 +104,6 @@ - diff --git a/windows/src/developer/TIKE/Tike.dpr b/windows/src/developer/TIKE/Tike.dpr index 38dedb5374..3131c46b4e 100644 --- a/windows/src/developer/TIKE/Tike.dpr +++ b/windows/src/developer/TIKE/Tike.dpr @@ -146,11 +146,9 @@ uses UfrmDebugStatus in 'child\UfrmDebugStatus.pas' {frmDebugStatus}, UfrmDebugStatus_Key in 'debug\UfrmDebugStatus_Key.pas' {frmDebugStatus_Key}, UfrmDebugStatus_Child in 'debug\UfrmDebugStatus_Child.pas' {frmDebugStatus_Child}, - DebugManager in '..\..\global\delphi\debug\DebugManager.pas', OnlineUpdateCheck in '..\..\global\delphi\online\OnlineUpdateCheck.pas', UfrmOnlineUpdateNewVersion in '..\..\global\delphi\online\UfrmOnlineUpdateNewVersion.pas' {frmOnlineUpdateNewVersion}, DebugPaths in '..\..\global\delphi\general\DebugPaths.pas', - SystemDebugPath in '..\..\global\delphi\general\SystemDebugPath.pas', MessageDefaults in 'kct\MessageDefaults.pas', UfrmDownloadProgress in 'main\UfrmDownloadProgress.pas' {frmDownloadProgress}, UframeOnScreenKeyboardEditor in 'main\UframeOnScreenKeyboardEditor.pas' {frameOnScreenKeyboardEditor}, diff --git a/windows/src/developer/TIKE/Tike.dproj b/windows/src/developer/TIKE/Tike.dproj index 41c3dc6455..1053483eb9 100644 --- a/windows/src/developer/TIKE/Tike.dproj +++ b/windows/src/developer/TIKE/Tike.dproj @@ -313,13 +313,11 @@
frmDebugStatus_Child
 -
frmOnlineUpdateNewVersion
 -
frmDownloadProgress
diff --git a/windows/src/developer/TIKE/main/UfrmMain.pas b/windows/src/developer/TIKE/main/UfrmMain.pas index cc6fd1982d..2102297822 100644 --- a/windows/src/developer/TIKE/main/UfrmMain.pas +++ b/windows/src/developer/TIKE/main/UfrmMain.pas @@ -414,7 +414,6 @@ uses Keyman.Developer.System.CEFManager, CharMapDropTool, - DebugManager, HTMLHelpViewer, KLog, keymanapi_TLB, @@ -530,15 +529,6 @@ begin frmHelp := TfrmHelp.Create(Application); - KL.Log('GetDebugManager start'); - try - GetDebugManager(Handle); - except - on E:Exception do - KL.LogError('GetDebugManager failed: '+E.Message); - end; - KL.Log('GetDebugManager finish'); - Application.OnActivate := AppOnActivate; LoadDockLayout; diff --git a/windows/src/developer/kmcomp/kmcomp.dpr b/windows/src/developer/kmcomp/kmcomp.dpr index 7961ced7a7..70913fe01f 100644 --- a/windows/src/developer/kmcomp/kmcomp.dpr +++ b/windows/src/developer/kmcomp/kmcomp.dpr @@ -31,7 +31,6 @@ uses utilkeyboard in '..\..\global\delphi\general\utilkeyboard.pas', unicode in '..\..\global\delphi\general\unicode.pas', utilhttp in '..\..\global\delphi\general\utilhttp.pas', - SystemDebugPath in '..\..\global\delphi\general\SystemDebugPath.pas', GetOsVersion in '..\..\global\delphi\general\GetOsVersion.pas', UfrmTike in '..\TIKE\main\UfrmTike.pas' {TikeForm: TTntForm}, CompilePackageInstaller in '..\..\global\delphi\general\CompilePackageInstaller.pas', diff --git a/windows/src/developer/kmcomp/kmcomp.dproj b/windows/src/developer/kmcomp/kmcomp.dproj index df5c58eaee..d9a5adc844 100644 --- a/windows/src/developer/kmcomp/kmcomp.dproj +++ b/windows/src/developer/kmcomp/kmcomp.dproj @@ -130,7 +130,6 @@ -
TikeForm
diff --git a/windows/src/developer/setup/setup.dpr b/windows/src/developer/setup/setup.dpr index 51c515d53f..bb2b862ceb 100644 --- a/windows/src/developer/setup/setup.dpr +++ b/windows/src/developer/setup/setup.dpr @@ -12,7 +12,6 @@ uses Upload_Settings in '..\..\global\delphi\general\Upload_Settings.pas', DebugPaths in '..\..\global\delphi\general\DebugPaths.pas', GetOsVersion in '..\..\global\delphi\general\GetOsVersion.pas', - SystemDebugPath in '..\..\global\delphi\general\SystemDebugPath.pas', TntDialogHelp in 'TntDialogHelp.pas', httpuploader_messageprocessor_windows in 'httpuploader_messageprocessor_windows.pas', SetupForm in 'SetupForm.pas', diff --git a/windows/src/developer/setup/setup.dproj b/windows/src/developer/setup/setup.dproj index 29cdf1de94..8e39ae65cc 100644 --- a/windows/src/developer/setup/setup.dproj +++ b/windows/src/developer/setup/setup.dproj @@ -93,7 +93,6 @@ - diff --git a/windows/src/engine/.gitignore b/windows/src/engine/.gitignore new file mode 100644 index 0000000000..045423e809 --- /dev/null +++ b/windows/src/engine/.gitignore @@ -0,0 +1,10 @@ +keyman32/MSG00001.bin +keyman32/keyman-debug-etw.h +keyman32/keyman-debug-etw.rc +keyman32/keyman-debug-etw.res +keyman32/keyman-debug-etwTEMP.BIN +keyman64/MSG00001.bin +keyman64/keyman-debug-etw.h +keyman64/keyman-debug-etw.rc +keyman64/keyman-debug-etw.res +keyman64/keyman-debug-etwTEMP.BIN diff --git a/windows/src/engine/inst/insthelper/insthelper.dpr b/windows/src/engine/inst/insthelper/insthelper.dpr index 94ca20c8b9..db38baa832 100644 --- a/windows/src/engine/inst/insthelper/insthelper.dpr +++ b/windows/src/engine/inst/insthelper/insthelper.dpr @@ -20,7 +20,6 @@ uses CRC32 in '..\..\..\global\delphi\general\CRC32.pas', VersionInfo in '..\..\..\global\delphi\general\VersionInfo.pas', GetOsVersion in '..\..\..\global\delphi\general\GetOsVersion.pas', - SystemDebugPath in '..\..\..\global\delphi\general\SystemDebugPath.pas', OnlineConstants in '..\..\..\global\delphi\productactivation\OnlineConstants.pas', ErrorControlledRegistry in '..\..\..\global\delphi\vcl\ErrorControlledRegistry.pas', Unicode in '..\..\..\global\delphi\general\Unicode.pas', diff --git a/windows/src/engine/inst/insthelper/insthelper.dproj b/windows/src/engine/inst/insthelper/insthelper.dproj index c4240ed200..e250ad58ca 100644 --- a/windows/src/engine/inst/insthelper/insthelper.dproj +++ b/windows/src/engine/inst/insthelper/insthelper.dproj @@ -7,7 +7,7 @@ 1 Library None - 18.1 + 18.4 Win32 @@ -74,7 +74,7 @@ Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) 1033 - CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= + CompanyName=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName);FileDescription=$(MSBuildProjectName);ProductName=$(MSBuildProjectName) insthelper_Icon.ico @@ -86,7 +86,7 @@ RELEASE;$(DCC_Define) - CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= + CompanyName=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName);FileDescription=$(MSBuildProjectName);ProductName=$(MSBuildProjectName) 1033 @@ -94,7 +94,7 @@ false - CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= + CompanyName=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName);FileDescription=$(MSBuildProjectName);ProductName=$(MSBuildProjectName) 1033 @@ -106,7 +106,6 @@ - @@ -175,6 +174,7 @@ + False True False diff --git a/windows/src/engine/keyman/GlobalKeyboardChangeManager.pas b/windows/src/engine/keyman/GlobalKeyboardChangeManager.pas index 047515cd1c..e133a04567 100644 --- a/windows/src/engine/keyman/GlobalKeyboardChangeManager.pas +++ b/windows/src/engine/keyman/GlobalKeyboardChangeManager.pas @@ -30,7 +30,7 @@ type implementation uses - DebugManager, + Keyman.System.DebugLogClient, UfrmKeyman7Main; const @@ -78,7 +78,7 @@ begin // ATOM construction copied from TLangSwitchKeyboard s := IntToStr(TIP.Profile.langid) + '|' + GUIDToString(TGUID(TIP.Profile.clsid)) + '|' + GUIDToString(TGUID(TIP.Profile.guidProfile)); - TDebugManager.WriteMessage('TGlobalKeyboardChangeManager.PostChange: '+s, []); + TDebugLogClient.Instance.WriteMessage('TGlobalKeyboardChangeManager.PostChange: '+s, []); if s <> FLastKeyboard then begin @@ -92,7 +92,7 @@ begin WinKB := Keyboard as TLangSwitchKeyboard_WinKeyboard; s := IntToStr(WinKB.HKL); - TDebugManager.WriteMessage('TGlobalKeyboardChangeManager.PostChange: '+s, []); + TDebugLogClient.Instance.WriteMessage('TGlobalKeyboardChangeManager.PostChange: '+s, []); if s <> FLastKeyboard then begin diff --git a/windows/src/engine/keyman/UfrmDebugNotify.dfm b/windows/src/engine/keyman/UfrmDebugNotify.dfm deleted file mode 100644 index 299a6a649e..0000000000 --- a/windows/src/engine/keyman/UfrmDebugNotify.dfm +++ /dev/null @@ -1,80 +0,0 @@ -object frmDebugNotify: TfrmDebugNotify - Left = 0 - Top = 0 - BorderIcons = [biSystemMenu] - BorderStyle = bsDialog - Caption = 'Keyman Debug Notification' - ClientHeight = 321 - ClientWidth = 553 - Color = clBtnFace - Font.Charset = DEFAULT_CHARSET - Font.Color = clWindowText - Font.Height = -11 - Font.Name = 'Tahoma' - Font.Style = [] - FormStyle = fsStayOnTop - OldCreateOrder = False - Position = poScreenCenter - OnShow = FormShow - PixelsPerInch = 96 - TextHeight = 13 - object lblNotes: TLabel - Left = 12 - Top = 17 - Width = 240 - Height = 13 - Caption = 'Note &details about this issue to store in the log file' - FocusControl = memoNotes - end - object lblLogFileName: TLabel - Left = 12 - Top = 259 - Width = 67 - Height = 13 - Caption = '&Log file name:' - FocusControl = editLogFileName - end - object memoNotes: TMemo - Left = 12 - Top = 36 - Width = 529 - Height = 209 - TabOrder = 0 - end - object editLogFileName: TEdit - Left = 92 - Top = 256 - Width = 449 - Height = 21 - TabStop = False - ParentColor = True - ReadOnly = True - TabOrder = 1 - end - object chkNotepad: TCheckBox - Left = 92 - Top = 288 - Width = 133 - Height = 17 - Caption = 'Open log file in &Notepad' - TabOrder = 2 - end - object cmdOK: TButton - Left = 472 - Top = 283 - Width = 73 - Height = 25 - Caption = 'OK' - Default = True - TabOrder = 4 - OnClick = cmdOKClick - end - object chkClipboard: TCheckBox - Left = 244 - Top = 288 - Width = 145 - Height = 17 - Caption = '&Copy file to clipboard' - TabOrder = 3 - end -end diff --git a/windows/src/engine/keyman/UfrmDebugNotify.pas b/windows/src/engine/keyman/UfrmDebugNotify.pas deleted file mode 100644 index 3ea2a15fda..0000000000 --- a/windows/src/engine/keyman/UfrmDebugNotify.pas +++ /dev/null @@ -1,181 +0,0 @@ -(* - Name: UfrmDebugNotify - Copyright: Copyright (C) SIL International. - Documentation: - Description: - Create Date: 4 May 2010 - - Modified Date: 8 Jun 2012 - Authors: mcdurdin - Related Files: - Dependencies: - - Bugs: - Todo: - Notes: - History: 04 May 2010 - mcdurdin - I2348 - Rework of debug log - 04 May 2010 - mcdurdin - I2349 - Debug log capture hotkey - 08 Jun 2012 - mcdurdin - I3349 - V9.0 - Consolidate all process creation into TUtilExecute -*) -unit UfrmDebugNotify; - -interface - -uses - Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, - Dialogs, StdCtrls, UserMessages; - -type - TfrmDebugNotify = class(TForm) - memoNotes: TMemo; - lblNotes: TLabel; - editLogFileName: TEdit; - chkNotepad: TCheckBox; - cmdOK: TButton; - lblLogFileName: TLabel; - chkClipboard: TCheckBox; - procedure FormShow(Sender: TObject); - procedure cmdOKClick(Sender: TObject); - private - FLogFileHandle: THandle; - FLogFileIndex: Integer; - procedure SetLogFileIndex(const Value: Integer); - procedure WMUserFormShown(var Message: TMessage); message WM_USER_FormShown; - procedure SetClipboardToFilename(const Filename: string); - { Private declarations } - public - { Public declarations } - property LogFileHandle: THandle read FLogFileHandle write FLogFileHandle; - property LogFileIndex: Integer read FLogFileIndex write SetLogFileIndex; - end; - -implementation - -uses - Clipbrd, - DebugManager, - ShellApi, - ShlObj, - utilexecute; - -{$R *.dfm} - -{ TfrmDebugNotify } - -//////////////////////////////////////////////////////////////// -// copies filenames from "Filenames" to the clipboard. -// "Filenames" can contain file- and directory names. -function Sto_CopyFilenamesToClipboard(Filenames: TStrings): Boolean; -var - sFilenames: String; - iIndex: Integer; - hBuffer: HGLOBAL; - pBuffer: PDropFiles; -begin - // check entry conditions - Result := (Filenames <> nil) and (Filenames.Count > 0); - if (not Result) then Exit; - // bring the filenames in a form, - // separated by #0 and ending with a double #0#0 - sFilenames := ''; - for iIndex := 0 to Filenames.Count - 1 do - sFilenames := sFilenames + - ExcludeTrailingPathDelimiter(Filenames.Strings[iIndex]) + #0; - sFilenames := sFilenames + #0; - // allocate memory with the size of the "DropFiles" structure plus the - // length of the filename buffer. - hBuffer := GlobalAlloc(GMEM_MOVEABLE or GMEM_ZEROINIT, - SizeOf(DROPFILES) + Length(sFilenames)); - try - Result := (hBuffer <> 0); - if (Result) then - begin - pBuffer := GlobalLock(hBuffer); - try - // prepare the "DROPFILES" structure - pBuffer^.pFiles := SizeOf(DROPFILES); - // behind the "DROPFILES" structure we place the filenames - pBuffer := Pointer(Integer(pBuffer) + SizeOf(DROPFILES)); - CopyMemory(pBuffer, PChar(sFilenames), Length(sFilenames)); - finally - GlobalUnlock(hBuffer); - end; - // copy buffer to the clipboard - Clipboard.Open; - try - Clipboard.SetAsHandle(CF_HDROP, hBuffer); - finally - Clipboard.Close; - end; - end; - except - Result := False; - // free only if handle could not be passed to the clipboard - GlobalFree(hBuffer); - end; -end; - - -procedure TfrmDebugNotify.SetClipboardToFilename(const Filename: string); -var - s: TStrings; -begin - s := TSTringList.Create; - try - s.Add(Filename); - Sto_CopyFilenamesToClipboard(s); - finally - s.Free; - end; -end; - -type - TDebugManagerEx = class(TDebugManager) - end; - -procedure TfrmDebugNotify.cmdOKClick(Sender: TObject); -begin - TDebugManagerEx.WriteString(FLogFileHandle, memoNotes.Text); - { - buf := PChar(memoNotes.Text); - buflen := Length(buf); - WriteFile(FLogFileHandle, PChar(buf)^, buflen, n, nil); - WriteFile(FLogFileHandle, #13#10, 2, n, nil); - } - TDebugManagerEx.CloseLogFile(FLogFileHandle); - - if chkNotepad.Checked then - if not TUtilExecute.Shell(Handle, editLogFileName.Text, GetCurrentDir) then // I3349 - ShowMessage(SysErrorMessage(GetLastError)); - - if chkClipboard.Checked then - SetClipboardToFilename(editLogFileName.Text); - - ModalResult := mrOk; -end; - -procedure TfrmDebugNotify.FormShow(Sender: TObject); -begin - PostMessage(Handle, WM_USER_FormShown, 0, 0); -end; - -procedure TfrmDebugNotify.SetLogFileIndex(const Value: Integer); -begin - FLogFileIndex := Value; - editLogFileName.Text := TDebugManager.DebugLogFileName(Value); -end; - -procedure TfrmDebugNotify.WMUserFormShown(var Message: TMessage); -var - FThreadID: DWord; -begin - FThreadID := GetWindowThreadProcessId(GetForegroundWindow); - if FThreadID <> GetCurrentThreadId then - AttachThreadInput(GetCurrentThreadId, FThreadID, True); - BringToFront; - SetFocus; - if FThreadID <> GetCurrentThreadId then - AttachThreadInput(GetCurrentThreadId, FThreadID, False); -end; - -end. diff --git a/windows/src/engine/keyman/UfrmKeyman7Main.pas b/windows/src/engine/keyman/UfrmKeyman7Main.pas index 0d1383ccaa..af78a66f57 100644 --- a/windows/src/engine/keyman/UfrmKeyman7Main.pas +++ b/windows/src/engine/keyman/UfrmKeyman7Main.pas @@ -148,6 +148,9 @@ uses Vcl.StdCtrls, Vcl.ImgList, + Keyman.System.DebugLogClient, + Keyman.System.DebugLogManager, + keymanapi_TLB, //TOUCH UfrmTouchKeyboard, GlobalKeyboardChangeManager, @@ -155,7 +158,6 @@ uses KeymanTrayIcon, KeymanMenuItem, custinterfaces, - DebugManager, Menu_KeyboardItems, UserMessages, UfrmKeymanMenu, @@ -240,7 +242,6 @@ type procedure WMUserParameterPass(var Message: TMessage); message WM_USER_ParameterPass; procedure WMUserSendFontChange(var Message: TMessage); message WM_USER_SendFontChange; procedure WMUserPlatformComms(var Message: TMessage); message WM_USER_PlatformComms; - procedure WMUserDebugNotify(var Message: TMessage); message WM_USER_DebugNotify; procedure WMUserVisualKeyboardClosed(var Message: TMessage); message WM_USER_VisualKeyboardClosed; // I4243 procedure SetTrayIcon(rp: TRunningProduct; kbd: IKeymanKeyboardInstalled); procedure TrayIconMouseUp(Sender: TObject; Button: TMouseButton; @@ -378,7 +379,6 @@ uses UfrmHelp, UILanguages, UfrmOSKCharacterMap, - UfrmDebugNotify, utilstr, utilwow64, KeymanEngineControl, @@ -715,7 +715,7 @@ begin end else if Message.Msg = wm_keyman_globalswitch then begin - TDebugManager.WriteMessage('wm_keyman_globalswitch for Application Handle: %x %x', [Message.wParam, Message.lParam]); + TDebugLogClient.Instance.WriteMessage('wm_keyman_globalswitch for Application Handle: %x %x', [Message.wParam, Message.lParam]); case Message.wParam of skHKL, // A windows language has been selected so select the most appropriate Keyman keyboard @@ -733,9 +733,9 @@ begin Exit; end; - TDebugManager.WriteMessage('wm_keyman_control for Application Handle: %x %x', [Message.wParam, Message.lParam]); + TDebugLogClient.Instance.WriteMessage('wm_keyman_control for Application Handle: %x %x', [Message.wParam, Message.lParam]); Message.Result := ProcessWMKeymanControl(LoWord(Message.WParam), HiWord(Message.WParam), Message.LParam); // I3961 - TDebugManager.WriteMessage('wm_keyman_control-exit for Application Handle: %x %x -> %x', [Message.wParam, Message.lParam, Message.Result]); // I3961 + TDebugLogClient.Instance.WriteMessage('wm_keyman_control-exit for Application Handle: %x %x -> %x', [Message.wParam, Message.lParam, Message.Result]); // I3961 end else Result := False; @@ -748,21 +748,21 @@ begin gti.cbSize := SizeOf(gti); if not GetGUIThreadInfo(0, gti) then begin - TDebugManager.WriteLastError('UpdateFocusInfo', 'GetGUIThreadInfo'); + TDebugLogClient.Instance.WriteLastError('UpdateFocusInfo', 'GetGUIThreadInfo'); Exit; end; - TDebugManager.WriteMessage('UpdateFocusInfo: last focus=%x last active=%x', [FLastFocus, FLastActive]); - TDebugManager.WriteMessage('UpdateFocusInfo: new focus=%x new active=%x', [gti.hwndFocus, gti.hwndActive]); + TDebugLogClient.Instance.WriteMessage('UpdateFocusInfo: last focus=%x last active=%x', [FLastFocus, FLastActive]); + TDebugLogClient.Instance.WriteMessage('UpdateFocusInfo: new focus=%x new active=%x', [gti.hwndFocus, gti.hwndActive]); if IsControllerWindow(gti.hwndFocus) then // I4731 - TDebugManager.WriteMessage('UpdateFocusInfo: new focus is controller window, not updating', []) + TDebugLogClient.Instance.WriteMessage('UpdateFocusInfo: new focus is controller window, not updating', []) else if IsSysTrayWindow(gti.hwndFocus) then // I4731 - TDebugManager.WriteMessage('UpdateFocusInfo: new focus is systray window, not updating', []) + TDebugLogClient.Instance.WriteMessage('UpdateFocusInfo: new focus is systray window, not updating', []) else if IsControllerWindow(gti.hwndActive) then // I4731 - TDebugManager.WriteMessage('UpdateFocusInfo: new active is controller window, not updating', []) + TDebugLogClient.Instance.WriteMessage('UpdateFocusInfo: new active is controller window, not updating', []) else if IsSysTrayWindow(gti.hwndActive) then // I4731 - TDebugManager.WriteMessage('UpdateFocusInfo: new active is systray window, not updating', []) + TDebugLogClient.Instance.WriteMessage('UpdateFocusInfo: new active is systray window, not updating', []) else begin FLastFocus := gti.hwndFocus; @@ -928,14 +928,14 @@ begin if Assigned(kbd) then begin case kbd.ItemType of - lsitWinKeyboard: TDebugManager.WriteMessage('LanguageSwitchFormHidden: kbd assigned, type = lsitWinKeyboard, value = %x', [(kbd as TLangSwitchKeyboard_WinKeyboard).HKL]); - lsitTIP: TDebugManager.WriteMessage('LanguageSwitchFormHidden: kbd assigned, type = lsitTIP, value = %s', [(kbd as TLangSwitchKeyboard_TIP).Caption]); - else TDebugManager.WriteMessage('LanguageSwitchFormHidden: kbd assigned, type = somthing else', []); + lsitWinKeyboard: TDebugLogClient.Instance.WriteMessage('LanguageSwitchFormHidden: kbd assigned, type = lsitWinKeyboard, value = %x', [(kbd as TLangSwitchKeyboard_WinKeyboard).HKL]); + lsitTIP: TDebugLogClient.Instance.WriteMessage('LanguageSwitchFormHidden: kbd assigned, type = lsitTIP, value = %s', [(kbd as TLangSwitchKeyboard_TIP).Caption]); + else TDebugLogClient.Instance.WriteMessage('LanguageSwitchFormHidden: kbd assigned, type = somthing else', []); end; kbd.Activate(hwnd); end else - TDebugManager.WriteMessage('LanguageSwitchFormHidden: kbd NOT assigned',[]); + TDebugLogClient.Instance.WriteMessage('LanguageSwitchFormHidden: kbd NOT assigned',[]); end; procedure TfrmKeyman7Main.ShowMenu(Sender: TObject; Location: TCustomisationMenuItemLocation; NearTray: Boolean; IconRect: TRect); // I3990 // I3991 @@ -1155,18 +1155,6 @@ begin end; end; -procedure TfrmKeyman7Main.WMUserDebugNotify(var Message: TMessage); -begin - with TfrmDebugNotify.Create(Self) do - try - LogFileHandle := Message.LParam; - LogFileIndex := Message.WParam; - ShowModal; - finally - Free; - end; -end; - procedure TfrmKeyman7Main.WMUserSendFontChange(var Message: TMessage); begin PostMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0); @@ -1377,7 +1365,7 @@ procedure TfrmKeyman7Main.ActivateKeyboard(Keyboard: TLangSwitchKeyboard); // var hwnd: THandle; begin - TDebugManager.WriteMessage('ActivateKeyboard: LastFocus=%x LastActive=%x Keyboard=%s KeymanID=%d', [FLastFocus, FLastActive, Keyboard.Caption, Keyboard.KeymanID]); // I4674 + TDebugLogClient.Instance.WriteMessage('ActivateKeyboard: LastFocus=%x LastActive=%x Keyboard=%s KeymanID=%d', [FLastFocus, FLastActive, Keyboard.Caption, Keyboard.KeymanID]); // I4674 hwnd := FLastFocus; AllowSetForegroundWindow(ASFW_ANY); // I3933 PostMessage(FLastActive, wm_keyman_control_internal, KMCI_SETFOREGROUND, FLastFocus); // I3933 @@ -1405,23 +1393,23 @@ begin tid := GetWindowThreadProcessId(FLastFocus, nil); if tid = 0 then begin - TDebugManager.WriteLastError('SetLastFocus', 'GetWindowThreadProcessId'); + TDebugLogClient.Instance.WriteLastError('SetLastFocus', 'GetWindowThreadProcessId'); Exit; end; if not AttachThreadInput(tid, GetCurrentThreadId, TRUE) then begin - TDebugManager.WriteLastError('SetLastFocus', 'AttachThreadInput:1'); + TDebugLogClient.Instance.WriteLastError('SetLastFocus', 'AttachThreadInput:1'); Exit; end; //Windows.SetForegroundWindow(FLastFocus); //FLastActive); if Winapi.Windows.SetFocus(FLastFocus) = 0 then - TDebugManager.WriteLastError('SetLastFocus', 'SetFocus'); + TDebugLogClient.Instance.WriteLastError('SetLastFocus', 'SetFocus'); if not AttachThreadInput(tid, GetCurrentThreadId, FALSE) then begin - TDebugManager.WriteLastError('SetLastFocus', 'AttachThreadInput:2'); + TDebugLogClient.Instance.WriteLastError('SetLastFocus', 'AttachThreadInput:2'); Exit; end; end; diff --git a/windows/src/engine/keyman/keyman.dpr b/windows/src/engine/keyman/keyman.dpr index 40ecaf863a..25166911d9 100644 --- a/windows/src/engine/keyman/keyman.dpr +++ b/windows/src/engine/keyman/keyman.dpr @@ -52,11 +52,10 @@ uses UfrmCharacterMapFilter in '..\..\global\delphi\charmap\UfrmCharacterMapFilter.pas' {frmCharacterMapFilter}, FixedTrackbar in '..\..\global\delphi\comp\FixedTrackbar.pas', Menu_KeyboardItems in 'Menu_KeyboardItems.pas', - DebugManager in '..\..\global\delphi\debug\DebugManager.pas', + Keyman.System.DebugLogManager in '..\..\global\delphi\debug\Keyman.System.DebugLogManager.pas', PaintPanel in '..\..\global\delphi\comp\PaintPanel.pas', exImageList in '..\..\global\delphi\comp\exImageList.pas', utilhttp in '..\..\global\delphi\general\utilhttp.pas', - SystemDebugPath in '..\..\global\delphi\general\SystemDebugPath.pas', VistaMessages in 'VistaMessages.pas', MessageIdentifierConsts in '..\..\global\delphi\cust\MessageIdentifierConsts.pas', VisualKeyboardExportXML in '..\..\global\delphi\visualkeyboard\VisualKeyboardExportXML.pas', @@ -93,7 +92,6 @@ uses WebSoundControl in '..\..\global\delphi\general\WebSoundControl.pas', VKeyChars in '..\..\global\delphi\general\VKeyChars.pas', usp10 in '..\..\global\delphi\general\usp10.pas', - UfrmDebugNotify in 'UfrmDebugNotify.pas' {frmDebugNotify}, UserMessages in '..\..\global\delphi\general\UserMessages.pas', UfrmKeymanMenu in 'UfrmKeymanMenu.pas' {frmKeymanMenu}, UILanguages in '..\..\desktop\kmshell\util\UILanguages.pas', @@ -139,7 +137,9 @@ uses Keyman.System.Standards.BCP47SubtagRegistry in '..\..\global\delphi\standards\Keyman.System.Standards.BCP47SubtagRegistry.pas', Keyman.System.Standards.BCP47SuppressScriptRegistry in '..\..\global\delphi\standards\Keyman.System.Standards.BCP47SuppressScriptRegistry.pas', Keyman.System.Standards.LibPalasoAllTagsRegistry in '..\..\global\delphi\standards\Keyman.System.Standards.LibPalasoAllTagsRegistry.pas', - Keyman.System.CanonicalLanguageCodeUtils in '..\..\global\delphi\general\Keyman.System.CanonicalLanguageCodeUtils.pas'; + Keyman.System.CanonicalLanguageCodeUtils in '..\..\global\delphi\general\Keyman.System.CanonicalLanguageCodeUtils.pas', + Keyman.System.DebugLogClient in '..\..\global\delphi\debug\Keyman.System.DebugLogClient.pas', + Keyman.System.DebugLogCommon in '..\..\global\delphi\debug\Keyman.System.DebugLogCommon.pas'; {$R ICONS.RES} {$R VERSION.RES} diff --git a/windows/src/engine/keyman/keyman.dproj b/windows/src/engine/keyman/keyman.dproj index e670ebf090..8893daced2 100644 --- a/windows/src/engine/keyman/keyman.dproj +++ b/windows/src/engine/keyman/keyman.dproj @@ -149,11 +149,10 @@ - + - @@ -205,9 +204,6 @@ - -
frmDebugNotify
-
frmKeymanMenu
@@ -264,6 +260,8 @@ + + Cfg_2 diff --git a/windows/src/engine/keyman/langswitch/LangSwitchManager.pas b/windows/src/engine/keyman/langswitch/LangSwitchManager.pas index cda4466df5..646807eac2 100644 --- a/windows/src/engine/keyman/langswitch/LangSwitchManager.pas +++ b/windows/src/engine/keyman/langswitch/LangSwitchManager.pas @@ -245,7 +245,7 @@ uses // System.StrUtils, - DebugManager, + Keyman.System.DebugLogClient, glossary, InterfaceHotkeys, kmint, @@ -361,18 +361,18 @@ var ppEnum: IEnumTfInputProcessorProfiles; FItem: TLangSwitchKeyboard; begin - TDebugManager.WriteMessage('[EnumTSFKeyboards] ENTER -------------', []); + TDebugLogClient.Instance.WriteMessage('[EnumTSFKeyboards] ENTER -------------', []); Assert(Assigned(FProfileMgr)); // I2864 // I4220 for I := 0 to FLanguages.Count - 1 do begin - TDebugManager.WriteMessage('[EnumTSFKeyboards] LangID=%x', [FLanguages[i].LangID]); + TDebugLogClient.Instance.WriteMessage('[EnumTSFKeyboards] LangID=%x', [FLanguages[i].LangID]); FProfileMgr.EnumProfiles(FLanguages[i].LangID, ppEnum); hr := ppEnum.Next(1, profile, pcFetch); while hr = S_OK do begin try - TDebugManager.WriteMessage('[EnumTSFKeyboards] LangID=%x type=%d hkl=%x flags=%x', [FLanguages[i].LangID, profile.dwProfileType, profile.HKL, profile.dwFlags]); + TDebugLogClient.Instance.WriteMessage('[EnumTSFKeyboards] LangID=%x type=%d hkl=%x flags=%x', [FLanguages[i].LangID, profile.dwProfileType, profile.HKL, profile.dwFlags]); if (profile.dwFlags and TF_IPP_FLAG_ENABLED) = 0 then // I4207 begin @@ -382,12 +382,12 @@ begin if profile.dwProfileType = TF_PROFILETYPE_KEYBOARDLAYOUT then begin FItem := TLangSwitchKeyboard_WinKeyboard.Create(Self, FLanguages[i], profile.HKL); //, (profile.dwFlags and TF_IPP_FLAG_ACTIVE) = TF_IPP_FLAG_ACTIVE); // I3961 - TDebugManager.WriteMessage('[EnumTSFKeyboards] Creating WinKeyboard hkl=%x, valid=%s', [profile.HKL, BoolToStr(FItem.Valid)]); // I4648 + TDebugLogClient.Instance.WriteMessage('[EnumTSFKeyboards] Creating WinKeyboard hkl=%x, valid=%s', [profile.HKL, BoolToStr(FItem.Valid)]); // I4648 end else if (profile.catid = GUID_TFCAT_TIP_KEYBOARD) then // I2826 // I3933 // I4005 begin FItem := TLangSwitchKeyboard_TIP.Create(Self, FLanguages[i], profile); // I3961 - TDebugManager.WriteMessage('[EnumTSFKeyboards] Creating TSF TIP guid=%s keymanid=%d, valid=%s', [GuidToString(profile.guidProfile), FItem.KeymanID, BoolToStr(FItem.Valid)]); // I4648 + TDebugLogClient.Instance.WriteMessage('[EnumTSFKeyboards] Creating TSF TIP guid=%s keymanid=%d, valid=%s', [GuidToString(profile.guidProfile), FItem.KeymanID, BoolToStr(FItem.Valid)]); // I4648 end else begin @@ -402,7 +402,7 @@ begin end; end; end; - TDebugManager.WriteMessage('[EnumTSFKeyboards] EXIT ---------------', []); + TDebugLogClient.Instance.WriteMessage('[EnumTSFKeyboards] EXIT ---------------', []); end; procedure TLangSwitchManager.Refresh; // I3933 @@ -682,7 +682,7 @@ procedure TLangSwitchKeyboard_WinKeyboard.Activate(hwnd: THandle); begin // Assert(FValid); // I4715 FManager.SetActiveItem(Self); // I3933 - TDebugManager.WriteMessage('TLangSwitchKeyboard_WinKeyboard.Activate hwnd=%x keyboard=%x', [hwnd, FHKL]); // I4674 + TDebugLogClient.Instance.WriteMessage('TLangSwitchKeyboard_WinKeyboard.Activate hwnd=%x keyboard=%x', [hwnd, FHKL]); // I4674 PostMessage(hwnd, wm_keyman_control_internal, KMCI_SELECTKEYBOARD, FHKL); // I3933 end; @@ -773,7 +773,7 @@ begin FManager.SetActiveItem(Self); // I3933 s := IntToStr(FProfile.langid) + '|' + GUIDToString(TGUID(FProfile.clsid)) + '|' + GUIDToString(TGUID(FProfile.guidProfile)); FAtom := GlobalAddAtom(PChar(s)); - TDebugManager.WriteMessage('TLangSwitchKeyboard_TIP.Activate hwnd=%x keyboard=%s', [hwnd, s]); // I4674 + TDebugLogClient.Instance.WriteMessage('TLangSwitchKeyboard_TIP.Activate hwnd=%x keyboard=%s', [hwnd, s]); // I4674 PostMessage(hwnd, wm_keyman_control_internal, KMCI_SELECTKEYBOARD_TSF, FAtom); // I3933 end; diff --git a/windows/src/engine/keyman/langswitch/UfrmLanguageSwitch.pas b/windows/src/engine/keyman/langswitch/UfrmLanguageSwitch.pas index 820dce8971..c927ceae1a 100644 --- a/windows/src/engine/keyman/langswitch/UfrmLanguageSwitch.pas +++ b/windows/src/engine/keyman/langswitch/UfrmLanguageSwitch.pas @@ -146,7 +146,7 @@ implementation uses System.Math, - DebugManager, + Keyman.System.DebugLogClient, KeymanControlMessages, keymanapi_TLB, UfrmKeyman7Main, @@ -261,7 +261,7 @@ procedure TfrmLanguageSwitch.FormKeyDown(Sender: TObject; var Key: Word; end; begin - TDebugManager.WriteMessage('TfrmLanguageSwitch.FormKeyDown ENTER: %d [%d %d]', [Key, FSelectedLanguage, FSelectedKeyboard]); + TDebugLogClient.Instance.WriteMessage('TfrmLanguageSwitch.FormKeyDown ENTER: %d [%d %d]', [Key, FSelectedLanguage, FSelectedKeyboard]); try if FSelectedLanguage = -1 then FSelectedLanguage := 0; if FSelectedKeyboard = -1 then FSelectedKeyboard := 0; @@ -362,7 +362,7 @@ begin EndCanvas; end; finally - TDebugManager.WriteMessage('TfrmLanguageSwitch.FormKeyDown EXIT: %d [%d %d]', [Key, FSelectedLanguage, FSelectedKeyboard]); + TDebugLogClient.Instance.WriteMessage('TfrmLanguageSwitch.FormKeyDown EXIT: %d [%d %d]', [Key, FSelectedLanguage, FSelectedKeyboard]); end; Key := 0; end; @@ -389,7 +389,7 @@ begin DrawLayer; // I2677 - TDebugManager.WriteMessage('TfrmLanguageSwitch.FormShow EXIT: [%d %d]', [FSelectedLanguage, FSelectedKeyboard]); + TDebugLogClient.Instance.WriteMessage('TfrmLanguageSwitch.FormShow EXIT: [%d %d]', [FSelectedLanguage, FSelectedKeyboard]); end; procedure TfrmLanguageSwitch.GetColors(y: Integer; var cc: array of Cardinal); diff --git a/windows/src/engine/keyman32/K32_DBG.CPP b/windows/src/engine/keyman32/K32_DBG.CPP index 3dd35f3db1..067751fc35 100644 --- a/windows/src/engine/keyman32/K32_DBG.CPP +++ b/windows/src/engine/keyman32/K32_DBG.CPP @@ -46,24 +46,33 @@ #include "keyman64.h" #include #include +#include + +#include "keyman-debug-etw.h" //#define _FILELOG #ifdef _WIN64 #define DEBUG_PLATFORM_STRING "x64" +#define DEBUG_PLATFORM_STRINGW L"x64" #else #define DEBUG_PLATFORM_STRING "x86" +#define DEBUG_PLATFORM_STRINGW L"x86" #endif #ifdef _FILELOG //FILE *fp = NULL; #endif +// {DA621615-E08B-4283-918E-D2502D3757AE} +static const GUID guid_EtwProviderId = +{ 0xda621615, 0xe08b, 0x4283, { 0x91, 0x8e, 0xd2, 0x50, 0x2d, 0x37, 0x57, 0xae } }; + + enum {NO_DEBUG_WINDOWS=100, UNABLE_TO_CREATE_FILE_MAPPING, UNABLE_TO_MAP_VIEW_OF_FILE}; extern void GetWindowsVersion(char *buf); -void InitDebuggingEx(PKEYMAN64THREADDATA _td) -{ +void InitDebuggingEx(PKEYMAN64THREADDATA _td) { RegistryReadOnly reg(HKEY_CURRENT_USER); if(reg.OpenKeyReadOnly(REGSZ_KeymanCU)) { _td->debug_KeymanLog = reg.ValueExists(REGSZ_Debug) && reg.ReadInteger(REGSZ_Debug); @@ -75,55 +84,15 @@ void InitDebuggingEx(PKEYMAN64THREADDATA _td) } - if(_td->debug_KeymanLog) - { - if(_td->debug_hLogMailSlot != 0 && _td->debug_hLogMailSlot != INVALID_HANDLE_VALUE) - CloseHandle(_td->debug_hLogMailSlot); - - _td->debug_hLogMailSlot = CreateFile("\\\\.\\mailslot\\Tavultesoft_KeymanEngine_Debug", - GENERIC_WRITE, - FILE_SHARE_READ | FILE_SHARE_WRITE, // required to write to a mailslot - (LPSECURITY_ATTRIBUTES) NULL, - OPEN_EXISTING, - FILE_FLAG_OVERLAPPED | FILE_ATTRIBUTE_NORMAL, - (HANDLE) NULL); - - if(_td->debug_hLogEvent) CloseHandle(_td->debug_hLogEvent); - _td->debug_hLogEvent = CreateEvent(NULL, FALSE, FALSE, "Tavultesoft_KeymanEngine_DebugWrite"); - - /* - FILE *fp = fopen("c:\\keyman.log", "at"); - fprintf(fp, "opening log %d (error=%d)\n", hLogMailSlot, GetLastError()); - fclose(fp);*/ - -#ifdef _FILELOG - char filenamebuf[256]; - wsprintf(filenamebuf, "c:\\keymanlog\\system-%d-%d.log", GetCurrentProcessId(), GetCurrentThreadId()); - _td->debug_fp = (void*) fopen(filenamebuf, "at"); -#endif - - if (_td->debug_hLogMailSlot == INVALID_HANDLE_VALUE) - { - _td->debug_hLogMailSlot = 0; - } - } - else - { - if(_td->debug_hLogMailSlot != 0) CloseHandle(_td->debug_hLogMailSlot); - _td->debug_hLogMailSlot = 0; - if(_td->debug_hLogEvent) CloseHandle(_td->debug_hLogEvent); - _td->debug_hLogEvent = 0; + if(_td->debug_KeymanLog) { + DWORD dwErr = EventRegister(&guid_EtwProviderId, NULL, NULL, &_td->etwRegHandle); + if (dwErr != ERROR_SUCCESS) { + OutputDebugString("Keyman k32_dbg: Failed to EventRegister");//TODO: Build a helper function with GLE? + } } } -inline void TestInitDebug(PKEYMAN64THREADDATA _td) -{ - if(!_td->debug_DebugInit) InitDebuggingEx(_td); - _td->debug_DebugInit = TRUE; -} - -void InitDebugging() -{ +void InitDebugging() { PKEYMAN64THREADDATA _td = ThreadGlobals(); if(!_td) return; @@ -164,30 +133,26 @@ void UninitDebuggingEx() PKEYMAN64THREADDATA _td = ThreadGlobals(); if(!_td) return; - if(_td->debug_hLogMailSlot) CloseHandle(_td->debug_hLogMailSlot); - _td->debug_hLogMailSlot = 0; - if(_td->debug_hLogEvent) CloseHandle(_td->debug_hLogEvent); - _td->debug_hLogEvent = 0; -#ifdef _FILELOG - if(_td->debug_fp) fclose((FILE*)_td->debug_fp); - _td->debug_fp = NULL; -#endif + if (_td->etwRegHandle != NULL) { + EventUnregister(_td->etwRegHandle); + _td->etwRegHandle = NULL; + } + _td->debug_DebugInit = FALSE; } -void UninitDebugging() -{ +void UninitDebugging() { SendDebugMessage(0, sdmGlobal, 0, "--- UninitDebugging() - shutting down ---"); } const TSDMState DebugState[] = {sdmInternat, sdmAIDefault, sdmMessage, sdmKeyboard, sdmGlobal, sdmMenu, sdmDebug, sdmLoad, sdmOther}; -BOOL ShouldDebug_1() //TSDMState state) -{ +BOOL ShouldDebug_1() { PKEYMAN64THREADDATA _td = ThreadGlobals(); if(!_td) return FALSE; - TestInitDebug(_td); + if (!_td->debug_DebugInit) InitDebuggingEx(_td); + _td->debug_DebugInit = TRUE; return _td->debug_KeymanLog; } @@ -245,47 +210,38 @@ int SendDebugMessage_1(HWND hwnd, TSDMState state, int kmn_lineno, char *file, i { UNREFERENCED_PARAMETER(hwnd); UNREFERENCED_PARAMETER(state); // I3569 + UNREFERENCED_PARAMETER(kmn_lineno); PKEYMAN64THREADDATA _td = ThreadGlobals(); if(!_td) return 0; - if(_td->debug_KeymanLog) - { - OVERLAPPED ov; - DWORD cbWritten; - char windowinfo[1024]; + if (msg == NULL) { + return 0; + } - if(msg == NULL) - { - switch(kmn_lineno) - { - case -1: // Signal an event to the controller - strcpy(windowinfo, "*"); - break; - } - } - else - { - GUITHREADINFO gti; - char - //sClassName[32], sWindowText[32], - //sFocusClassName[32], sFocusWindowText[32], - //sActiveClassName[32], sActiveWindowText[32], - sProcessPath[256], sProcessName[32]; + if(_td->debug_KeymanLog) { + GUITHREADINFO gti; + char + //sClassName[32], sWindowText[32], + //sFocusClassName[32], sFocusWindowText[32], + //sActiveClassName[32], sActiveWindowText[32], + sProcessPath[256], sProcessName[32]; - gti.cbSize = sizeof(gti); - GetGUIThreadInfo(GetCurrentThreadId(), >i); + gti.cbSize = sizeof(gti); + GetGUIThreadInfo(GetCurrentThreadId(), >i); - //FillWindowInfo(hwnd, sClassName, sWindowText); // I3656 - //FillWindowInfo(gti.hwndActive, sActiveClassName, sActiveWindowText); // I3656 - //FillWindowInfo(gti.hwndFocus, sFocusClassName, sFocusWindowText); // I3656 + //FillWindowInfo(hwnd, sClassName, sWindowText); // I3656 + //FillWindowInfo(gti.hwndActive, sActiveClassName, sActiveWindowText); // I3656 + //FillWindowInfo(gti.hwndFocus, sFocusClassName, sFocusWindowText); // I3656 - GetModuleFileName(NULL, sProcessPath, 256); - _splitpath_s(sProcessPath, NULL, 0, NULL, 0, sProcessName, 32, NULL, 0); - sProcessName[31] = 0; + GetModuleFileName(NULL, sProcessPath, 256); + _splitpath_s(sProcessPath, NULL, 0, NULL, 0, sProcessName, 32, NULL, 0); + sProcessName[31] = 0; - if(strlen(msg) > 256) msg[255] = 0; + if(strlen(msg) > 256) msg[255] = 0; - wsprintf(windowinfo, + if(_td->debug_ToConsole) { // I3951 + char windowinfo[1024]; + wsprintf(windowinfo, DEBUG_PLATFORM_STRING TAB //"Platform" TAB "%s" TAB //"Process" TAB "%x" TAB //"PID" TAB @@ -309,7 +265,7 @@ int SendDebugMessage_1(HWND hwnd, TSDMState state, int kmn_lineno, char *file, i "%8x" TAB //"ActiveHKL" TAB "%s:%d" TAB //"SourceFile" TAB "%s", //"Message" - + sProcessName, //"Process" TAB GetCurrentProcessId(), //"PID" TAB GetCurrentThreadId(), //"TID" TAB @@ -337,46 +293,53 @@ int SendDebugMessage_1(HWND hwnd, TSDMState state, int kmn_lineno, char *file, i GetKeyboardLayout(0), //"ActiveHKL" TAB file, line, //"SourceFile" TAB msg); //"Message" - } -#ifdef _FILELOG - if(_td->debug_fp) - { - fputs(windowinfo, (FILE*)_td->debug_fp); - fputs("\n", (FILE*)_td->debug_fp); - } -#endif - if(_td->debug_ToConsole) { // I3951 + OutputDebugString(windowinfo); // I3570 // I3951 OutputDebugString("\n"); // I3570 // I3951 } - if(_td->debug_hLogMailSlot != 0) - { - ov.Offset = 0; - ov.OffsetHigh = 0; - ov.hEvent = _td->debug_hLogEvent; - if(!WriteFile(_td->debug_hLogMailSlot, - windowinfo, - (DWORD) strlen(windowinfo) + 1, // include terminating null - &cbWritten, - &ov)) - { - switch(GetLastError()) // I2445 - Try and reconnect debug pipe on error - { - case ERROR_HANDLE_EOF: - case ERROR_BROKEN_PIPE: - UninitDebuggingEx(); - InitDebuggingEx(_td); - if(WriteFile(_td->debug_hLogMailSlot, - windowinfo, - (DWORD) strlen(windowinfo) + 1, // include terminating null - &cbWritten, - &ov)) break; - default: - UninitDebuggingEx(); - _td->debug_KeymanLog = FALSE; /// Failed again - we could log to system log I guess - } + if (_td->etwRegHandle != NULL) { +#define MAX_DESCRIPTORS 12 + + // TODO: convert debugging to Unicode + PWSTR sProcessNameW = strtowstr(sProcessName); + PWSTR fileW = strtowstr(file); + PWSTR msgW = strtowstr(msg); + EVENT_DATA_DESCRIPTOR Descriptors[MAX_DESCRIPTORS]; + DWORD pid = GetCurrentProcessId(); + DWORD tid = GetCurrentThreadId(); + DWORD shiftState = Globals::get_ShiftState(); + DWORD actualShiftState = GetActualShiftState(); + DWORD tickCount = GetTickCount(); + HKL activeHKL = GetKeyboardLayout(0); + +#ifdef _WIN64 + DWORD platform = 2; +#else + DWORD platform = 1; +#endif + + // These must match the manifest template in keyman-debug-etw.man + EventDataDescCreate(&Descriptors[0], &platform, sizeof(DWORD)); // + EventDataDescCreate(&Descriptors[1], sProcessNameW, (ULONG) (wcslen(sProcessNameW) + 1) * sizeof(WCHAR)); // + EventDataDescCreate(&Descriptors[2], &pid, sizeof(DWORD)); // + EventDataDescCreate(&Descriptors[3], &tid, sizeof(DWORD)); // + EventDataDescCreate(&Descriptors[4], &shiftState, sizeof(DWORD)); // + EventDataDescCreate(&Descriptors[5], &actualShiftState, sizeof(DWORD)); // + EventDataDescCreate(&Descriptors[6], &tickCount, sizeof(DWORD)); // + EventDataDescCreate(&Descriptors[7], (PDWORD)>i.hwndFocus, sizeof(DWORD)); // + EventDataDescCreate(&Descriptors[8], (PDWORD)&activeHKL, sizeof(DWORD)); // + EventDataDescCreate(&Descriptors[9], fileW, (ULONG) (wcslen(fileW)+1) * sizeof(WCHAR)); // + EventDataDescCreate(&Descriptors[10], (PDWORD)&line, sizeof(DWORD)); // + EventDataDescCreate(&Descriptors[11], msgW, (ULONG) (wcslen(msgW)+1) * sizeof(WCHAR)); // + + DWORD dwErr = EventWrite(_td->etwRegHandle, &DebugEvent, (ULONG)MAX_DESCRIPTORS, &Descriptors[0]); + if (dwErr != ERROR_SUCCESS) { + OutputDebugString("Keyman k32_dbg: Failed to call EventWrite"); } + delete sProcessNameW; + delete fileW; + delete msgW; } } diff --git a/windows/src/engine/keyman32/Keyman32.vcxproj b/windows/src/engine/keyman32/Keyman32.vcxproj index 0df1e6d7eb..3d7e089184 100644 --- a/windows/src/engine/keyman32/Keyman32.vcxproj +++ b/windows/src/engine/keyman32/Keyman32.vcxproj @@ -342,11 +342,24 @@ + + Document + false + false + mc %(FullPath) + Compiling keyman-debug-etw + %(Filename).rc;%(Filename.h);MSG00001.bin + mc %(FullPath) + Compiling keyman-debug-etw + %(Filename).rc;%(Filename.h);MSG00001.bin + Designer + + %(PreprocessorDefinitions) %(PreprocessorDefinitions) @@ -368,6 +381,7 @@ + diff --git a/windows/src/engine/keyman32/Keyman32.vcxproj.filters b/windows/src/engine/keyman32/Keyman32.vcxproj.filters index 57bef006b2..ccd2d0a708 100644 --- a/windows/src/engine/keyman32/Keyman32.vcxproj.filters +++ b/windows/src/engine/keyman32/Keyman32.vcxproj.filters @@ -136,6 +136,9 @@ Source Files + + Source Files + @@ -204,5 +207,11 @@ Header Files + + Header Files + + + + \ No newline at end of file diff --git a/windows/src/engine/keyman32/globals.h b/windows/src/engine/keyman32/globals.h index 0da5f9147d..aa8cb726cd 100644 --- a/windows/src/engine/keyman32/globals.h +++ b/windows/src/engine/keyman32/globals.h @@ -52,6 +52,8 @@ #ifndef _globals_h #define _globals_h +#include + #define GLOBAL_ContextStackSize 80 #define GLOBAL_MsgStackSize 80 #define GLOBAL_MaxKeyboards 32 @@ -216,13 +218,12 @@ typedef struct tagKEYMAN64THREADDATA int CurrentAddin; HWND CurrenthWnd; - void *debug_fp; - HANDLE debug_hLogMailSlot, debug_hLogEvent; BOOL debug_DebugInit, debug_KeymanLog, debug_ToConsole; // I3951 char debug_buf[64]; // I3617 // I3618 + REGHANDLE etwRegHandle; /* TSF Manager Globals */ diff --git a/windows/src/engine/keyman32/keyman-debug-etw.man b/windows/src/engine/keyman32/keyman-debug-etw.man new file mode 100644 index 0000000000..d327247f10 --- /dev/null +++ b/windows/src/engine/keyman32/keyman-debug-etw.man @@ -0,0 +1,111 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + \ No newline at end of file diff --git a/windows/src/engine/keyman64/keyman64.vcxproj b/windows/src/engine/keyman64/keyman64.vcxproj index 7c3913e012..d784ceedf2 100644 --- a/windows/src/engine/keyman64/keyman64.vcxproj +++ b/windows/src/engine/keyman64/keyman64.vcxproj @@ -298,6 +298,7 @@ + @@ -325,6 +326,7 @@ + @@ -344,6 +346,25 @@ + + false + Document + false + false + false + mc %(FullPath) + %(Filename).rc;%(Filename).h;MSG00001.bin + mc %(FullPath) + %(Filename).rc;%(Filename).h;MSG00001.bin + mc %(FullPath) + %(Filename).rc;%(Filename).h;MSG00001.bin + mc %(FullPath) + %(Filename).rc;%(Filename).h;MSG00001.bin + Compiling %(Filename).man + Compiling %(Filename).man + Compiling %(Filename).man + Compiling %(Filename).man + diff --git a/windows/src/engine/keyman64/keyman64.vcxproj.filters b/windows/src/engine/keyman64/keyman64.vcxproj.filters index c807c634b1..04bde3ac9e 100644 --- a/windows/src/engine/keyman64/keyman64.vcxproj.filters +++ b/windows/src/engine/keyman64/keyman64.vcxproj.filters @@ -113,6 +113,9 @@ Source Files + + Source Files + @@ -232,6 +235,9 @@ Header Files + + Source Files + @@ -240,5 +246,8 @@ Resource Files + + Source Files + \ No newline at end of file diff --git a/windows/src/engine/kmcomapi/kmcomapi.dpr b/windows/src/engine/kmcomapi/kmcomapi.dpr index f29b487960..2462e7d314 100644 --- a/windows/src/engine/kmcomapi/kmcomapi.dpr +++ b/windows/src/engine/kmcomapi/kmcomapi.dpr @@ -101,7 +101,6 @@ uses utildir in '..\..\global\delphi\general\utildir.pas', utiltsf in '..\..\global\delphi\general\utiltsf.pas', OnlineConstants in '..\..\global\delphi\productactivation\OnlineConstants.pas', - SystemDebugPath in '..\..\global\delphi\general\SystemDebugPath.pas', MessageDefaults in '..\..\global\delphi\cust\MessageDefaults.pas', MessageIdentifierConsts in '..\..\global\delphi\cust\MessageIdentifierConsts.pas', KeymanEngineControl in '..\..\global\delphi\general\KeymanEngineControl.pas', diff --git a/windows/src/engine/kmcomapi/kmcomapi.dproj b/windows/src/engine/kmcomapi/kmcomapi.dproj index 9f79ae9c1a..bcbc444e56 100644 --- a/windows/src/engine/kmcomapi/kmcomapi.dproj +++ b/windows/src/engine/kmcomapi/kmcomapi.dproj @@ -238,7 +238,6 @@ - diff --git a/windows/src/engine/tsysinfo/tsysinfo.dpr b/windows/src/engine/tsysinfo/tsysinfo.dpr index 4babfd5905..2f81bbd891 100644 --- a/windows/src/engine/tsysinfo/tsysinfo.dpr +++ b/windows/src/engine/tsysinfo/tsysinfo.dpr @@ -31,7 +31,6 @@ uses klog in '..\..\global\delphi\general\klog.pas', utildir in '..\..\global\delphi\general\utildir.pas', utilsystem in '..\..\global\delphi\general\utilsystem.pas', - SystemDebugPath in '..\..\global\delphi\general\SystemDebugPath.pas', ErrorControlledRegistry in '..\..\global\delphi\vcl\ErrorControlledRegistry.pas', Unicode in '..\..\global\delphi\general\Unicode.pas', utilexecute in '..\..\global\delphi\general\utilexecute.pas', diff --git a/windows/src/engine/tsysinfo/tsysinfo.dproj b/windows/src/engine/tsysinfo/tsysinfo.dproj index 3a884167a7..6cd10172b7 100644 --- a/windows/src/engine/tsysinfo/tsysinfo.dproj +++ b/windows/src/engine/tsysinfo/tsysinfo.dproj @@ -7,7 +7,7 @@ 1 Application VCL - 18.3 + 18.4 Win32 @@ -175,7 +175,6 @@ - diff --git a/windows/src/ext/jedi/jwa/branches/2.3/Win32API/JwaEventTracing.pas b/windows/src/ext/jedi/jwa/branches/2.3/Win32API/JwaEventTracing.pas index 36f324f8e5..2b2113e814 100644 --- a/windows/src/ext/jedi/jwa/branches/2.3/Win32API/JwaEventTracing.pas +++ b/windows/src/ext/jedi/jwa/branches/2.3/Win32API/JwaEventTracing.pas @@ -2001,7 +2001,7 @@ function FlushTrace; external advapi32 name 'FlushTrace'+AWSuffix; {$ENDIF WINXP_UP} function ControlTraceW; external advapi32 name 'ControlTraceW'; function ControlTraceA; external advapi32 name 'ControlTraceA'; -function ControlTrace; external advapi32 name 'ControlTraceA'+AWSuffix; +function ControlTrace; external advapi32 name 'ControlTrace'+AWSuffix; function QueryAllTracesW; external advapi32 name 'QueryAllTracesW'; function QueryAllTracesA; external advapi32 name 'QueryAllTracesA'; diff --git a/windows/src/global/delphi/debug/DebugManager.pas b/windows/src/global/delphi/debug/DebugManager.pas deleted file mode 100644 index 3639895d79..0000000000 --- a/windows/src/global/delphi/debug/DebugManager.pas +++ /dev/null @@ -1,643 +0,0 @@ -(* - Name: DebugManager - Copyright: Copyright (C) SIL International. - Documentation: - Description: - Create Date: 14 Sep 2006 - - Modified Date: 9 Aug 2015 - Authors: mcdurdin - Related Files: - Dependencies: - - Bugs: - Todo: - Notes: - History: 14 Sep 2006 - mcdurdin - Initial version - 04 Jan 2007 - mcdurdin - Add ShouldDebug function - 19 Jun 2007 - mcdurdin - Widestring it - 19 Nov 2007 - mcdurdin - I1157 - const string parameters - 04 May 2010 - mcdurdin - I2348 - Rework columns in debug log - 04 May 2010 - mcdurdin - I2349 - Hotkey to capture debug log - 04 May 2010 - mcdurdin - I2350 - Keyman.exe should be able to report events in debug log - 04 May 2010 - mcdurdin - I2352 - Debug logging not reliable in some apps due to security - 15 Jun 2010 - mcdurdin - I2423 - Fix crash in debug manager - 24 Jun 2010 - mcdurdin - I2422 - Recreate, not rewrite existing log files - 29 Jun 2010 - mcdurdin - I2446 - Keyman Engine crashes due to debug manager being freed late - 17 Dec 2010 - mcdurdin - Add extra column to raw strings - 11 Jan 2011 - mcdurdin - I2640 - Raise error at appropriate location so it isn't masked by cascading issue - 31 Jan 2011 - mcdurdin - I2685 - Reduce registry noise from ShouldDebug function - 31 Jan 2011 - mcdurdin - I2690 - Add foreground window info to debug log - 31 Jan 2011 - mcdurdin - I2691 - Fix handle leaks - 18 Feb 2011 - mcdurdin - I2685 : 9827 - Fix shoulddebug refresh counter not resetting - 03 May 2011 - mcdurdin - I2890 - Record diagnostic data when encountering registry errors - 18 May 2012 - mcdurdin - I3306 - V9.0 - Remove TntControls + Win9x support - 08 Jun 2012 - mcdurdin - I3310 - V9.0 - Unicode in Delphi fixes - 28 Nov 2012 - mcdurdin - I3601 - V9.0 - Debug messages were written partially Unicode, partially ANSI - 13 Dec 2012 - mcdurdin - I3656 - V9.0 - Debug logs show too many columns for host messages - 01 Jan 2013 - mcdurdin - I3692 - V9.0 - [host] entries in system.log out by 1 tabstop - 09 Aug 2015 - mcdurdin - I4843 - Log reported modifier state as well as Keyman current modifier state -*) -unit DebugManager; // I3306 - -interface - -uses - Windows, - Classes, - SysUtils, - UserMessages; - -type - TDebugManagerMessageEvent = procedure(Sender: TObject; const Message: string) of object; - - TDebugManager = class(TThread) - private - FOwner: HWND; - hLogFile, hMailSlot: THandle; - hEvent: THandle; - FDebugLogIndex: Integer; - FOnMessage: TDebugManagerMessageEvent; - - const - crlf: AnsiString = #13#10; - - procedure WriteHeadingString; - procedure WriteMessage(buf: PAnsiChar; buflen: Integer); overload; // I3310 - procedure StartNewLogFile; - procedure FindFirstLogFileName; - protected - procedure Execute; override; - - class procedure CloseLogFile(var Handle: THandle); - class procedure WriteString(Handle: THandle; const s: string); - class procedure WriteMessage(Handle: THandle; buf: PAnsiChar; buflen: Integer); overload; // I3310 - class procedure WriteRawString(Handle: THandle; const s: string); static; - public - constructor Create(AOwner: HWND); reintroduce; - destructor Destroy; override; - - class procedure WriteLastError(const ParentMethod, FailingMethod: string; const Message: string = ''); - class procedure WriteMessage(const Format: string; const Args: array of const); overload; - - - class function DebugLogFileName(n: Integer): WideString; - - property OnMessage: TDebugManagerMessageEvent read FOnMessage write FOnMessage; - end; - -function GetDebugManager(AOwner: HWND): TDebugManager; - -implementation - -uses - Accctrl, - AclApi, - ErrorControlledRegistry, - RegistryKeys, - SystemDebugPath, - Unicode; - -var - FDebugManager: TDebugManager = nil; - FTerminating: Boolean = False; - - FShouldDebug: Boolean = False; - FShouldDebugLastTick: Cardinal = 0; - -function ShouldDebug: Boolean; -var - t1: Cardinal; -begin - t1 := GetTickCount; - if (t1 < FShouldDebugLastTick) or (t1 - FShouldDebugLastTick > 5000) then // I2685 - begin - with TRegistryErrorControlled.Create do // I2890 - try - if OpenKeyReadOnly(SRegKey_KeymanEngine_CU) and ValueExists(SRegValue_KeymanDebug) - then FShouldDebug := ReadBool(SRegValue_KeymanDebug) - else FShouldDebug := False; - finally - Free; - end; - FShouldDebugLastTick := GetTickCount; // I2685:9827 - end; - - Result := FShouldDebug; -end; - -function GetDebugManager(AOwner: HWND): TDebugManager; -begin - Assert(not FTerminating); - - if ShouldDebug then - begin - if not Assigned(FDebugManager) then - FDebugManager := TDebugManager.Create(AOwner); - Result := FDebugManager; - end - else - Result := nil; -end; - -{ TDebugManager } - -class procedure TDebugManager.CloseLogFile(var Handle: THandle); -begin - if Handle <> 0 then - begin - WriteString(Handle, '---- Log file closed '+FormatDateTime('C', now) + '----'); - CloseHandle(Handle); - Handle := 0; - end; -end; - - -const LOW_INTEGRITY_SDDL_SACL_W: WideString = 'S:(ML;;NW;;;LW)'; -const LABEL_SECURITY_INFORMATION = $00000010; -const SDDL_REVISION_1 = 1; - -function ConvertStringSecurityDescriptorToSecurityDescriptor( - {IN} StringSecurityDescriptor: LPCWSTR; - {IN} StringSDRevision: DWORD; - {OUT} var SecurityDescriptor: PSECURITY_DESCRIPTOR; - {OUT} SecurityDescriptorSize: PULONG {OPTIONAL} - ): BOOL; stdcall; external 'advapi32.dll' name 'ConvertStringSecurityDescriptorToSecurityDescriptorW'; - -function SetObjectToLowIntegrity(hObject: THandle; _type: SE_OBJECT_TYPE = SE_KERNEL_OBJECT): BOOL; -var - dwErr: DWORD; - pSD: PSECURITY_DESCRIPTOR; - pSacl: PACL; - fSaclPresent: BOOL; - fSaclDefaulted: BOOL; -begin - //BOOL bRet = FALSE; - //dwErr := ERROR_SUCCESS; - Result := False; - - pSD := nil; - pSacl := nil; - fSaclPresent := FALSE; - fSaclDefaulted := FALSE; - - if LOBYTE(LOWORD(GetVersion())) >= 6 then - begin - if ConvertStringSecurityDescriptorToSecurityDescriptor(PWideChar(LOW_INTEGRITY_SDDL_SACL_W), SDDL_REVISION_1, pSD, nil) then - begin - if GetSecurityDescriptorSacl(pSD, fSaclPresent, pSacl, fSaclDefaulted) then - begin - dwErr := SetSecurityInfo( - hObject, _type, LABEL_SECURITY_INFORMATION, - nil, nil, nil, pSacl); - Result := ERROR_SUCCESS = dwErr; - end; - end; - - LocalFree(Cardinal(pSD)); - end - else - Result := True; -end; - -constructor TDebugManager.Create(AOwner: HWND); -const - lpszSlotName: string = '\\.\mailslot\tavultesoft_keymanengine_debug'; -var - pSD: PSECURITY_DESCRIPTOR; - //sd: SECURITY_DESCRIPTOR; - sa: SECURITY_ATTRIBUTES; - //bSaclPresent: LongBool; - //pSacl: PACL; - //bSaclDefaulted: LongBool; - //fSaclPresent: LongBool; -begin - FOwner := AOwner; - - if LOBYTE(LOWORD(GetVersion())) >= 6 then - begin - if ConvertStringSecurityDescriptorToSecurityDescriptor(PWideChar(LOW_INTEGRITY_SDDL_SACL_W), SDDL_REVISION_1, pSD, nil) then - begin - sa.nLength := sizeof(sa); - sa.lpSecurityDescriptor := pSD; - sa.bInheritHandle := FALSE; - - hMailSlot := CreateMailslot(PChar(lpszSlotName), - 0, // no maximum message size - 10, // 10 msec time-out for operations - @sa); - if hMailSlot = INVALID_HANDLE_VALUE then RaiseLastOSError; // I2640 - Raise error at appropriate location so it isn't masked by cascading issue - - // For some reason the mailslot does not have full access for everyone so we need to set it afterwards anyway! - if SetSecurityInfo(hMailSlot, SE_KERNEL_OBJECT, DACL_SECURITY_INFORMATION, nil, nil, nil, nil) <> ERROR_SUCCESS then - RaiseLastOSError; - - LocalFree(Cardinal(pSD)); - end - else RaiseLastOSError; - end - else - begin - hMailSlot := CreateMailslot(PChar(lpszSlotName), - 0, // no maximum message size - 10, // 10 msec time-out for operations - nil); - if hMailSlot = INVALID_HANDLE_VALUE then RaiseLastOSError; - end; - - try - FindFirstLogFileName; - StartNewLogFile; - - try - hEvent := CreateEvent(nil, FALSE, FALSE, 'Tavultesoft_KeymanEngine_Debug'); - if hEvent = 0 then RaiseLastOSError; - if not SetObjectToLowIntegrity(hEvent) then RaiseLastOSError; - - try - SetFilePointer(hLogFile, 0, nil, FILE_END); - - FreeOnTerminate := False; // I2446 - Keyman Engine crashes due to debug manager being freed late - inherited Create(False); - except - on E:Exception do - begin - CloseHandle(hEvent); - hEvent := 0; - raise; - end; - end; - except - on E:Exception do - begin - CloseHandle(hLogFile); - hLogFile := 0; - raise; - end; - end; - except - on E:Exception do - begin - CloseHandle(hMailSlot); - hMailSlot := 0; - raise; - end; - end; -end; - -destructor TDebugManager.Destroy; -begin - CloseLogFile(hLogFile); - if hMailSlot <> 0 then CloseHandle(hMailSlot); - if hEvent <> 0 then CloseHandle(hEvent); - inherited Destroy; -end; - -const - MAXDEBUGLOGS = 16; - -class function TDebugManager.DebugLogFileName(n: Integer): WideString; -begin - Result := GetSystemDebugPath + 'system' + IntToStr(n) + '.log'; -end; - -procedure TDebugManager.FindFirstLogFileName; -var - FSelectedTime: TDateTime; - i: Integer; - f: TSearchRec; -begin - FSelectedTime := MaxDateTime; - FDebugLogIndex := 0; - - for i := 0 to MAXDEBUGLOGS - 1 do - begin - if FindFirst(DebugLogFileName(i), 0, f) = 0 then - begin - if f.TimeStamp < FSelectedTime then - begin - FDebugLogIndex := i; - FSelectedTime := f.TimeStamp; - end; - FindClose(f); - end - else - begin - FDebugLogIndex := i; - Break; - end; - end; - - Dec(FDebugLogIndex); // It will be immediately incremented by StartNewLogFile -end; - -procedure TDebugManager.StartNewLogFile; -var - FDebugLogFileName: WideString; -begin - if hLogFile <> 0 then - CloseHandle(hLogFile); - - Inc(FDebugLogIndex); - if FDebugLogIndex > MAXDEBUGLOGS then - FDebugLogIndex := 0; - - FDebugLogFileName := 'system' + IntToStr(FDebugLogIndex) + '.log'; - - hLogFile := CreateFile(PChar(DebugLogFileName(FDebugLogIndex)), GENERIC_READ or GENERIC_WRITE, FILE_SHARE_READ, nil, CREATE_ALWAYS, 0, 0); - if hLogFile = INVALID_HANDLE_VALUE then RaiseLastOSError; - - WriteHeadingString; -end; - -procedure TDebugManager.Execute; -var - szBuffer, cbMessage, cMessage, cbRead: DWord; - lpszBuffer: PAnsiChar; // I3310 - ov: TOverlapped; -begin - // - try - cbMessage := 0; - cMessage := 0; - cbRead := 0; - szBuffer := 0; - lpszBuffer := nil; - - ov.Offset := 0; - ov.OffsetHigh := 0; - ov.hEvent := hEvent; - - try - repeat - if not GetMailslotInfo(hMailSlot, // mailslot handle - nil, // no maximum message size - cbMessage, // size of next message - @cMessage, // number of messages - nil) then // no read time-out - RaiseLastOSError; - - if cbMessage = MAILSLOT_NO_MESSAGE then { Sleep 10 msec } - begin - Sleep(10); - Continue; - end; - - while (cMessage > 0) and not Terminated do // retrieve all messages - begin - if szBuffer < cbMessage then - begin - if Assigned(lpszBuffer) then FreeMem(lpszBuffer); - lpszBuffer := AllocMem(cbMessage); - end; - if not Assigned(lpszBuffer) then - raise Exception.Create('Invalid buffer'); - - lpszBuffer^ := #0; - - if not ReadFile(hMailSlot, - lpszBuffer^, - cbMessage, - cbRead, - @ov) then - RaiseLastOSError; - - WriteMessage(lpszBuffer, cbRead - 1); // Ignore terminating nul - - // Concatenate the message and the message-number string. - - if not GetMailslotInfo(hMailSlot, // mailslot handle - nil, // no maximum message size - cbMessage, // size of next message - @cMessage, // number of messages - nil) then // no read time-out - RaiseLastOSError; - end; - until Terminated; - finally - if Assigned(lpszBuffer) then FreeMem(lpszBuffer); - end; - except - on E:Exception do - WriteString(hLogFile, '*** Exception '+E.ClassName+' in TDebugManager: '+E.Message); - end; -end; - -procedure TDebugManager.WriteHeadingString; -begin - WriteRawString(hLogFile, // I3656 - 'Platform' + #9 + - 'Process' + #9 + - 'PID' + #9 + - 'TID' + #9 + - //'QueueStatus' + #9 + - 'ShiftState' + #9 + - 'ActualShiftState' + #9 + // I4843 - 'TickCount' + #9 + - //'LogHWND' + #9 + - //'LogWindowClassName' + #9 + - //'LogWindowText' + #9 + - 'FocusHWND' + #9 + - //'FocusWindowClassName' + #9 + - //'FocusWindowText' + #9 + - //'ActiveHWND' + #9 + - //'ActiveWindowClassName' + #9 + - //'ActiveWindowText' + #9 + - //'ForegroundHWND' + #9 + // I2690 - //'MessageType' + #9 + - //'SourceLine' + #9 + - 'ActiveHKL' + #9 + - 'SourceFile' + #9 + - 'Message'); - WriteString(hLogFile, '---- Log file opened '+FormatDateTime('C', now) + '----'); -end; - -var - hLogMailSlot: THandle = 0; - hLogEvent: THandle = 0; - -class procedure TDebugManager.WriteLastError(const ParentMethod, FailingMethod: string; const Message: string = ''); -var - FLastError: DWord; - FLastErrorString: string; -begin - FLastError := GetLastError; - FLastErrorString := SysErrorMessage(GetLastError); - WriteMessage('ERROR %d in %s [%s]: %s %s', [FLastError, FailingMethod, ParentMethod, FLastErrorString, Message]); -end; - -class procedure TDebugManager.WriteMessage(const Format: string; - const Args: array of const); -var - bufa: ansistring; - buf: string; - ov: OVERLAPPED; - cbWritten: DWORD; - gti: TGUIThreadInfo; -begin - if not ShouldDebug then Exit; - - if hLogMailSlot = 0 then - begin - hLogMailSlot := CreateFile('\\.\mailslot\Tavultesoft_KeymanEngine_Debug', - GENERIC_WRITE, - FILE_SHARE_READ or FILE_SHARE_WRITE, // required to write to a mailslot - nil, - OPEN_EXISTING, - FILE_FLAG_OVERLAPPED or FILE_ATTRIBUTE_NORMAL, - 0); - - hLogEvent := CreateEvent(nil, False, False, 'Tavultesoft_KeymanEngine_DebugWrite'); - - if hLogMailSlot = 0 then Exit; - if hLogEvent = 0 then Exit; - end; - - gti.cbSize := SizeOf(TGUIThreadInfo); // I2690 - GetGUIThreadInfo(0, gti); - - buf := - SysUtils.Format( // I3656 - 'x86' + #9 + - 'keyman[host]' + #9 + - '%x' + #9 + - '%x' + #9 + - //'' + #9 + - '' + #9 + // shift state - '' + #9 + // actual shift state // I4843 - IntToStr(GetTickCount) + #9 + - //'' + #9 + - //'' + #9 + - //'' + #9 + - '%x' + #9 + - //'' + #9 + - //'' + #9 + - //'%x' + #9 + - //'' + #9 + - //'' + #9 + - //'%x' + #9 + - - //'' + #9 + - //'' + #9 + // I3692 - '' + #9 + - '' + #9, - [GetCurrentProcessId, - GetCurrentThreadId, - gti.hwndFocus - //gti.hwndActive, - {GetForegroundWindow}]) + - SysUtils.Format(Format, Args); - - ov.Offset := 0; - ov.OffsetHigh := 0; - ov.hEvent := hLogEvent; - - bufa := String_UtoA(buf); // I3601 - - WriteFile(hLogMailSlot, - bufa[1], // I3601 - Length(bufa) + 1, - cbWritten, - @ov); -end; - -procedure TDebugManager.WriteMessage(buf: PAnsiChar; buflen: Integer); // I3310 -var - Control: AnsiChar; // I3310 -begin - if (buflen > 0) then Control := buf[0] else Control := #0; - - if Control = '*' then - begin - if FOwner <> 0 then - begin - if PostMessage(FOwner, WM_USER_DebugNotify, FDebugLogIndex, hLogFile) then - hLogFile := 0; - end; - StartNewLogFile; - end - else - begin - if Assigned(FOnMessage) then - begin - FOnMessage(Self, string(Copy(buf, 1, buflen) + crlf)); - end; - - WriteMessage(hLogFile, buf, buflen); - end; -end; - -class procedure TDebugManager.WriteString(Handle: THandle; const s: string); -var - gti: TGUIThreadInfo; -begin - gti.cbSize := SizeOf(TGUIThreadInfo); - GetGUIThreadInfo(0, gti); // I2690 - - WriteRawString(Handle, // I3656 - SysUtils.Format( - 'x86' + #9 + - 'keyman[host]' + #9 + - '%x' + #9 + - '%x' + #9 + - //'' + #9 + - '' + #9 + // shift state - '' + #9 + // actual shift state // I4843 - IntToStr(GetTickCount) + #9 + - //'' + #9 + - //'' + #9 + - //'' + #9 + - '%x' + #9 + - //'' + #9 + - //'' + #9 + - //'%x' + #9 + - //'' + #9 + - //'' + #9 + - //'%x' + #9 + - - //'' + #9 + - //'' + #9 + // I3692 - '' + #9 + - '' + #9, - [GetCurrentProcessId, - GetCurrentThreadId, - gti.hwndFocus {, - gti.hwndActive, - GetForegroundWindow}]) + - s); -end; - -class procedure TDebugManager.WriteRawString(Handle: THandle; const s: string); -var - sa: AnsiString; // I3310 -begin - sa := String_UtoA(s); // I3310 - WriteMessage(Handle, PAnsiChar(sa), Length(sa)); -end; - -class procedure TDebugManager.WriteMessage(Handle: THandle; buf: PAnsiChar; buflen: Integer); // I3310 -var - n: DWord; -begin - if Handle = 0 then Exit; - - WriteFile(Handle, buf^, buflen, n, nil); - WriteFile(Handle, PAnsiChar(crlf)^, 2, n, nil); // I3601 -end; - -procedure CloseHandles; // I2691 -begin - if hLogEvent <> 0 then CloseHandle(hLogEvent); - if hLogMailSlot <> 0 then CloseHandle(hLogMailSlot); - hLogMailSlot := 0; - hLogEvent := 0; -end; - -initialization -finalization - FTerminating := True; - if Assigned(FDebugManager) then // I2446 - Keyman Engine crashes due to debug manager being freed late - FDebugManager.Terminate; - FreeAndNil(FDebugManager); - CloseHandles; // I2691 -end. diff --git a/windows/src/global/delphi/debug/Keyman.System.DebugLogClient.pas b/windows/src/global/delphi/debug/Keyman.System.DebugLogClient.pas new file mode 100644 index 0000000000..33e7998b2f --- /dev/null +++ b/windows/src/global/delphi/debug/Keyman.System.DebugLogClient.pas @@ -0,0 +1,141 @@ +unit Keyman.System.DebugLogClient; + +interface + +uses + Winapi.Windows, + JwaEventDefs, + JwaEventTracing, + JwaEvntProv; + +type + TDebugLogClient = class + private + FRegHandle: TRegHandle; + class var FInstance: TDebugLogClient; + public + constructor Create; + destructor Destroy; override; + procedure WriteLastError(const ParentMethod, FailingMethod: string; const Message: string = ''); + procedure WriteMessage(const Format: string; const Args: array of const); + + class function Instance: TDebugLogClient; + end; + +implementation + +uses + System.SysUtils, + + Keyman.System.DebugLogCommon; + +{ TDebugLogClient } + +const + // This comes from keyman-debug-etw.h. If the event descriptor is ever changed, + // then this needs to be updated. + DebugEvent: EVENT_DESCRIPTOR = ( + Id : $1; + Version : $0; + Channel : $10; + Level : $4; + Opcode : $0; + Task : $0; + Keyword : $8000000000000000 + ); + +constructor TDebugLogClient.Create; +var + status: ULONG; +begin + if ShouldDebug then + begin + status := EventRegister(@DebugLogProviderGuid, nil, nil, FRegHandle); + if ERROR_SUCCESS <> status then + begin + FRegHandle := 0; + RaiseLastOSError(status, 'EventRegister'); + end; + end; +end; + +destructor TDebugLogClient.Destroy; +var + status: ULONG; +begin + if FRegHandle <> 0 then + begin + status := EventUnregister(FRegHandle); + if ERROR_SUCCESS <> status then + OutputDebugString(PChar('EventUnregister failed with '+IntToStr(status))); + end; + + inherited Destroy; +end; + +class function TDebugLogClient.Instance: TDebugLogClient; +begin + if not Assigned(FInstance) then + FInstance := TDebugLogClient.Create; + + Result := FInstance; +end; + +procedure TDebugLogClient.WriteLastError(const ParentMethod, + FailingMethod, Message: string); +var + FLastError: DWord; + FLastErrorString: string; +begin + FLastError := GetLastError; + FLastErrorString := SysErrorMessage(GetLastError); + WriteMessage('ERROR %d in %s [%s]: %s %s', [FLastError, FailingMethod, ParentMethod, FLastErrorString, Message]); +end; + +procedure TDebugLogClient.WriteMessage(const Format: string; + const Args: array of const); +const + MAX_DESCRIPTORS = 12; +var + Descriptors: array[0..MAX_DESCRIPTORS-1] of EVENT_DATA_DESCRIPTOR; + dwPlatform: DWORD; + sDummy, sMsg, sProcessName: string; + pid, tid: DWORD; + dwTickCount, dwDummy: DWORD; + status: ULONG; +begin + if not ShouldDebug then + Exit; + + pid := GetCurrentProcessId; + tid := GetCurrentThreadId; + dwTickCount := GetTickCount; + + dwPlatform := 1; // x86 + dwDummy := 0; + sProcessName := 'keyman[host]'; + sMsg := System.SysUtils.Format(Format, Args); + + // These must match the manifest template in keyman-debug-etw.man + EventDataDescCreate(Descriptors[0], @dwPlatform, sizeof(DWORD)); // + EventDataDescCreate(&Descriptors[1], PChar(sProcessName), (Length(sProcessName) + 1) * sizeof(WCHAR)); // + EventDataDescCreate(&Descriptors[2], @pid, sizeof(DWORD)); // + EventDataDescCreate(&Descriptors[3], @tid, sizeof(DWORD)); // + EventDataDescCreate(&Descriptors[4], @dwDummy, sizeof(DWORD)); // + EventDataDescCreate(&Descriptors[5], @dwDummy, sizeof(DWORD)); // + EventDataDescCreate(&Descriptors[6], @dwTickCount, sizeof(DWORD)); // + EventDataDescCreate(&Descriptors[7], @dwDummy, sizeof(DWORD)); // + EventDataDescCreate(&Descriptors[8], @dwDummy, sizeof(DWORD)); // + EventDataDescCreate(&Descriptors[9], PChar(sDummy), sizeof(WCHAR)); // + EventDataDescCreate(&Descriptors[10], @dwDummy, sizeof(DWORD)); // + EventDataDescCreate(&Descriptors[11], PChar(sMsg), (Length(sMsg)+1) * sizeof(WCHAR)); // + + status := EventWrite(FRegHandle, @DebugEvent, MAX_DESCRIPTORS, @Descriptors[0]); + if ERROR_SUCCESS <> status then + OutputDebugString(PChar('EventWrite failed with '+IntToStr(status))); +end; + +initialization +finalization + FreeAndNil(TDebugLogClient.FInstance); +end. diff --git a/windows/src/global/delphi/debug/Keyman.System.DebugLogCommon.pas b/windows/src/global/delphi/debug/Keyman.System.DebugLogCommon.pas new file mode 100644 index 0000000000..690beaaafd --- /dev/null +++ b/windows/src/global/delphi/debug/Keyman.System.DebugLogCommon.pas @@ -0,0 +1,36 @@ +unit Keyman.System.DebugLogCommon; + +interface + +const + // GUID that identifies the provider that you want + // to enable to your session. + DebugLogProviderGuid: TGUID = '{DA621615-E08B-4283-918E-D2502D3757AE}'; + +function ShouldDebug: Boolean; + +implementation + +uses + System.Win.Registry, + + RegistryKeys; + +var + FShouldDebug: Boolean; + +function ShouldDebug: Boolean; +begin + Result := FShouldDebug; +end; + +initialization + with TRegistry.Create do // I2890 + try + if OpenKeyReadOnly(SRegKey_KeymanEngine_CU) and ValueExists(SRegValue_KeymanDebug) + then FShouldDebug := ReadBool(SRegValue_KeymanDebug) + else FShouldDebug := False; + finally + Free; + end; +end. diff --git a/windows/src/global/delphi/debug/Keyman.System.DebugLogManager.pas b/windows/src/global/delphi/debug/Keyman.System.DebugLogManager.pas new file mode 100644 index 0000000000..fe813047a6 --- /dev/null +++ b/windows/src/global/delphi/debug/Keyman.System.DebugLogManager.pas @@ -0,0 +1,289 @@ +(* + Name: DebugManager + Copyright: Copyright (C) SIL International. + Documentation: + Description: + Create Date: 14 Sep 2006 + + Modified Date: 9 Aug 2015 + Authors: mcdurdin + Related Files: + Dependencies: + + Bugs: + Todo: + Notes: + History: 14 Sep 2006 - mcdurdin - Initial version + 04 Jan 2007 - mcdurdin - Add ShouldDebug function + 19 Jun 2007 - mcdurdin - Widestring it + 19 Nov 2007 - mcdurdin - I1157 - const string parameters + 04 May 2010 - mcdurdin - I2348 - Rework columns in debug log + 04 May 2010 - mcdurdin - I2349 - Hotkey to capture debug log + 04 May 2010 - mcdurdin - I2350 - Keyman.exe should be able to report events in debug log + 04 May 2010 - mcdurdin - I2352 - Debug logging not reliable in some apps due to security + 15 Jun 2010 - mcdurdin - I2423 - Fix crash in debug manager + 24 Jun 2010 - mcdurdin - I2422 - Recreate, not rewrite existing log files + 29 Jun 2010 - mcdurdin - I2446 - Keyman Engine crashes due to debug manager being freed late + 17 Dec 2010 - mcdurdin - Add extra column to raw strings + 11 Jan 2011 - mcdurdin - I2640 - Raise error at appropriate location so it isn't masked by cascading issue + 31 Jan 2011 - mcdurdin - I2685 - Reduce registry noise from ShouldDebug function + 31 Jan 2011 - mcdurdin - I2690 - Add foreground window info to debug log + 31 Jan 2011 - mcdurdin - I2691 - Fix handle leaks + 18 Feb 2011 - mcdurdin - I2685 : 9827 - Fix shoulddebug refresh counter not resetting + 03 May 2011 - mcdurdin - I2890 - Record diagnostic data when encountering registry errors + 18 May 2012 - mcdurdin - I3306 - V9.0 - Remove TntControls + Win9x support + 08 Jun 2012 - mcdurdin - I3310 - V9.0 - Unicode in Delphi fixes + 28 Nov 2012 - mcdurdin - I3601 - V9.0 - Debug messages were written partially Unicode, partially ANSI + 13 Dec 2012 - mcdurdin - I3656 - V9.0 - Debug logs show too many columns for host messages + 01 Jan 2013 - mcdurdin - I3692 - V9.0 - [host] entries in system.log out by 1 tabstop + 09 Aug 2015 - mcdurdin - I4843 - Log reported modifier state as well as Keyman current modifier state +*) +unit Keyman.System.DebugLogManager; // I3306 + +interface + +uses + System.Classes, + System.SysUtils, + Winapi.Windows, + JwaWmiStr, + JwaEventTracing, + + Keyman.System.DebugLogCommon, + UserMessages; + +type + TDebugLogManager = class + private + FOwner: HWND; + FDebugLogIndex: Integer; + FDebugLogFileName: string; + + pSessionProperties: PEVENT_TRACE_PROPERTIES; + FSessionHandle: TRACEHANDLE; + FTraceRunning: Boolean; + + procedure StartNewLogFile; + procedure FindFirstLogFileName; + + function DebugLogFileName(n: Integer): string; + public + constructor Create(AOwner: HWND); reintroduce; + destructor Destroy; override; + + end; + +function GetDebugManager(AOwner: HWND): TDebugLogManager; + +implementation + +uses + Accctrl, + AclApi, + ErrorControlledRegistry, + ErrLogPath, + RegistryKeys, + Unicode; + +var + FDebugManager: TDebugLogManager = nil; + FTerminating: Boolean = False; + + FShouldDebug: Boolean = False; + FShouldDebugLastTick: Cardinal = 0; + +const + // GUID that identifies your trace session. + // Remember to create your own session GUID. + SessionGuid: TGUID = '{FADEA67E-0EE9-452B-AF04-22E342D1227A}'; + +function GetDebugManager(AOwner: HWND): TDebugLogManager; +begin + Assert(not FTerminating); + + if ShouldDebug then + begin + if not Assigned(FDebugManager) then + FDebugManager := TDebugLogManager.Create(AOwner); + Result := FDebugManager; + end + else + Result := nil; +end; + +{ TDebugManager } + +const LOGSESSION_NAME: string = 'Keyman Event Trace Session'; + +function StringBufferSize(const s: string): Integer; +begin + Result := (Length(s) + 1) * sizeof(WCHAR); +end; + +constructor TDebugLogManager.Create(AOwner: HWND); +var + BufferSize: ULONG; + status: ULONG; +// BOOL TraceOn = TRUE; +// BOOL bTraceAlreadyStarted = FALSE; +begin + FOwner := AOwner; + + FindFirstLogFileName; + StartNewLogFile; + + // Allocate memory for the session properties. The memory must + // be large enough to include the log file name and session name, + // which get appended to the end of the session properties structure. + + BufferSize := sizeof(EVENT_TRACE_PROPERTIES) + StringBufferSize(FDebugLogFileName) + StringBufferSize(LOGSESSION_NAME); + pSessionProperties := PEVENT_TRACE_PROPERTIES(AllocMem(BufferSize)); + + // Set the session properties. You only append the log file name + // to the properties structure; the StartTrace function appends + // the session name for you. + + pSessionProperties.Wnode.BufferSize := BufferSize; + pSessionProperties.Wnode.Flags := WNODE_FLAG_TRACED_GUID; + pSessionProperties.Wnode.ClientContext := 1; //QPC clock resolution + pSessionProperties.Wnode.Guid := SessionGuid; + pSessionProperties.LogFileMode := EVENT_TRACE_FILE_MODE_SEQUENTIAL; + pSessionProperties.MaximumFileSize := 1; // 1 MB + pSessionProperties.LoggerNameOffset := sizeof(EVENT_TRACE_PROPERTIES); + pSessionProperties.LogFileNameOffset := sizeof(EVENT_TRACE_PROPERTIES) + sizeof(LOGSESSION_NAME); + StrPCopy(PWideChar(PByte(pSessionProperties) + pSessionProperties.LoggerNameOffset), LOGSESSION_NAME); + StrPCopy(PWideChar(PByte(pSessionProperties) + pSessionProperties.LogFileNameOffset), FDebugLogFileName); +// StringCbCopy((LPWSTR)((char*)pSessionProperties + pSessionProperties->LogFileNameOffset), sizeof(LOGFILE_PATH), LOGFILE_PATH); + + status := StartTrace(@FSessionHandle, PWideChar(LOGSESSION_NAME), pSessionProperties^); + if ERROR_ALREADY_EXISTS = status then + begin + // The trace was already started, perhaps Keyman did not close down cleanly + // We'll stop it and restart it + status := ControlTraceW(FSessionHandle, PWideChar(LOGSESSION_NAME), pSessionProperties^, EVENT_TRACE_CONTROL_STOP); + if ERROR_SUCCESS <> status then + OutputDebugString(PChar('ControlTrace failed with '+IntToStr(status))); + + status := StartTrace(@FSessionHandle, PWideChar(LOGSESSION_NAME), pSessionProperties^); + end; + + if ERROR_SUCCESS <> status then + RaiseLastOSError(status, 'StartTrace'); + + // Enable the providers that you want to log events to your session. + + status := EnableTraceEx( + @DebugLogProviderGuid, + @SessionGuid, + FSessionHandle, + 1, // Enable + TRACE_LEVEL_INFORMATION, + 0, + 0, + 0, + nil + ); + + if ERROR_SUCCESS <> status then + RaiseLastOSError(status, 'EnableTraceEx'); + + FTraceRunning := True; +end; + +destructor TDebugLogManager.Destroy; +var + status: ULONG; +begin + if FSessionHandle <> 0 then + begin + if FTraceRunning then + begin + status := EnableTraceEx( + @DebugLogProviderGuid, + @SessionGuid, + FSessionHandle, + 0, // Disable + TRACE_LEVEL_INFORMATION, + 0, + 0, + 0, + nil + ); + if ERROR_SUCCESS <> status then + OutputDebugString(PChar('EnableTraceEx(FALSE) failed with '+IntToStr(status))); + + FTraceRunning := False; + end; + + // We use ControlTraceW because JwaEventTracing has a typo for ControlTrace + status := ControlTraceW(FSessionHandle, PWideChar(LOGSESSION_NAME), pSessionProperties^, EVENT_TRACE_CONTROL_STOP); + if ERROR_SUCCESS <> status then + OutputDebugString(PChar('ControlTrace failed with '+IntToStr(status))); + + FSessionHandle := 0; + end; + + if pSessionProperties <> nil then + begin + FreeMem(pSessionProperties); + pSessionProperties := nil; + end; + + inherited Destroy; +end; + +const + MAXDEBUGLOGS = 16; + +function TDebugLogManager.DebugLogFileName(n: Integer): string; +begin + Result := GetErrLogPath + 'system' + IntToStr(n) + '.etl'; +end; + +procedure TDebugLogManager.FindFirstLogFileName; +var + FSelectedTime: TDateTime; + i: Integer; + f: TSearchRec; +begin + FSelectedTime := MaxDateTime; + FDebugLogIndex := 0; + + for i := 0 to MAXDEBUGLOGS - 1 do + begin + if FindFirst(DebugLogFileName(i), 0, f) = 0 then + begin + if f.TimeStamp < FSelectedTime then + begin + FDebugLogIndex := i; + FSelectedTime := f.TimeStamp; + end; + System.SysUtils.FindClose(f); + end + else + begin + FDebugLogIndex := i; + Break; + end; + end; + + Dec(FDebugLogIndex); // It will be immediately incremented by StartNewLogFile +end; + +procedure TDebugLogManager.StartNewLogFile; +begin + Inc(FDebugLogIndex); + if FDebugLogIndex > MAXDEBUGLOGS then + FDebugLogIndex := 0; + + FDebugLogFileName := DebugLogFileName(FDebugLogIndex); + if FileExists(FDebugLogFileName) then + System.SysUtils.DeleteFile(FDebugLogFileName); +end; + + +initialization +finalization + FTerminating := True; + FreeAndNil(FDebugManager); +end. diff --git a/windows/src/global/delphi/general/SystemDebugPath.pas b/windows/src/global/delphi/general/SystemDebugPath.pas deleted file mode 100644 index 3a417f7586..0000000000 --- a/windows/src/global/delphi/general/SystemDebugPath.pas +++ /dev/null @@ -1,74 +0,0 @@ -(* - Name: SystemDebugPath - Copyright: Copyright (C) SIL International. - Documentation: - Description: - Create Date: 4 Dec 2006 - - Modified Date: 26 Jun 2012 - Authors: mcdurdin - Related Files: - Dependencies: - - Bugs: - Todo: - Notes: - History: 04 Dec 2006 - mcdurdin - Initial version - 19 Jun 2007 - mcdurdin - Widestrings - 03 May 2011 - mcdurdin - I2890 - Record diagnostic data when encountering registry errors - 04 May 2012 - mcdurdin - I3306 - V9.0 - Remove TntControls - 26 Jun 2012 - mcdurdin - I3379 - KM9 - Remove old Winapi references now in Delphi libraries -*) -unit SystemDebugPath; // I3306 - -interface - -function GetSystemDebugPath: WideString; - -implementation - -uses - ActiveX, ShellApi, ShlObj, ErrorControlledRegistry, SysUtils, Windows; - -function GetFolderPath(csidl: Integer): WideString; -var - buf: array[0..260] of WideChar; - idl: PItemIDList; - mm: IMalloc; -begin - Result := ''; - if SHGetMalloc(mm) = NOERROR then - begin - if SHGetSpecialFolderLocation(0, csidl, idl) = NOERROR then - begin - if SHGetPathFromIDList(idl, buf) then - begin - Result := Buf; - end; - mm.Free(idl); - end; - mm._Release; - end; - - if (Result = '') and (csidl = CSIDL_PROGRAM_FILES) then - with TRegistryErrorControlled.Create do // I2890 - try - RootKey := HKEY_LOCAL_MACHINE; - if not OpenKeyReadOnly('Software\Microsoft\Windows\CurrentVersion') then // I2890 - RaiseLastRegistryError; - Result := ReadString('ProgramFilesDir'); - finally - Free; - end; - if Result <> '' then Result := IncludeTrailingPathDelimiter(Result); - if Result[Length(Result)] <> '\' then Result := Result + '\'; -end; - -function GetSystemDebugPath: WideString; -begin - Result := GetFolderPath(CSIDL_DESKTOPDIRECTORY) + 'keymanlog'; - if not DirectoryExists(Result) then CreateDir(Result); // assumes write permissions! - Result := Result + '\'; -end; - -end. diff --git a/windows/src/global/delphi/general/UserMessages.pas b/windows/src/global/delphi/general/UserMessages.pas index 609acc1851..1deb856767 100644 --- a/windows/src/global/delphi/general/UserMessages.pas +++ b/windows/src/global/delphi/general/UserMessages.pas @@ -32,7 +32,6 @@ const WM_USER_ParameterPass = WM_USER+100; WM_USER_SendFontChange = WM_USER+102; WM_USER_PlatformComms = WM_USER+103; - WM_USER_DebugNotify = WM_USER+104; WM_USER_VisualKeyboardClosed = WM_USER+105; // I4242 const