From e4baa63b892d85f8929d209c4f7fb43f6b237a48 Mon Sep 17 00:00:00 2001 From: sekelsenmat Date: Mon, 16 Sep 2013 11:07:57 +0000 Subject: [PATCH] fpbrowser: Adds a module for testing HTTP commands git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@2792 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- applications/fpbrowser/browsermodules.pas | 32 +++++- applications/fpbrowser/fpbrowser.dpr | 4 +- applications/fpbrowser/fpbrowser.lpi | 9 +- applications/fpbrowser/mainform.pas | 60 ++++++++-- applications/fpbrowser/mod_testhttp.lfm | 91 +++++++++++++++ applications/fpbrowser/mod_testhttp.lrs | 32 ++++++ applications/fpbrowser/mod_testhttp.pas | 129 ++++++++++++++++++++++ 7 files changed, 343 insertions(+), 14 deletions(-) create mode 100644 applications/fpbrowser/mod_testhttp.lfm create mode 100644 applications/fpbrowser/mod_testhttp.lrs create mode 100644 applications/fpbrowser/mod_testhttp.pas diff --git a/applications/fpbrowser/browsermodules.pas b/applications/fpbrowser/browsermodules.pas index 1896fa447..1bc1a9647 100644 --- a/applications/fpbrowser/browsermodules.pas +++ b/applications/fpbrowser/browsermodules.pas @@ -5,10 +5,13 @@ unit browsermodules; interface uses - Classes, SysUtils; + Classes, SysUtils; type + TBrowserModuleUIElement = (bmueEnabledDisableMenu, bmueCommandsSubmenu); + TBrowserModuleUIElements = set of TBrowserModuleUIElement; + { TBrowserModule } TBrowserModule = class @@ -16,7 +19,14 @@ type ShortDescription: string; Activated: Boolean; constructor Create; virtual; + // + function GetModuleUIElements(): TBrowserModuleUIElements; virtual; + // For active/disabled modules function HandleOnPageLoad(AInput: string; out AOutput: string): Boolean; virtual; + // For expansions + function GetCommandCount: Integer; virtual; + function GetCommandName(AID: Integer): string; virtual; + procedure ExecuteCommand(AID: Integer); virtual; end; procedure RegisterBrowserModule(AModule: TBrowserModule); @@ -52,12 +62,32 @@ begin end; +function TBrowserModule.GetModuleUIElements: TBrowserModuleUIElements; +begin + Result := [bmueEnabledDisableMenu]; +end; + function TBrowserModule.HandleOnPageLoad(AInput: string; out AOutput: string): Boolean; begin AOutput := ''; Result := False; end; +function TBrowserModule.GetCommandCount: Integer; +begin + Result := 0; +end; + +function TBrowserModule.GetCommandName(AID: Integer): string; +begin + Result := ''; +end; + +procedure TBrowserModule.ExecuteCommand(AID: Integer); +begin + +end; + initialization gBrowserModules := TList.Create; finalization diff --git a/applications/fpbrowser/fpbrowser.dpr b/applications/fpbrowser/fpbrowser.dpr index 40d412ac9..cdfea5634 100644 --- a/applications/fpbrowser/fpbrowser.dpr +++ b/applications/fpbrowser/fpbrowser.dpr @@ -25,12 +25,14 @@ uses {$ifdef FPBROWSER_TURBOPOWERIPRO} viewer_ipro, {$endif} - browserviewer, mod_braille, browserconstants, dlgconfig, browserconfig; + browserviewer, mod_braille, browserconstants, dlgconfig, browserconfig, + mod_testhttp; begin Application.Initialize; Application.CreateForm(TformBrowser, formBrowser); Application.CreateForm(TSubmitForm, SubmitForm); Application.CreateForm(TformConfig, formConfig); + Application.CreateForm(TformTestHttp, formTestHttp); Application.Run; end. diff --git a/applications/fpbrowser/fpbrowser.lpi b/applications/fpbrowser/fpbrowser.lpi index e4d068213..c9f0219e5 100644 --- a/applications/fpbrowser/fpbrowser.lpi +++ b/applications/fpbrowser/fpbrowser.lpi @@ -92,7 +92,7 @@ - + @@ -174,6 +174,13 @@ + + + + + + + diff --git a/applications/fpbrowser/mainform.pas b/applications/fpbrowser/mainform.pas index 685bb428a..83efc0c01 100644 --- a/applications/fpbrowser/mainform.pas +++ b/applications/fpbrowser/mainform.pas @@ -123,6 +123,7 @@ type procedure InitializeForm(); procedure UpdateModulesMenu(); procedure HandleModuleMenuItemClick(Sender: TObject); + procedure HandleModuleCommandMenuItemClick(Sender: TObject); function GetCurrentPageLoader: TPageLoader; procedure HandlePageChanged(Sender: TObject); public @@ -310,9 +311,10 @@ end; procedure TformBrowser.UpdateModulesMenu; var - lItem: TMenuItem; + lItem, lSubItem: TMenuItem; lModule: TBrowserModule; - i: Integer; + i, j: Integer; + lModuleUIElements: TBrowserModuleUIElements; begin // First remove any existing modules menuToolsModules.Clear; @@ -320,12 +322,36 @@ begin // Now add all modules and their state for i := 0 to GetBrowserModuleCount() - 1 do begin - lModule := GetBrowserModule(0); - lItem := TMenuItem.Create(nil); - lItem.Caption := lModule.ShortDescription; - lItem.Checked := lModule.Activated; - lItem.OnClick := HandleModuleMenuItemClick; - menuToolsModules.Add(lItem); + lModule := GetBrowserModule(i); + + lModuleUIElements := lModule.GetModuleUIElements(); + + // ---- + if bmueEnabledDisableMenu in lModuleUIElements then + begin + lItem := TMenuItem.Create(nil); + lItem.Caption := lModule.ShortDescription; + lItem.Checked := lModule.Activated; + lItem.OnClick := HandleModuleMenuItemClick; + menuToolsModules.Add(lItem); + end; + // ---- + if bmueCommandsSubmenu in lModuleUIElements then + begin + lItem := TMenuItem.Create(nil); + lItem.Caption := Format('Commands from module %s', [lModule.ShortDescription]); + + for j := 0 to lModule.GetCommandCount()-1 do + begin + lSubItem := TMenuItem.Create(nil); + lSubItem.Caption := lModule.GetCommandName(j); + lSubItem.OnClick := HandleModuleCommandMenuItemClick; + lSubItem.Tag := PtrInt(lModule); + lItem.Add(lSubItem); + end; + + menuToolsModules.Add(lItem); + end; end; end; @@ -344,6 +370,18 @@ begin lModule.Activated := lNewState; end; +procedure TformBrowser.HandleModuleCommandMenuItemClick(Sender: TObject); +var + lItem: TMenuItem; + lCommandNum: Integer; + lModule: TBrowserModule; +begin + lItem := Sender as TMenuItem; + lModule := TBrowserModule(lItem.Tag); + lCommandNum := lItem.Parent.IndexOf(lItem); + lModule.ExecuteCommand(lCommandNum); +end; + function TformBrowser.GetCurrentPageLoader: TPageLoader; var lViewer: TBrowserViewer; @@ -920,13 +958,13 @@ begin Pt1 := Viewer.ScreenToClient(Pt); TitleStr := Viewer.TitleAttr; if (TitleStr = '') or not PtInRect(Viewer.ClientRect, Pt1)then - begin + begin OldTitle := ''; CloseAll; Exit; - end; + end; if TitleStr <> OldTitle then - begin + begin TimerCount := 0; OldTitle := TitleStr; HintWindow.ReleaseHandle; diff --git a/applications/fpbrowser/mod_testhttp.lfm b/applications/fpbrowser/mod_testhttp.lfm new file mode 100644 index 000000000..1df2842bc --- /dev/null +++ b/applications/fpbrowser/mod_testhttp.lfm @@ -0,0 +1,91 @@ +object formTestHttp: TformTestHttp + Left = 241 + Height = 401 + Top = 145 + Width = 462 + Caption = 'formTestHttp' + ClientHeight = 401 + ClientWidth = 462 + LCLVersion = '1.1' + object buttonVideoHEADTest: TButton + Left = 8 + Height = 25 + Top = 88 + Width = 195 + Caption = 'Test HTTP HEAD to Video' + OnClick = buttonVideoHEADTestClick + TabOrder = 0 + end + object memoTestHttpDebug: TMemo + Left = 8 + Height = 274 + Top = 120 + Width = 448 + Lines.Strings = ( + 'memoTestHttpDebug' + ) + ScrollBars = ssVertical + TabOrder = 1 + end + object Label1: TLabel + Left = 10 + Height = 15 + Top = 11 + Width = 24 + Caption = 'URL:' + ParentColor = False + end + object comboURL: TComboBox + Left = 40 + Height = 23 + Top = 8 + Width = 416 + ItemHeight = 15 + ItemIndex = 0 + Items.Strings = ( + 'http://file31.content-video.ru/Volume18/mp4/2013/08/20/2013_08_20_RIAMERCEDESmix1_mwyitzcc.0il.mp4' + ) + TabOrder = 2 + Text = 'http://file31.content-video.ru/Volume18/mp4/2013/08/20/2013_08_20_RIAMERCEDESmix1_mwyitzcc.0il.mp4' + end + object Label2: TLabel + Left = 10 + Height = 15 + Top = 36 + Width = 61 + Caption = 'User Agent:' + ParentColor = False + end + object comboUserAgent: TComboBox + Left = 80 + Height = 23 + Top = 32 + Width = 376 + ItemHeight = 15 + ItemIndex = 3 + Items.Strings = ( + 'FPBrowser/1.0 (Mobile; U; en-GB)' + 'Opera/9.80 (iPhone; Opera Mini/6.5.1.23995/27.1227; U; pt) Presto/2.8.119 Version/11.10' + 'Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.7.12) Gecko/20060101 Firefox/1.0.8' + 'Mozilla/5.0 (Windows NT 6.1; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/29.0.1547.66 Safari/537.36' + ) + TabOrder = 3 + Text = 'Mozilla/5.0 (Windows NT 6.1; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/29.0.1547.66 Safari/537.36' + end + object Label3: TLabel + Left = 10 + Height = 15 + Top = 64 + Width = 32 + Caption = 'Proxy:' + ParentColor = False + end + object editProxy: TEdit + Left = 81 + Height = 23 + Top = 58 + Width = 168 + TabOrder = 4 + Text = 'editProxy' + end +end diff --git a/applications/fpbrowser/mod_testhttp.lrs b/applications/fpbrowser/mod_testhttp.lrs new file mode 100644 index 000000000..74dfd7f54 --- /dev/null +++ b/applications/fpbrowser/mod_testhttp.lrs @@ -0,0 +1,32 @@ +{ This is an automatically generated lazarus resource file } + +LazarusResources.Add('TformTestHttp','FORMDATA',[ + 'TPF0'#13'TformTestHttp'#12'formTestHttp'#4'Left'#3#241#0#6'Height'#3#145#1#3 + +'Top'#3#145#0#5'Width'#3#206#1#7'Caption'#6#12'formTestHttp'#12'ClientHeight' + +#3#145#1#11'ClientWidth'#3#206#1#10'LCLVersion'#6#3'1.1'#0#7'TButton'#19'but' + +'tonVideoHEADTest'#4'Left'#2#8#6'Height'#2#25#3'Top'#2'X'#5'Width'#3#195#0#7 + +'Caption'#6#23'Test HTTP HEAD to Video'#7'OnClick'#7#24'buttonVideoHEADTestC' + +'lick'#8'TabOrder'#2#0#0#0#5'TMemo'#17'memoTestHttpDebug'#4'Left'#2#8#6'Heig' + +'ht'#3#18#1#3'Top'#2'x'#5'Width'#3#192#1#13'Lines.Strings'#1#6#17'memoTestHt' + +'tpDebug'#0#10'ScrollBars'#7#10'ssVertical'#8'TabOrder'#2#1#0#0#6'TLabel'#6 + +'Label1'#4'Left'#2#10#6'Height'#2#15#3'Top'#2#11#5'Width'#2#24#7'Caption'#6#4 + +'URL:'#11'ParentColor'#8#0#0#9'TComboBox'#8'comboURL'#4'Left'#2'('#6'Height' + +#2#23#3'Top'#2#8#5'Width'#3#160#1#10'ItemHeight'#2#15#9'ItemIndex'#2#0#13'It' + +'ems.Strings'#1#6'bhttp://file31.content-video.ru/Volume18/mp4/2013/08/20/20' + +'13_08_20_RIAMERCEDESmix1_mwyitzcc.0il.mp4'#0#8'TabOrder'#2#2#4'Text'#6'bhtt' + +'p://file31.content-video.ru/Volume18/mp4/2013/08/20/2013_08_20_RIAMERCEDESm' + +'ix1_mwyitzcc.0il.mp4'#0#0#6'TLabel'#6'Label2'#4'Left'#2#10#6'Height'#2#15#3 + +'Top'#2'$'#5'Width'#2'='#7'Caption'#6#11'User Agent:'#11'ParentColor'#8#0#0#9 + +'TComboBox'#14'comboUserAgent'#4'Left'#2'P'#6'Height'#2#23#3'Top'#2' '#5'Wid' + +'th'#3'x'#1#10'ItemHeight'#2#15#9'ItemIndex'#2#3#13'Items.Strings'#1#6' FPBr' + +'owser/1.0 (Mobile; U; en-GB)'#6'WOpera/9.80 (iPhone; Opera Mini/6.5.1.23995' + +'/27.1227; U; pt) Presto/2.8.119 Version/11.10'#6'OMozilla/5.0 (X11; U; Linu' + +'x i686; en-US; rv:1.7.12) Gecko/20060101 Firefox/1.0.8'#6'lMozilla/5.0 (Win' + +'dows NT 6.1; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/29.0.1547' + +'.66 Safari/537.36'#0#8'TabOrder'#2#3#4'Text'#6'lMozilla/5.0 (Windows NT 6.1' + +'; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/29.0.1547.66 Safari/' + +'537.36'#0#0#6'TLabel'#6'Label3'#4'Left'#2#10#6'Height'#2#15#3'Top'#2'@'#5'W' + +'idth'#2' '#7'Caption'#6#6'Proxy:'#11'ParentColor'#8#0#0#5'TEdit'#9'editProx' + +'y'#4'Left'#2'Q'#6'Height'#2#23#3'Top'#2':'#5'Width'#3#168#0#8'TabOrder'#2#4 + +#4'Text'#6#9'editProxy'#0#0#0 +]); diff --git a/applications/fpbrowser/mod_testhttp.pas b/applications/fpbrowser/mod_testhttp.pas new file mode 100644 index 000000000..d24096285 --- /dev/null +++ b/applications/fpbrowser/mod_testhttp.pas @@ -0,0 +1,129 @@ +unit mod_testhttp; + +{$mode delphi} + +interface + +uses + Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, + StdCtrls, + browsermodules, browserconfig; + +type + + { TformTestHttp } + + TformTestHttp = class(TForm) + buttonVideoHEADTest: TButton; + comboUserAgent: TComboBox; + comboURL: TComboBox; + editProxy: TEdit; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + memoTestHttpDebug: TMemo; + procedure buttonVideoHEADTestClick(Sender: TObject); + private + { private declarations } + public + { public declarations } + end; + + { TTestHttpBrowserModule } + + TTestHttpBrowserModule = class(TBrowserModule) + public + constructor Create; override; + function GetModuleUIElements(): TBrowserModuleUIElements; override; + // For expansions + function GetCommandCount: Integer; override; + function GetCommandName(AID: Integer): string; override; + procedure ExecuteCommand(AID: Integer); override; + end; + +var + formTestHttp: TformTestHttp; + +implementation + +uses httpsend; + +{ TformTestHttp } + +procedure TformTestHttp.buttonVideoHEADTestClick(Sender: TObject); +var + Client: THttpSend; + ContentsList: TStringList; + AURL: string; +begin + AURL := comboURL.Text; + + Client := THttpSend.Create; + ContentsList := TStringList.Create; + try + Client.Headers.Add('Accept: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8'); + Client.Headers.Add('Accept-Language: en-gb,en;q=0.5'); + //Client.Headers.Add('Accept-Encoding: gzip,deflate'); + Client.Headers.Add('Accept-Charset: utf-8;q=0.7,*;q=0.7'); // ISO-8859-1, + Client.UserAgent := comboUserAgent.Text; + if editProxy.Text <> '' then + begin + Client.ProxyHost := editProxy.Text; + Client.ProxyPort := '80'; + end; + + Client.HttpMethod('GET', AURL); + +// Client.Headers; + + Client.Document.Position := 0; + ContentsList.Clear(); + ContentsList.LoadFromStream(Client.Document); + memoTestHttpDebug.Clear(); + memoTestHttpDebug.Lines.Add(Format('Loading page: %s', [AURL])); + memoTestHttpDebug.Lines.Add(''); + memoTestHttpDebug.Lines.Add('HTTP Headers:'); + memoTestHttpDebug.Lines.Add(''); + memoTestHttpDebug.Lines.AddStrings(Client.Headers); + memoTestHttpDebug.Lines.Add(''); + finally + ContentsList.Free; + Client.Free; + end; +end; + +{ TTestHttpBrowserModule } + +constructor TTestHttpBrowserModule.Create; +begin + inherited Create; + + ShortDescription := 'HTTP Test'; +end; + +function TTestHttpBrowserModule.GetModuleUIElements: TBrowserModuleUIElements; +begin + Result := [bmueCommandsSubmenu]; +end; + +function TTestHttpBrowserModule.GetCommandCount: Integer; +begin + Result := 1; +end; + +function TTestHttpBrowserModule.GetCommandName(AID: Integer): string; +begin + Result := 'HTTP Test Dialog'; +end; + +procedure TTestHttpBrowserModule.ExecuteCommand(AID: Integer); +begin + formTestHttp.ShowModal(); +end; + +initialization + {$I mod_testhttp.lrs} + + RegisterBrowserModule(TTestHttpBrowserModule.Create()); +end. +