diff --git a/windows/src/desktop/kmshell/help/UfrmHelp.pas b/windows/src/desktop/kmshell/help/UfrmHelp.pas index 697eabf4f6..9d421bd628 100644 --- a/windows/src/desktop/kmshell/help/UfrmHelp.pas +++ b/windows/src/desktop/kmshell/help/UfrmHelp.pas @@ -64,7 +64,7 @@ uses MessageIdentifiers, utildir, utilexecute, - utilxml; + utilhttp; { TfrmHelp } @@ -124,19 +124,14 @@ end; procedure TfrmHelp.WMUserFormShown(var Message: TMessage); var - FXML: WideString; + FQuery: string; begin FormStyle := fsStayOnTop; // I4209 - if FActiveKeyboard <> nil then - begin - FXML := - ''; - end - else - FXML := ''; + if FActiveKeyboard <> nil + then FQuery := Format('?keyboard=%s', [UrlEncode(FActiveKeyboard.Name)]) + else FQuery := ''; - // TODO: xml - Content_Render(False, FXML); + Content_Render(False, FQuery); inherited; end; diff --git a/windows/src/desktop/kmshell/install/UfrmInstallKeyboard.pas b/windows/src/desktop/kmshell/install/UfrmInstallKeyboard.pas index 64d1dc33b7..79eff72909 100644 --- a/windows/src/desktop/kmshell/install/UfrmInstallKeyboard.pas +++ b/windows/src/desktop/kmshell/install/UfrmInstallKeyboard.pas @@ -17,7 +17,7 @@ 01 Aug 2006 - mcdurdin - Check if keyboard is already installed and uninstall if so 06 Oct 2006 - mcdurdin - Display welcome after package install 04 Dec 2006 - mcdurdin - Change to a xml/xslt/html page - 05 Dec 2006 - mcdurdin - Refactor using XMLRenderer + 05 Dec 2006 - mcdurdin - Refactor using XML-Renderer 12 Dec 2006 - mcdurdin - Refresh after uninstalling keyboard 12 Dec 2006 - mcdurdin - Fix package and keyboard names in messages 12 Dec 2006 - mcdurdin - Capitalize form name @@ -98,7 +98,6 @@ implementation uses ComObj, custinterfaces, - GenericXMLRenderer, GetOSVersion, MessageIdentifierConsts, MessageIdentifiers, @@ -312,9 +311,8 @@ begin FXML := FKeyboard.SerializeXML(keymanapi_TLB.ksfExportImages, FTempPath, FFileReferences); end; - // TODO: xml FRenderPage := 'installkeyboard'; - Content_Render; + Content_Render(False, 'file='+Value); // TODO: xml finally Screen.Cursor := crDefault; end; diff --git a/windows/src/desktop/kmshell/install/UfrmInstallKeyboardFromWeb.pas b/windows/src/desktop/kmshell/install/UfrmInstallKeyboardFromWeb.pas index 68fc2c8bab..102e37869f 100644 --- a/windows/src/desktop/kmshell/install/UfrmInstallKeyboardFromWeb.pas +++ b/windows/src/desktop/kmshell/install/UfrmInstallKeyboardFromWeb.pas @@ -14,7 +14,7 @@ Todo: Notes: History: 06 Oct 2006 - mcdurdin - Initial version - 05 Dec 2006 - mcdurdin - Refactor using XMLRenderer + 05 Dec 2006 - mcdurdin - Refactor using XML-Renderer 12 Dec 2006 - mcdurdin - Capitalize form name 04 Jan 2007 - mcdurdin - Add proxy support 15 Jan 2007 - mcdurdin - Use name of file in Content-Disposition @@ -41,7 +41,6 @@ type dlgSaveFile: TSaveDialog; procedure TntFormShow(Sender: TObject); private - FXML: WideString; FURL: WideString; FFileName: WideString; procedure Download(params: TStringList); @@ -60,8 +59,7 @@ uses Upload_Settings, utildir, VersionInfo, - WideStrings, - GenericXMLRenderer; + WideStrings; {$R *.dfm} diff --git a/windows/src/desktop/kmshell/kmshell.dpr b/windows/src/desktop/kmshell/kmshell.dpr index 08fe857cca..32bad58476 100644 --- a/windows/src/desktop/kmshell/kmshell.dpr +++ b/windows/src/desktop/kmshell/kmshell.dpr @@ -162,7 +162,10 @@ uses Keyman.Configuration.UI.UfrmDiagnosticTests in 'util\Keyman.Configuration.UI.UfrmDiagnosticTests.pas' {frmDiagnosticTests}, Keyman.Configuration.System.UmodWebHttpServer in 'web\Keyman.Configuration.System.UmodWebHttpServer.pas' {modWebHttpServer: TDataModule}, Keyman.Configuration.System.HttpServer.App in 'web\Keyman.Configuration.System.HttpServer.App.pas', - Keyman.System.HttpServer.Base in '..\..\global\delphi\web\Keyman.System.HttpServer.Base.pas'; + Keyman.System.HttpServer.Base in '..\..\global\delphi\web\Keyman.System.HttpServer.Base.pas', + Keyman.Configuration.System.HttpServer.SharedData in 'web\Keyman.Configuration.System.HttpServer.SharedData.pas', + Keyman.Configuration.System.HttpServer.App.OnlineUpdate in 'web\Keyman.Configuration.System.HttpServer.App.OnlineUpdate.pas', + Keyman.System.LocaleStrings in '..\..\global\delphi\cust\Keyman.System.LocaleStrings.pas'; {$R VERSION.RES} {$R manifest.res} diff --git a/windows/src/desktop/kmshell/kmshell.dproj b/windows/src/desktop/kmshell/kmshell.dproj index 475f2fd14d..f872f8b5b3 100644 --- a/windows/src/desktop/kmshell/kmshell.dproj +++ b/windows/src/desktop/kmshell/kmshell.dproj @@ -99,7 +99,7 @@ CompanyName=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName);FileDescription=$(MSBuildProjectName);ProductName=$(MSBuildProjectName) true Debug - -c + -splash @@ -313,6 +313,9 @@ + + + Cfg_2 @@ -405,18 +408,18 @@ true - - - kmshell.exe - true - - .\ true + + + kmshell.exe + true + + 1 diff --git a/windows/src/desktop/kmshell/kmshell.res b/windows/src/desktop/kmshell/kmshell.res index c30b3f5779..ca8af465a8 100644 Binary files a/windows/src/desktop/kmshell/kmshell.res and b/windows/src/desktop/kmshell/kmshell.res differ diff --git a/windows/src/desktop/kmshell/main/OnlineUpdateCheck.pas b/windows/src/desktop/kmshell/main/OnlineUpdateCheck.pas index 9390db900b..19f79afaa3 100644 --- a/windows/src/desktop/kmshell/main/OnlineUpdateCheck.pas +++ b/windows/src/desktop/kmshell/main/OnlineUpdateCheck.pas @@ -115,6 +115,19 @@ type property ShowErrors: Boolean read FShowErrors write FShowErrors; end; + IOnlineUpdateSharedData = interface + ['{7442A323-C1E3-404B-BEEA-5B24A52BBB0E}'] + function Params: TOnlineUpdateCheckParams; + end; + + TOnlineUpdateSharedData = class(TInterfacedObject, IOnlineUpdateSharedData) + private + FParams: TOnlineUpdateCheckParams; + public + constructor Create(AParams: TOnlineUpdateCheckParams); + function Params: TOnlineUpdateCheckParams; + end; + procedure OnlineUpdateAdmin(Path: string); implementation @@ -691,4 +704,17 @@ begin end; end; +{ TOnlineUpdateSharedData } + +constructor TOnlineUpdateSharedData.Create(AParams: TOnlineUpdateCheckParams); +begin + inherited Create; + FParams := AParams; +end; + +function TOnlineUpdateSharedData.Params: TOnlineUpdateCheckParams; +begin + Result := FParams; +end; + end. diff --git a/windows/src/desktop/kmshell/main/UfrmBaseKeyboard.pas b/windows/src/desktop/kmshell/main/UfrmBaseKeyboard.pas index 6703c9b16d..bf4c6d7140 100644 --- a/windows/src/desktop/kmshell/main/UfrmBaseKeyboard.pas +++ b/windows/src/desktop/kmshell/main/UfrmBaseKeyboard.pas @@ -25,7 +25,6 @@ implementation uses BaseKeyboards, - GenericXMLRenderer, kmint; function ConfigureBaseKeyboard: Boolean; @@ -39,14 +38,9 @@ begin end; procedure TfrmBaseKeyboard.TntFormCreate(Sender: TObject); -var - xml: WideString; begin inherited; - // TODO: xml - xml := TBaseKeyboards.EnumerateXML(kmcom.Options['koBaseLayout'].Value); - FRenderPage := 'basekeyboard'; Content_Render; end; diff --git a/windows/src/desktop/kmshell/main/UfrmKeepInTouch.pas b/windows/src/desktop/kmshell/main/UfrmKeepInTouch.pas index 43cba447c2..68dccd14dd 100644 --- a/windows/src/desktop/kmshell/main/UfrmKeepInTouch.pas +++ b/windows/src/desktop/kmshell/main/UfrmKeepInTouch.pas @@ -31,7 +31,7 @@ type private { Private declarations } protected - procedure Content_Render(FRefreshKeyman: Boolean = False; const AdditionalData: WideString = ''); override; + procedure Content_Render(FRefreshKeyman: Boolean = False; const Query: string = ''); override; procedure FireCommand(const command: WideString; params: TStringList); override; public { Public declarations } @@ -87,7 +87,7 @@ begin end; procedure TfrmKeepInTouch.Content_Render(FRefreshKeyman: Boolean; - const AdditionalData: WideString); + const Query: string); var FPath: string; begin diff --git a/windows/src/desktop/kmshell/main/UfrmMain.pas b/windows/src/desktop/kmshell/main/UfrmMain.pas index 9bfa75457e..b7a854e1b1 100644 --- a/windows/src/desktop/kmshell/main/UfrmMain.pas +++ b/windows/src/desktop/kmshell/main/UfrmMain.pas @@ -23,7 +23,7 @@ 06 Oct 2006 - mcdurdin - Add download keyboard 04 Dec 2006 - mcdurdin - Use T-frmWebContainer; 04 Dec 2006 - mcdurdin - Add keyboard_download, package_welcome, footer_buy, select_uilanguage - 05 Dec 2006 - mcdurdin - Refactor using XMLRenderer + 05 Dec 2006 - mcdurdin - Refactor using XML-Renderer 05 Dec 2006 - mcdurdin - Localize additional messages 12 Dec 2006 - mcdurdin - Capitalize form name; start on Keyboards page, not options 04 Jan 2007 - mcdurdin - Proxy support @@ -198,7 +198,6 @@ uses utilkmshell, utilhttp, utiluac, - utilxml, Variants; type @@ -234,7 +233,7 @@ begin Keyboards_Init; Options_Init; - FRenderPage := 'main'; + FRenderPage := 'keyman'; // TODO: rename to 'main'? or 'config'? Do_Content_Render(False); end; @@ -273,16 +272,17 @@ end; procedure TfrmMain.Do_Content_Render(FRefreshKeyman: Boolean); var - s: string; + query: string; begin SaveState; - s := ''+XMLEncode(FState)+''; - s := s + ''+ - XMLEncode(TBaseKeyboards.GetName(kmcom.Options[KeymanOptionName(koBaseLayout)].Value))+ - ''; // I4169 + query := Format('state=%s&basekeyboardname=%s&basekeyboardid=%08.8x', [ + UrlEncode(FState), + UrlEncode(TBaseKeyboards.GetName(kmcom.Options[KeymanOptionName(koBaseLayout)].Value)), + Cardinal(kmcom.Options[KeymanOptionName(koBaseLayout)].Value) + ]); - Content_Render(FRefreshKeyman, s); + Content_Render(FRefreshKeyman, query); end; procedure TfrmMain.FireCommand(const command: WideString; params: TStringList); diff --git a/windows/src/desktop/kmshell/main/UfrmOnlineUpdateNewVersion.pas b/windows/src/desktop/kmshell/main/UfrmOnlineUpdateNewVersion.pas index a800369215..9c3e02159a 100644 --- a/windows/src/desktop/kmshell/main/UfrmOnlineUpdateNewVersion.pas +++ b/windows/src/desktop/kmshell/main/UfrmOnlineUpdateNewVersion.pas @@ -33,8 +33,10 @@ uses type TfrmOnlineUpdateNewVersion = class(TfrmWebContainer) procedure TntFormShow(Sender: TObject); + procedure TntFormDestroy(Sender: TObject); private FParams: TOnlineUpdateCheckParams; + PageTag: Integer; protected procedure FireCommand(const command: WideString; params: TStringList); override; public @@ -47,6 +49,7 @@ implementation uses kmint, + Keyman.Configuration.System.UmodWebHttpServer, MessageIdentifiers, MessageIdentifierConsts, strutils, @@ -81,55 +84,30 @@ begin inherited; end; +procedure TfrmOnlineUpdateNewVersion.TntFormDestroy(Sender: TObject); +begin + inherited; + modWebHttpServer.SharedData.Remove(PageTag); +end; + procedure TfrmOnlineUpdateNewVersion.TntFormShow(Sender: TObject); var - xml: WideString; i: Integer; + Data: IOnlineUpdateSharedData; begin inherited; - // TODO: refactor data - xml := ''; - - if (FParams.Keyman.DownloadURL <> '') then - begin + if FParams.Keyman.DownloadURL <> '' then FParams.Keyman.Install := True; - xml := xml + - ''+ - '0'+ - IfThen(not kmcom.SystemInfo.IsAdministrator, '')+ - ''+ - ''+xmlencode(MsgFromIdFormat(SKUpdate_KeymanText, [FParams.Keyman.NewVersion]))+''+ - ''+xmlencode(FParams.Keyman.NewVersion)+''+ - ''+xmlencode(FParams.Keyman.OldVersion)+''+ - ''+xmlencode(Format('%d', [FParams.Keyman.DownloadSize div 1024]))+'KB'+ - ''+xmlencode(FParams.Keyman.DownloadURL)+''+ - ''+ - ''; - end; for i := 0 to High(FParams.Packages) do - begin FParams.Packages[i].Install := True; - xml := xml + - ''+ - ''+IntToStr(i+1)+''+ - IfThen(not kmcom.SystemInfo.IsAdministrator, '')+ - ''+ - ''+xmlencode(MsgFromIdFormat(SKUpdate_PackageText, [FParams.Packages[i].Description, FParams.Packages[i].NewVersion]))+''+ - ''+xmlencode(FParams.Packages[i].NewVersion)+''+ - ''+xmlencode(FParams.Packages[i].OldVersion)+''+ - ''+xmlencode(Format('%d', [FParams.Packages[i].DownloadSize div 1024]))+'KB'+ - ''+xmlencode(FParams.Packages[i].DownloadURL)+''+ - ''+ - ''; -// ''+xmlencode(MsgFromIdFormat(SKUpdate_NewVersionText, [FNewVersion, FCurrentVersion]))+''+ -// ''+xmlencode(MsgFromIdFormat(SKUpdate_PatchText, [FPatchSize div 1024]))+''; - end; + Data := TOnlineUpdateSharedData.Create(FParams); + PageTag := modWebHttpServer.SharedData.Add(Data); FRenderPage := 'onlineupdate'; - Content_Render; + Content_Render(False, 'tag='+IntToStr(PageTag)); end; end. diff --git a/windows/src/desktop/kmshell/main/UfrmProxyConfiguration.pas b/windows/src/desktop/kmshell/main/UfrmProxyConfiguration.pas index 984bb82729..004538e22e 100644 --- a/windows/src/desktop/kmshell/main/UfrmProxyConfiguration.pas +++ b/windows/src/desktop/kmshell/main/UfrmProxyConfiguration.pas @@ -39,7 +39,6 @@ type implementation uses - GenericXMLRenderer, GlobalProxySettings, utilxml; diff --git a/windows/src/desktop/kmshell/startup/UfrmSplash.pas b/windows/src/desktop/kmshell/startup/UfrmSplash.pas index 05b1127e14..7964086d90 100644 --- a/windows/src/desktop/kmshell/startup/UfrmSplash.pas +++ b/windows/src/desktop/kmshell/startup/UfrmSplash.pas @@ -72,7 +72,6 @@ type class function ShouldRegisterWindow: Boolean; override; // I2720 function ShouldSetAppTitle: Boolean; override; // I2786 public - procedure Do_Content_Render(FRefreshKeyman: Boolean); override; property ShowConfigurationOnLoad: Boolean read FShowConfigurationOnLoad write FShowConfigurationOnLoad; end; @@ -84,10 +83,8 @@ implementation uses ComObj, custinterfaces, - GenericXMLRenderer, GetOSVersion, initprog, - KeyboardListXMLRenderer, KeymanControlMessages, KeymanOptionNames, kmcomapi_errors, @@ -104,9 +101,7 @@ uses Upload_Settings, utilexecute, utilfocusappwnd, - utilkmshell, - utilxml, - VersionInfo, ActiveX; + utilkmshell; {$R *.DFM} @@ -136,40 +131,11 @@ end; procedure TfrmSplash.TntFormShow(Sender: TObject); begin + FRenderPage := 'splash'; Do_Content_Render(False); inherited; end; -function EscapeString(const str: WideString): WideString; -var - i: Integer; -begin - Result := ''; - for i := 1 to Length(str) do - begin - case str[i] of - '"': Result := Result + '\"'; - #0..#31: Result := Result + '\x'+IntToHex(Ord(str[i]), 2); - '\': Result := Result + '\\'; - else Result := Result + str[i]; - end; - end; -end; - -procedure TfrmSplash.Do_Content_Render(FRefreshKeyman: Boolean); -var - xml: WideString; -begin - xml := ''; - - // TODO: xml - xml := xml + ''+xmlencode(MsgFromIdFormat(SKSplashVersion, [GetVersionString]))+''; -// xml := xml + ''+IntToStr(kmcom.Keyboards.Count)+''; - - FRenderPage := 'splash'; - Content_Render; -end; - procedure TfrmSplash.WMUser(var Message: TMessage); begin Do_Content_Render(False); diff --git a/windows/src/desktop/kmshell/web/Keyman.Configuration.System.HttpServer.App.OnlineUpdate.pas b/windows/src/desktop/kmshell/web/Keyman.Configuration.System.HttpServer.App.OnlineUpdate.pas new file mode 100644 index 0000000000..3fc80050ff --- /dev/null +++ b/windows/src/desktop/kmshell/web/Keyman.Configuration.System.HttpServer.App.OnlineUpdate.pas @@ -0,0 +1,99 @@ +unit Keyman.Configuration.System.HttpServer.App.OnlineUpdate; + +interface + +uses + Keyman.Configuration.System.HttpServer.App, + OnlineUpdateCheck; // TODO refactor dependency chain so data and code are separate units + +type + TOnlineUpdateHttpResponder = class(TAppHttpResponder) + public + procedure ProcessRequest; override; + end; + +implementation + +uses + System.Classes, + System.Contnrs, + System.StrUtils, + System.SysUtils, + + GenericXMLRenderer, + Keyman.System.LocaleStrings, + MessageIdentifierConsts, + utilxml; + +{ TOnlineUpdateHttpResponder } + +procedure TOnlineUpdateHttpResponder.ProcessRequest; +var + xml: string; + i: Integer; + u: IUnknown; + data: IOnlineUpdateSharedData; + tag: Integer; +begin + data := nil; + tag := StrToIntDef(RequestInfo.Params.Values['tag'], -1); + if (tag >= 0) then + begin + u := SharedData.Get(tag); + if Assigned(u) then + Supports(u, IOnlineUpdateSharedData, data); + end; + + if data = nil then + begin + Respond404(Context, RequestInfo, ResponseInfo); + Exit; + end; + + xml := ''; + + if (data.Params.Keyman.DownloadURL <> '') then + begin +// FParams.Keyman.Install := True; + xml := xml + + ''+ + '0'+ + IfThen(not XMLRenderers.kmcom.SystemInfo.IsAdministrator, '')+ + ''+ + ''+xmlencode(TLocaleStrings.MsgFromIdFormat(XMLRenderers.kmcom, SKUpdate_KeymanText, [data.Params.Keyman.NewVersion]))+''+ + ''+xmlencode(data.Params.Keyman.NewVersion)+''+ + ''+xmlencode(data.Params.Keyman.OldVersion)+''+ + ''+xmlencode(Format('%d', [data.Params.Keyman.DownloadSize div 1024]))+'KB'+ + ''+xmlencode(data.Params.Keyman.DownloadURL)+''+ + ''+ + ''; + end; + + for i := 0 to High(data.Params.Packages) do + begin + xml := xml + + ''+ + ''+IntToStr(i+1)+''+ + IfThen(not XMLRenderers.kmcom.SystemInfo.IsAdministrator, '')+ + ''+ + ''+xmlencode(TLocaleStrings.MsgFromIdFormat(XMLRenderers.kmcom, SKUpdate_PackageText, [data.Params.Packages[i].Description, data.Params.Packages[i].NewVersion]))+''+ + ''+xmlencode(data.Params.Packages[i].NewVersion)+''+ + ''+xmlencode(data.Params.Packages[i].OldVersion)+''+ + ''+xmlencode(Format('%d', [data.Params.Packages[i].DownloadSize div 1024]))+'KB'+ + ''+xmlencode(data.Params.Packages[i].DownloadURL)+''+ + ''+ + ''; + +// ''+xmlencode(MsgFromIdFormat(SKUpdate_NewVersionText, [FNewVersion, FCurrentVersion]))+''+ +// ''+xmlencode(MsgFromIdFormat(SKUpdate_PatchText, [FPatchSize div 1024]))+''; + end; + + XMLRenderers.xRenderTemplate := 'onlineupdate.xsl'; + XMLRenderers.Clear; + XMLRenderers.Add(TGenericXMLRenderer.Create(XMLRenderers, xml)); + ProcessXMLPage; +end; + +initialization + TOnlineUpdateHttpResponder.Register('/page/onlineupdate', TOnlineUpdateHttpResponder); +end. diff --git a/windows/src/desktop/kmshell/web/Keyman.Configuration.System.HttpServer.App.pas b/windows/src/desktop/kmshell/web/Keyman.Configuration.System.HttpServer.App.pas index 407212bbfb..01e8063476 100644 --- a/windows/src/desktop/kmshell/web/Keyman.Configuration.System.HttpServer.App.pas +++ b/windows/src/desktop/kmshell/web/Keyman.Configuration.System.HttpServer.App.pas @@ -3,39 +3,66 @@ unit Keyman.Configuration.System.HttpServer.App; interface uses + System.Classes, + System.Generics.Collections, + IdContext, IdCustomHTTPServer, + Keyman.Configuration.System.HttpServer.SharedData, Keyman.System.HttpServer.Base, XMLRenderer; type + TAppHttpResponderClass = class of TAppHttpResponder; + TAppHttpResponder = class(TBaseHttpResponder) private + class var FRegisteredClasses: TDictionary; + private + FSharedData: THttpServerSharedData; FContext: TIdContext; FRequestInfo: TIdHTTPRequestInfo; FResponseInfo: TIdHTTPResponseInfo; FXMLRenderers: TXMLRenderers; - procedure ProcessPageMain; + procedure ProcessPageMain(const Params: TStrings); procedure ProcessPageHint; procedure ProcessPageSplash; - procedure ProcessXMLPage(const s: string); - public + procedure ProcessPageHelp(const Params: TStrings); + procedure ProcessPageBaseKeyboard; constructor Create( + ASharedData: THttpServerSharedData; AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo); + protected + procedure ProcessXMLPage(const s: string = ''); + procedure ProcessRequest; virtual; + property SharedData: THttpServerSharedData read FSharedData; + property Context: TIdContext read FContext; + property RequestInfo: TIdHTTPRequestInfo read FRequestInfo; + property ResponseInfo: TIdHTTPResponseInfo read FResponseInfo; + property XMLRenderers: TXMLRenderers read FXMLRenderers; + class procedure Register(const page: string; ClassType: TAppHttpResponderClass); + public destructor Destroy; override; - procedure ProcessRequest; + class procedure DoProcessRequest( + ASharedData: THttpServerSharedData; + AContext: TIdContext; + ARequestInfo: TIdHTTPRequestInfo; + AResponseInfo: TIdHTTPResponseInfo); end; implementation uses - System.Classes, System.Contnrs, System.SysUtils, + BaseKeyboards, + KeymanVersion, + MessageIdentifierConsts, + Keyman.System.LocaleStrings, KeymanPaths, GenericXMLRenderer, HotkeysXMLRenderer, @@ -43,7 +70,8 @@ uses LanguagesXMLRenderer, OptionsXMLRenderer, SupportXMLRenderer, - TempFileManager; + TempFileManager, + utilxml; { THttpServerApp } @@ -69,12 +97,16 @@ begin else if FRequestInfo.Document.StartsWith('/page/') then begin // Retrieve data from kmcom etc - if FRequestInfo.Document = '/page/main' then - ProcessPageMain + if FRequestInfo.Document = '/page/keyman' then + ProcessPageMain(FRequestInfo.Params) else if FRequestInfo.Document = '/page/hint' then ProcessPageHint + else if FRequestInfo.Document = '/page/help' then + ProcessPageHelp(FRequestInfo.Params) else if FRequestInfo.Document = '/page/splash' then ProcessPageSplash + else if FRequestInfo.Document = '/page/basekeyboard' then + ProcessPageBaseKeyboard else begin // Generic response @@ -92,10 +124,12 @@ begin FResponseInfo := nil; end; -constructor TAppHttpResponder.Create(AContext: TIdContext; +constructor TAppHttpResponder.Create( + ASharedData: THttpServerSharedData; AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo); begin inherited Create; + FSharedData := ASharedData; FContext := AContext; FRequestInfo := ARequestInfo; FResponseInfo := AResponseInfo; @@ -108,24 +142,54 @@ begin inherited Destroy; end; + +class procedure TAppHttpResponder.DoProcessRequest(ASharedData: THttpServerSharedData; AContext: TIdContext; + ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo); +var + FClass: TAppHttpResponderClass; + FApp: TAppHttpResponder; +begin + if FRegisteredClasses.ContainsKey(ARequestInfo.Document) then + begin + FClass := FRegisteredClasses[ARequestInfo.Document] + end + else + FClass := TAppHttpResponder; + + FApp := FClass.Create(ASharedData, AContext, ARequestInfo, AResponseInfo); + try + FApp.ProcessRequest; + finally + FreeAndNil(FApp); + end; +end; + procedure TAppHttpResponder.ProcessPageHint; begin FXMLRenderers.xRenderTemplate := 'Hint.xsl'; ProcessXMLPage(''); end; -procedure TAppHttpResponder.ProcessPageMain; +procedure TAppHttpResponder.ProcessPageHelp(const Params: TStrings); var s: string; begin -// SaveState; - s := ''; -{ - s := ''+XMLEncode(FState)+''; - s := s + ''+ - XMLEncode(TBaseKeyboards.GetName(kmcom.Options[KeymanOptionName(koBaseLayout)].Value))+ - ''; // I4169 -} + if Params.Values['keyboard'] <> '' + then s := Format('', [XMLEncode(Params.Values['keyboard'])]) + else s := ''; + FXMLRenderers.xRenderTemplate := 'Help.xsl'; + ProcessXMLPage(s); +end; + +procedure TAppHttpResponder.ProcessPageMain(const Params: TStrings); +var + s: string; +begin + s := Format('%s%s', [ + XMLEncode(Params.Values['state']), + XMLEncode(Params.Values['basekeyboardid']), + XMLEncode(Params.Values['basekeyboardname']) + ]); FXMLRenderers.xRenderTemplate := 'Keyman.xsl'; FXMLRenderers.Add(TKeyboardListXMLRenderer.Create(FXMLRenderers)); @@ -138,12 +202,29 @@ begin end; procedure TAppHttpResponder.ProcessPageSplash; +var + xml: string; begin + xml := + ''+ + xmlencode(TLocaleStrings.MsgFromIdFormat(FXMLRenderers.kmcom, SKSplashVersion, [CKeymanVersionInfo.VersionWithTag]))+ + ''; + FXMLRenderers.xRenderTemplate := 'Splash.xsl'; FXMLRenderers.Clear; - FXMLRenderers.Add(TGenericXMLRenderer.Create(FXMLRenderers)); + FXMLRenderers.Add(TGenericXMLRenderer.Create(FXMLRenderers, xml)); FXMLRenderers.Add(TKeyboardListXMLRenderer.Create(FXMLRenderers)); - ProcessXMLPage(''); + ProcessXMLPage; +end; + +procedure TAppHttpResponder.ProcessPageBaseKeyboard; +var + xml: string; +begin + xml := TBaseKeyboards.EnumerateXML(FXMLRenderers.kmcom.Options['koBaseLayout'].Value); + FXMLRenderers.xRenderTemplate := 'basekeyboard.xsl'; + FXMLRenderers.Add(TGenericXMLRenderer.Create(FXMLRenderers, xml)); + ProcessXMLPage; end; procedure TAppHttpResponder.ProcessXMLPage(const s: string); @@ -166,4 +247,11 @@ begin FResponseInfo.ContentStream.Position := 0; end; +class procedure TAppHttpResponder.Register(const page: string; ClassType: TAppHttpResponderClass); +begin + if not Assigned(FRegisteredClasses) then + FRegisteredClasses := TDictionary.Create; + FRegisteredClasses.Add(page, ClassType); +end; + end. diff --git a/windows/src/desktop/kmshell/web/Keyman.Configuration.System.HttpServer.SharedData.pas b/windows/src/desktop/kmshell/web/Keyman.Configuration.System.HttpServer.SharedData.pas new file mode 100644 index 0000000000..669818e4e3 --- /dev/null +++ b/windows/src/desktop/kmshell/web/Keyman.Configuration.System.HttpServer.SharedData.pas @@ -0,0 +1,75 @@ +unit Keyman.Configuration.System.HttpServer.SharedData; + +interface + +// +// This unit is transitional but will probably live a while. It contains data +// shared between UI and http response threads. Required usage model: the +// owner dialog sets the data, and the http response threads read them. When +// the owner dialog is destroyed, the data will soon become out of date, but +// the lifetime of the objects contained will exceed that of the owner dialog, +// so that incomplete http requests can finish safely. +// +// Interfaces are used for automatic reference counting. When the interface +// reference count is zero, it will be removed from the list automatically but +// the list will not be compacted, so indexes will never be reused within a +// single process session. +// +// Ideally, this will be refactored to make it unnecessary, but for now this +// is the cleanest refactor pathway. +// + +uses + System.Classes, + System.Generics.Collections, + System.SyncObjs; + +type + THttpServerSharedData = class + private + FData: TInterfaceList; + public + constructor Create; + destructor Destroy; override; + function Add(Data: IUnknown): Integer; + procedure Remove(Tag: Integer); + function Get(Tag: Integer): IUnknown; + end; + +implementation + +uses + System.SysUtils; + +{ THttpServerSharedData } + +function THttpServerSharedData.Add(Data: IUnknown): Integer; +begin + Result := FData.Add(Data); +end; + +procedure THttpServerSharedData.Remove(Tag: Integer); +begin + // Decrements reference count, ensures new attempts to get the data will fail + // and allowing the data to be released when all existing references disappear + FData[Tag] := nil; +end; + +constructor THttpServerSharedData.Create; +begin + inherited Create; + FData := TInterfaceList.Create; +end; + +destructor THttpServerSharedData.Destroy; +begin + FreeAndNil(FData); + inherited Destroy; +end; + +function THttpServerSharedData.Get(Tag: Integer): IUnknown; +begin + Result := FData[Tag]; +end; + +end. diff --git a/windows/src/desktop/kmshell/web/Keyman.Configuration.System.UmodWebHttpServer.dfm b/windows/src/desktop/kmshell/web/Keyman.Configuration.System.UmodWebHttpServer.dfm index eca967116a..21487c56b3 100644 --- a/windows/src/desktop/kmshell/web/Keyman.Configuration.System.UmodWebHttpServer.dfm +++ b/windows/src/desktop/kmshell/web/Keyman.Configuration.System.UmodWebHttpServer.dfm @@ -1,6 +1,7 @@ object modWebHttpServer: TmodWebHttpServer OldCreateOrder = False OnCreate = DataModuleCreate + OnDestroy = DataModuleDestroy Height = 150 Width = 215 object http: TIdHTTPServer diff --git a/windows/src/desktop/kmshell/web/Keyman.Configuration.System.UmodWebHttpServer.pas b/windows/src/desktop/kmshell/web/Keyman.Configuration.System.UmodWebHttpServer.pas index 0e14b7ed56..f8e5d19454 100644 --- a/windows/src/desktop/kmshell/web/Keyman.Configuration.System.UmodWebHttpServer.pas +++ b/windows/src/desktop/kmshell/web/Keyman.Configuration.System.UmodWebHttpServer.pas @@ -13,7 +13,8 @@ uses IdCustomTCPServer, IdHTTPServer, - Keyman.Configuration.System.HttpServer.App; + Keyman.Configuration.System.HttpServer.App, + Keyman.Configuration.System.HttpServer.SharedData; type TmodWebHttpServer = class(TDataModule) @@ -21,10 +22,13 @@ type procedure httpCommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo); procedure DataModuleCreate(Sender: TObject); + procedure DataModuleDestroy(Sender: TObject); private + FSharedData: THttpServerSharedData; function GetPort: Integer; function GetHost: string; public + property SharedData: THttpServerSharedData read FSharedData; property Port: Integer read GetPort; property Host: string read GetHost; end; @@ -51,12 +55,18 @@ procedure TmodWebHttpServer.DataModuleCreate(Sender: TObject); var b: TIdSocketHandle; begin + FSharedData := THttpServerSharedData.Create; b := http.Bindings.Add; b.Port := 8009; //0; b.IP := '127.0.0.1'; http.Active := True; end; +procedure TmodWebHttpServer.DataModuleDestroy(Sender: TObject); +begin + FreeAndNil(FSharedData); +end; + function TmodWebHttpServer.GetHost: string; begin Result := 'http://'+http.Bindings[0].IP+':'+IntToStr(http.Bindings[0].Port); @@ -74,12 +84,7 @@ var begin CoInitializeEx(nil, COINIT_APARTMENTTHREADED); try - FApp := TAppHttpResponder.Create(AContext, ARequestInfo, AResponseInfo); - try - FApp.ProcessRequest; - finally - FreeAndNil(FApp); - end; + TAppHttpResponder.DoProcessRequest(SharedData, AContext, ARequestInfo, AResponseInfo); finally CoUninitialize; end; diff --git a/windows/src/global/delphi/chromium/Keyman.UI.UframeCEFHost.pas b/windows/src/global/delphi/chromium/Keyman.UI.UframeCEFHost.pas index 7c4719057d..935a6479ad 100644 --- a/windows/src/global/delphi/chromium/Keyman.UI.UframeCEFHost.pas +++ b/windows/src/global/delphi/chromium/Keyman.UI.UframeCEFHost.pas @@ -397,9 +397,15 @@ begin end; end; -function IsLocalURL(URL: WideString): Boolean; +function IsLocalURL(URL: string): Boolean; begin - Result := (Copy(URL, 1, 5) = 'file:') or (Copy(URL, 1, 1) = '/'); + Result := + URL.StartsWith('file:') or + URL.StartsWith('/') or + URL.StartsWith('http://localhost:') or + URL.StartsWith('http://localhost/') or + URL.StartsWith('http://127.0.0.1:') or + URL.StartsWith('http://127.0.0.1/'); end; procedure TframeCEFHost.Handle_CEF_BEFOREBROWSE(var message: TMessage); diff --git a/windows/src/global/delphi/cust/Keyman.System.LocaleStrings.pas b/windows/src/global/delphi/cust/Keyman.System.LocaleStrings.pas new file mode 100644 index 0000000000..f0134574aa --- /dev/null +++ b/windows/src/global/delphi/cust/Keyman.System.LocaleStrings.pas @@ -0,0 +1,46 @@ +unit Keyman.System.LocaleStrings; + +interface + +uses + keymanapi_TLB, + MessageIdentifierConsts; + +type + TLocaleStrings = class + class function MsgFromId(kmcom: IKeyman; const msgid: TMessageIdentifier): string; + class function MsgFromStr(kmcom: IKeyman; const str: string): string; + class function MsgFromIdFormat(kmcom: IKeyman; const msgid: TMessageIdentifier; const args: array of const): string; + end; + +implementation + +uses + System.SysUtils, + + custinterfaces; + +class function TLocaleStrings.MsgFromStr(kmcom: IKeyman; const str: string): string; +begin + if kmcom = nil + then Result := str + else Result := Trim((kmcom.Control as IKeymanCustomisationAccess).KeymanCustomisation.CustMessages.MessageFromID(str)); +end; + +class function TLocaleStrings.MsgFromId(kmcom: IKeyman; const msgid: TMessageIdentifier): string; +begin + if kmcom = nil + then Result := IntToStr(Ord(msgid)) + else Result := Trim((kmcom.Control as IKeymanCustomisationAccess).KeymanCustomisation.CustMessages.MessageFromID(StringFromMsgId(msgid))); +end; + +class function TLocaleStrings.MsgFromIdFormat(kmcom: IKeyman; const msgid: TMessageIdentifier; const args: array of const): string; +begin + try + Result := Format(MsgFromId(kmcom, msgid), args); + except + Result := MsgFromId(kmcom, msgid) + ' (error displaying message parameters)'; + end; +end; + +end. diff --git a/windows/src/global/delphi/cust/MessageIdentifiers.pas b/windows/src/global/delphi/cust/MessageIdentifiers.pas index 57327afcb0..f8a6ccf8ab 100644 --- a/windows/src/global/delphi/cust/MessageIdentifiers.pas +++ b/windows/src/global/delphi/cust/MessageIdentifiers.pas @@ -22,7 +22,6 @@ unit MessageIdentifiers; interface uses - keymanapi_TLB, MessageIdentifierConsts; function MsgFromId(const msgid: TMessageIdentifier): WideString; @@ -31,30 +30,23 @@ function MsgFromIdFormat(const msgid: TMessageIdentifier; const args: array of c implementation -uses SysUtils, Unicode, kmint, custinterfaces; - +uses + kmint, + Keyman.System.LocaleStrings; function MsgFromStr(const str: WideString): WideString; begin - if kmcom = nil - then Result := str - else Result := Trim(kmint.KeymanCustomisation.CustMessages.MessageFromID(str)); + Result := TLocaleStrings.MsgFromStr(kmcom, str); end; function MsgFromId(const msgid: TMessageIdentifier): WideString; begin - if kmcom = nil - then Result := IntToStr(Ord(msgid)) - else Result := Trim(kmint.KeymanCustomisation.CustMessages.MessageFromID(StringFromMsgId(msgid))); + Result := TLocaleStrings.MsgFromId(kmcom, msgid); end; function MsgFromIdFormat(const msgid: TMessageIdentifier; const args: array of const): WideString; begin - try - Result := WideFormat(MsgFromId(msgid), args); - except - Result := MsgFromId(msgid) + ' (error displaying message parameters)'; - end; + Result := TLocaleStrings.MsgFromIdFormat(kmcom, msgid, args); end; end. diff --git a/windows/src/global/delphi/hints/UfrmHint.pas b/windows/src/global/delphi/hints/UfrmHint.pas index c621b1627f..7f8f9b2a75 100644 --- a/windows/src/global/delphi/hints/UfrmHint.pas +++ b/windows/src/global/delphi/hints/UfrmHint.pas @@ -55,7 +55,7 @@ implementation {$R *.dfm} uses - Hints, XMLRenderer, GenericXMLRenderer; + Hints; procedure TfrmHint.FireCommand(const command: WideString; params: TStringList); diff --git a/windows/src/global/delphi/ui/UfrmWebContainer.pas b/windows/src/global/delphi/ui/UfrmWebContainer.pas index e402666c0d..54e40aa631 100644 --- a/windows/src/global/delphi/ui/UfrmWebContainer.pas +++ b/windows/src/global/delphi/ui/UfrmWebContainer.pas @@ -49,17 +49,13 @@ interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, UfrmKeymanBase, - XMLRenderer, keymanapi_TLB, UserMessages, TempFileManager, Keyman.UI.UframeCEFHost; + keymanapi_TLB, UserMessages, TempFileManager, Keyman.UI.UframeCEFHost; type TfrmWebContainer = class(TfrmKeymanBase) procedure TntFormCreate(Sender: TObject); - procedure TntFormDestroy(Sender: TObject); private FDialogName: WideString; -// FXMLRenderers: TXMLRenderers; -// FXMLFileName: TTempFile; -// FNoMoreErrors: Boolean; // I4181 procedure WMUser_FormShown(var Message: TMessage); message WM_USER_FormShown; procedure WMUser_ContentRender(var Message: TMessage); message WM_USER_ContentRender; procedure DownloadUILanguages; @@ -84,8 +80,7 @@ type procedure UILanguage(params: TStringList); - procedure Content_Render(FRefreshKeyman: Boolean = False; const AdditionalData: WideString = ''); virtual; -// property XMLRenderers: TXMLRenderers read FXMLRenderers; + procedure Content_Render(FRefreshKeyman: Boolean = False; const Query: string = ''); virtual; procedure WndProc(var Message: TMessage); override; // I2720 public constructor Create(AOwner: TComponent); override; @@ -107,6 +102,8 @@ var implementation uses + System.StrUtils, + uCEFConstants, uCEFInterfaces, uCEFTypes, @@ -132,14 +129,13 @@ begin end; procedure TfrmWebContainer.Content_Render(FRefreshKeyman: Boolean; - const AdditionalData: WideString); + const Query: string); var FWidth, FHeight: Integer; begin // FreeAndNil(FXMLFileName); // I4181 - // TODO: change this to use the same as FRenderPage - FDialogName := FRenderPage; // ChangeFileExt(ExtractFileName(FXMLRenderers.xRenderTemplate), ''); + FDialogName := FRenderPage; HelpType := htKeyword; HelpKeyword := FDialogName; @@ -153,7 +149,7 @@ begin ClientHeight := FHeight; end; - cef.Navigate(modWebHttpServer.Host + '/page/'+FRenderPage); // FXMLFileName.Name); + cef.Navigate(modWebHttpServer.Host + '/page/'+FRenderPage+IfThen(Query='','','?'+Query)); // FXMLFileName.Name); end; procedure TfrmWebContainer.Do_Content_Render(FRefreshKeyman: Boolean); @@ -235,13 +231,6 @@ begin end; end; -procedure TfrmWebContainer.TntFormDestroy(Sender: TObject); -begin - inherited; -// FXMLRenderers.Free; -// FreeAndNil(FXMLFileName); // I4181 -end; - procedure TfrmWebContainer.DownloadUILanguages; begin if Assigned(FOnDownloadLocale) then diff --git a/windows/src/global/delphi/ui/XMLRenderer.pas b/windows/src/global/delphi/ui/XMLRenderer.pas index 4553cf31d6..31f553241d 100644 --- a/windows/src/global/delphi/ui/XMLRenderer.pas +++ b/windows/src/global/delphi/ui/XMLRenderer.pas @@ -288,11 +288,13 @@ begin end; function TXMLRenderers.GetXMLTemplatePath(const FileName: WideString): WideString; -var - Customisation: IKeymanCustomisation; - CustMessages: IKeymanCustomisationMessages; +//var +// Customisation: IKeymanCustomisation; +// CustMessages: IKeymanCustomisationMessages; begin - Customisation := (kmcom.Control as IKeymanCustomisationAccess).KeymanCustomisation; + Result := TKeymanPaths.KeymanConfigStaticHttpFilesPath; + + {Customisation := (kmcom.Control as IKeymanCustomisationAccess).KeymanCustomisation; CustMessages := Customisation.CustMessages; with CustMessages do begin @@ -301,7 +303,7 @@ begin if (ExtractFileName(Result) = 'locale.xml') and FileExists(ExtractFilePath(Result) + '\'+FileName) then Result := ExtractFilePath(Result) + '\' else Result := OldXMLTemplatePath; - end; + end;} end; end.