Turbopower_ipro: New files for Iphttpbroker and its example from Silvio Clécio. Issue #29483.

git-svn-id: trunk@51387 -
This commit is contained in:
juha 2016-01-23 17:20:09 +00:00
parent 6fe2a8440e
commit 51be79de05
7 changed files with 590 additions and 0 deletions

6
.gitattributes vendored
View File

@ -4269,6 +4269,10 @@ components/turbopower_ipro/design/Makefile.fpc svneol=native#text/plain
components/turbopower_ipro/design/ipidehtmlcontrol.pas svneol=native#text/plain
components/turbopower_ipro/design/turbopoweriprodsgn.lpk svneol=native#text/plain
components/turbopower_ipro/design/turbopoweriprodsgn.pas svneol=native#text/plain
components/turbopower_ipro/examples/browser.lpi svneol=native#text/plain
components/turbopower_ipro/examples/browser.lpr svneol=native#text/pascal
components/turbopower_ipro/examples/browserfrm.lfm svneol=native#text/plain
components/turbopower_ipro/examples/browserfrm.pas svneol=native#text/pascal
components/turbopower_ipro/examples/defaultimage.res -text
components/turbopower_ipro/examples/defaultimage.xpm -text svneol=unset#image/pixmap
components/turbopower_ipro/examples/fpdoc.css svneol=native#text/plain
@ -4303,6 +4307,7 @@ components/turbopower_ipro/iphtmlpv.lfm svneol=native#text/plain
components/turbopower_ipro/iphtmlpv.pas svneol=native#text/pascal
components/turbopower_ipro/iphtmltablelayout.pas svneol=native#text/pascal
components/turbopower_ipro/iphtmltablist.pas svneol=native#text/plain
components/turbopower_ipro/iphttpbroker.pas svneol=native#text/pascal
components/turbopower_ipro/ipmsg.pas svneol=native#text/pascal
components/turbopower_ipro/ipstrms.pas svneol=native#text/pascal
components/turbopower_ipro/iputils.pas svneol=native#text/pascal
@ -4339,6 +4344,7 @@ components/turbopower_ipro/languages/iputils.uk.po svneol=native#text/plain
components/turbopower_ipro/languages/iputils.zh_CN.po svneol=native#text/plain
components/turbopower_ipro/tipfiledataprovider.png -text svneol=unset#image/png
components/turbopower_ipro/tiphtmlpanel.png -text svneol=unset#image/png
components/turbopower_ipro/tiphttpdataprovider.png -text svneol=unset#image/png
components/turbopower_ipro/turbopoweripro.lpk svneol=native#text/pascal
components/turbopower_ipro/turbopoweripro.pas svneol=native#text/plain
components/vlc/README.txt svneol=native#text/plain

View File

@ -0,0 +1,93 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
<PathDelim Value="\"/>
<General>
<Flags>
<SaveOnlyProjectUnits Value="True"/>
</Flags>
<MainUnit Value="0"/>
<Title Value="browser"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<Icon Value="0"/>
</General>
<i18n>
<EnableI18N LFM="False"/>
</i18n>
<VersionInfo>
<StringTable ProductVersion=""/>
</VersionInfo>
<BuildModes Count="1" Active="Default">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
</local>
</RunParams>
<RequiredPackages Count="2">
<Item1>
<PackageName Value="TurboPowerIPro"/>
</Item1>
<Item2>
<PackageName Value="LCL"/>
</Item2>
</RequiredPackages>
<Units Count="2">
<Unit0>
<Filename Value="browser.lpr"/>
<IsPartOfProject Value="True"/>
<UsageCount Value="20"/>
</Unit0>
<Unit1>
<Filename Value="browserfrm.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="frMain"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<IsVisibleTab Value="True"/>
<UsageCount Value="20"/>
<Loaded Value="True"/>
</Unit1>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="browser"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Debugging>
<UseExternalDbgSyms Value="True"/>
</Debugging>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

View File

@ -0,0 +1,19 @@
program browser;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, Forms, browserfrm;
{$R *.res}
begin
RequireDerivedFormResource := True;
Application.Initialize;
Application.CreateForm(TfrMain, frMain);
Application.Run;
end.

View File

@ -0,0 +1,212 @@
object frMain: TfrMain
Left = 41
Height = 314
Top = 31
Width = 591
Caption = 'IPro browser'
ClientHeight = 314
ClientWidth = 591
LCLVersion = '1.7'
object pnTop: TPanel
Left = 0
Height = 42
Top = 0
Width = 591
Align = alTop
ClientHeight = 42
ClientWidth = 591
TabOrder = 0
object btBack: TSpeedButton
Left = 5
Height = 32
Top = 5
Width = 40
Action = acBack
Align = alLeft
BorderSpacing.Around = 4
Glyph.Data = {
36060000424D3606000000000000360400002800000020000000100000000100
0800000000000002000000000000000000000000000000000000000000000000
80000080000000808000800000008000800080800000C0C0C000C0DCC000F0CA
A6000020400000206000002080000020A0000020C0000020E000004000000040
20000040400000406000004080000040A0000040C0000040E000006000000060
20000060400000606000006080000060A0000060C0000060E000008000000080
20000080400000806000008080000080A0000080C0000080E00000A0000000A0
200000A0400000A0600000A0800000A0A00000A0C00000A0E00000C0000000C0
200000C0400000C0600000C0800000C0A00000C0C00000C0E00000E0000000E0
200000E0400000E0600000E0800000E0A00000E0C00000E0E000400000004000
20004000400040006000400080004000A0004000C0004000E000402000004020
20004020400040206000402080004020A0004020C0004020E000404000004040
20004040400040406000404080004040A0004040C0004040E000406000004060
20004060400040606000406080004060A0004060C0004060E000408000004080
20004080400040806000408080004080A0004080C0004080E00040A0000040A0
200040A0400040A0600040A0800040A0A00040A0C00040A0E00040C0000040C0
200040C0400040C0600040C0800040C0A00040C0C00040C0E00040E0000040E0
200040E0400040E0600040E0800040E0A00040E0C00040E0E000800000008000
20008000400080006000800080008000A0008000C0008000E000802000008020
20008020400080206000802080008020A0008020C0008020E000804000008040
20008040400080406000804080008040A0008040C0008040E000806000008060
20008060400080606000806080008060A0008060C0008060E000808000008080
20008080400080806000808080008080A0008080C0008080E00080A0000080A0
200080A0400080A0600080A0800080A0A00080A0C00080A0E00080C0000080C0
200080C0400080C0600080C0800080C0A00080C0C00080C0E00080E0000080E0
200080E0400080E0600080E0800080E0A00080E0C00080E0E000C0000000C000
2000C0004000C0006000C0008000C000A000C000C000C000E000C0200000C020
2000C0204000C0206000C0208000C020A000C020C000C020E000C0400000C040
2000C0404000C0406000C0408000C040A000C040C000C040E000C0600000C060
2000C0604000C0606000C0608000C060A000C060C000C060E000C0800000C080
2000C0804000C0806000C0808000C080A000C080C000C080E000C0A00000C0A0
2000C0A04000C0A06000C0A08000C0A0A000C0A0C000C0A0E000C0C00000C0C0
2000C0C04000C0C06000C0C08000C0C0A000F0FBFF00A4A0A000808080000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00FDFDFDFDFDFD
FDF5F5FDFDFDFDFDFDFDFDFDFDFDFDFDFD0707FDFDFDFDFDFDFDFDFDFDFDFDFD
B51111FDFDFDFDFDFDFDFDFDFDFDFDFD07F7F7FDFDFDFDFDFDFDFDFDFDFDFDB5
196219FDFDFDFDFDFDFDFDFDFDFDFD07F707F7FDFDFDFDFDFDFDFDFDFDFDAC11
627362FDFDFDFDFDFDFDFDFDFDFD07F7070707FDFDFDFDFDFDFDFDFDFDAC1962
737361B4B4F7ACADF7FDFDFDFD07F707070707070707070707FDFDFDAC1162B3
696A61181919191951FDFDFD07F70707070707F7F7F7F7F7F7FDFDAC1162BCB3
69697272737373B462FDFD07F7070707F707070707070707F7FDB41162B3B3B3
B2686969727272B462FD07F7070707070707070707070707F7FD616AF4B3B3B3
BB696869696969B361FDF7070707070707F7070707070707F7FDFD61AABBB3B4
BCBB6968696969BB61FDFDF7070707070707F7F7F7F7F707F7FDFDFD61AABCBC
B4F4BCBCBCBCBCBC61FDFDFDF70707070707070707070707F7FDFDFDFD61AAF4
B4F561616162616262FDFDFDFDF707070707F7F7F7F7F7F7F7FDFDFDFDFD61AA
BCF561FDFDFDFDFDFDFDFDFDFDFDF7070707F7FDFDFDFDFDFDFDFDFDFDFDFD61
AAF462FDFDFDFDFDFDFDFDFDFDFDFDF70707F7FDFDFDFDFDFDFDFDFDFDFDFDFD
61AA61FDFDFDFDFDFDFDFDFDFDFDFDFDF707F7FDFDFDFDFDFDFDFDFDFDFDFDFD
FD6161FDFDFDFDFDFDFDFDFDFDFDFDFDFDF7F7FDFDFDFDFDFDFD
}
NumGlyphs = 2
end
object btForward: TSpeedButton
Left = 49
Height = 32
Top = 5
Width = 40
Action = acForward
Align = alLeft
BorderSpacing.Around = 4
Glyph.Data = {
36060000424D3606000000000000360400002800000020000000100000000100
0800000000000002000000000000000000000000000000000000000000000000
80000080000000808000800000008000800080800000C0C0C000C0DCC000F0CA
A6000020400000206000002080000020A0000020C0000020E000004000000040
20000040400000406000004080000040A0000040C0000040E000006000000060
20000060400000606000006080000060A0000060C0000060E000008000000080
20000080400000806000008080000080A0000080C0000080E00000A0000000A0
200000A0400000A0600000A0800000A0A00000A0C00000A0E00000C0000000C0
200000C0400000C0600000C0800000C0A00000C0C00000C0E00000E0000000E0
200000E0400000E0600000E0800000E0A00000E0C00000E0E000400000004000
20004000400040006000400080004000A0004000C0004000E000402000004020
20004020400040206000402080004020A0004020C0004020E000404000004040
20004040400040406000404080004040A0004040C0004040E000406000004060
20004060400040606000406080004060A0004060C0004060E000408000004080
20004080400040806000408080004080A0004080C0004080E00040A0000040A0
200040A0400040A0600040A0800040A0A00040A0C00040A0E00040C0000040C0
200040C0400040C0600040C0800040C0A00040C0C00040C0E00040E0000040E0
200040E0400040E0600040E0800040E0A00040E0C00040E0E000800000008000
20008000400080006000800080008000A0008000C0008000E000802000008020
20008020400080206000802080008020A0008020C0008020E000804000008040
20008040400080406000804080008040A0008040C0008040E000806000008060
20008060400080606000806080008060A0008060C0008060E000808000008080
20008080400080806000808080008080A0008080C0008080E00080A0000080A0
200080A0400080A0600080A0800080A0A00080A0C00080A0E00080C0000080C0
200080C0400080C0600080C0800080C0A00080C0C00080C0E00080E0000080E0
200080E0400080E0600080E0800080E0A00080E0C00080E0E000C0000000C000
2000C0004000C0006000C0008000C000A000C000C000C000E000C0200000C020
2000C0204000C0206000C0208000C020A000C020C000C020E000C0400000C040
2000C0404000C0406000C0408000C040A000C040C000C040E000C0600000C060
2000C0604000C0606000C0608000C060A000C060C000C060E000C0800000C080
2000C0804000C0806000C0808000C080A000C080C000C080E000C0A00000C0A0
2000C0A04000C0A06000C0A08000C0A0A000C0A0C000C0A0E000C0C00000C0C0
2000C0C04000C0C06000C0C08000C0C0A000F0FBFF00A4A0A000808080000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00FDFDFDFDFDFD
FDF5F5FDFDFDFDFDFDFDFDFDFDFDFDFDFD0707FDFDFDFDFDFDFDFDFDFDFDFDFD
FD1111B5FDFDFDFDFDFDFDFDFDFDFDFDFDF7F707FDFDFDFDFDFDFDFDFDFDFDFD
FD196219B5FDFDFDFDFDFDFDFDFDFDFDFDF707F707FDFDFDFDFDFDFDFDFDFDFD
FD62736211ACFDFDFDFDFDFDFDFDFDFDFD070707F707FDFDFDFDFDF7ADACF7B4
B46173736219ACFDFDFDFD07070707070707070707F707FDFDFDFD5119191919
18616A69B36211ACFDFDFDF7F7F7F7F7F70707070707F707FDFDFD62B4737373
72726969B3BC6211ACFDFDF707070707070707F7070707F707FDFD62B4727272
696968B2B3B3B36211B4FDF7070707070707070707070707F707FD61B3696969
696869BBB3B3B3F46A61FDF707070707070707070707070707F7FD61BB696969
6869BBBCB4B3BBAA61FDFDF70707F707F7F7070707070707F7FDFD61BCBCBCBC
BCBCF4B4BCBCAA61FDFDFDF70707070707070707070707F7FDFDFD6262616261
6161F5B4F4AA61FDFDFDFDF7F707F7F707F707070707F7FDFDFDFDFDFDFDFDFD
FD61F5BCAA61FDFDFDFDFDFDFDFDFDFDFDF7070707F7FDFDFDFDFDFDFDFDFDFD
FD62F4AA61FDFDFDFDFDFDFDFDFDFDFDFDF70707F7FDFDFDFDFDFDFDFDFDFDFD
FD61AA61FDFDFDFDFDFDFDFDFDFDFDFDFDF707F7FDFDFDFDFDFDFDFDFDFDFDFD
FD6161FDFDFDFDFDFDFDFDFDFDFDFDFDFDF7F7FDFDFDFDFDFDFD
}
NumGlyphs = 2
end
object edUrl: TEdit
AnchorSideLeft.Control = btForward
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = pnTop
AnchorSideTop.Side = asrCenter
AnchorSideRight.Control = btGo
Left = 93
Height = 23
Top = 10
Width = 449
Anchors = [akTop, akLeft, akRight]
ParentBidiMode = False
TabOrder = 0
Text = 'http://freepascal.org/'
end
object btGo: TSpeedButton
Left = 546
Height = 32
Top = 5
Width = 40
Action = acGo
Align = alRight
BorderSpacing.Around = 4
NumGlyphs = 2
end
end
object IpHtmlPanel1: TIpHtmlPanel
Left = 0
Height = 272
Top = 42
Width = 591
Align = alClient
DataProvider = IpHttpDataProvider1
FixedTypeface = 'Courier New'
DefaultTypeFace = 'default'
DefaultFontSize = 12
FlagErrors = False
PrintSettings.MarginLeft = 0.5
PrintSettings.MarginTop = 0.5
PrintSettings.MarginRight = 0.5
PrintSettings.MarginBottom = 0.5
TabOrder = 1
OnDocumentOpen = IpHtmlPanel1DocumentOpen
end
object IpHttpDataProvider1: TIpHttpDataProvider
left = 64
top = 64
end
object alMain: TActionList
OnUpdate = alMainUpdate
left = 160
top = 64
object acBack: TAction
Category = 'Browser'
Enabled = False
OnExecute = acBackExecute
end
object acForward: TAction
Category = 'Browser'
Enabled = False
OnExecute = acForwardExecute
end
object acGo: TAction
Category = 'Browser'
Caption = 'Go!'
OnExecute = acGoExecute
ShortCut = 13
end
end
end

View File

@ -0,0 +1,71 @@
unit browserfrm;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Iphttpbroker, IpHtml, Forms, Buttons, ExtCtrls, StdCtrls,
ActnList;
type
{ TfrMain }
TfrMain = class(TForm)
acBack: TAction;
acForward: TAction;
acGo: TAction;
alMain: TActionList;
btGo: TSpeedButton;
edUrl: TEdit;
IpHtmlPanel1: TIpHtmlPanel;
IpHttpDataProvider1: TIpHttpDataProvider;
pnTop: TPanel;
btBack: TSpeedButton;
btForward: TSpeedButton;
procedure acBackExecute(Sender: TObject);
procedure acForwardExecute(Sender: TObject);
procedure acGoExecute(Sender: TObject);
procedure alMainUpdate(AAction: TBasicAction; var Handled: Boolean);
procedure IpHtmlPanel1DocumentOpen(Sender: TObject);
end;
var
frMain: TfrMain;
implementation
{$R *.lfm}
{ TfrMain }
procedure TfrMain.IpHtmlPanel1DocumentOpen(Sender: TObject);
begin
edUrl.Text := IpHtmlPanel1.CurURL;
end;
procedure TfrMain.alMainUpdate(AAction: TBasicAction; var Handled: Boolean);
begin
acBack.Enabled := IpHtmlPanel1.CanGoBack;
acForward.Enabled := IpHtmlPanel1.CanGoForward;
acGo.Enabled := Trim(edUrl.Text) <> '';
end;
procedure TfrMain.acBackExecute(Sender: TObject);
begin
IpHtmlPanel1.GoBack;
end;
procedure TfrMain.acForwardExecute(Sender: TObject);
begin
IpHtmlPanel1.GoForward;
end;
procedure TfrMain.acGoExecute(Sender: TObject);
begin
IpHtmlPanel1.OpenURL(edUrl.Text);
end;
end.

View File

@ -0,0 +1,189 @@
(* ***** BEGIN LICENSE BLOCK *****
* Version: MPL 1.1
*
* The contents of this file are subject to the Mozilla Public License Version
* 1.1 (the "License"); you may not use this file except in compliance with
* the License. You may obtain a copy of the License at
* http://www.mozilla.org/MPL/
*
* Software distributed under the License is distributed on an "AS IS" basis,
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
* for the specific language governing rights and limitations under the
* License.
*
* The Original Code is TurboPower Internet Professional
*
* The Initial Developer of the Original Code is
* TurboPower Software
*
* Portions created by the Initial Developer are Copyright (C) 2000-2002
* the Initial Developer. All Rights Reserved.
*
* Contributor(s):
*
* Silvio Clecio - https://github.com/silvioprog
*
* ***** END LICENSE BLOCK ***** *)
(* Part of Ipbroker.pas allowing to use online files Silvio Clecio Jan 2016 *)
unit Iphttpbroker;
{$I ipdefine.inc}
interface
uses
IpFileBroker, FPHttpClient, IpMsg, IpUtils, IpHtml, Graphics, Classes;
type
{ TIpHttpClient }
TIpHttpClient = class(TFPHTTPClient)
end;
{ TIpHttpDataProvider }
TIpHttpDataProvider = class(TIpCustomHtmlDataProvider)
private
FClient: TIpHttpClient;
FDocumment: TMemoryStream;
FContentType: string;
protected
property Documment: TMemoryStream read FDocumment;
property Client: TIpHttpClient read FClient;
public
constructor Create(AOwner : TComponent); override;
destructor Destroy; override;
function GetHtmlStream(const AUrl: string;
APostData: TIpFormDataEntity): TStream; override;
{$IFDEF IP_LAZARUS}
function DoGetStream(const AUrl: string): TStream; override;
{$ENDIF}
function CheckURL(const AUrl: string;
var AContentType: string): Boolean; override;
procedure Leave(AHtml: TIpHtml); override;
procedure Reference(const AUrl: string); override;
procedure GetImage(ASender: TIpHtmlNode; const AUrl: string;
var APicture: TPicture); override;
function CanHandle(const AUrl: string): Boolean; override;
end;
procedure Register;
implementation
{ TIpHttpDataProvider }
constructor TIpHttpDataProvider.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FClient := TIpHttpClient.Create(nil);
FDocumment := TMemoryStream.Create;
HandledProtocols.Add('HTTP');
FClient.ResponseHeaders.NameValueSeparator := ':';
FClient.AllowRedirect := True;
FClient.MaxRedirects := High(Byte);
end;
destructor TIpHttpDataProvider.Destroy;
begin
FDocumment.Free;
FClient.Free;
inherited Destroy;
end;
function TIpHttpDataProvider.GetHtmlStream(const AUrl: string;
APostData: TIpFormDataEntity): TStream;
begin
Result := TMemoryStream.Create;
Result.CopyFrom(FDocumment, 0);
Result.Seek(0, soFromBeginning);
end;
{$IFDEF IP_LAZARUS}
function TIpHttpDataProvider.DoGetStream(const AUrl: string): TStream;
begin
Result := TMemoryStream.Create;
Result.CopyFrom(FDocumment, 0);
Result.Seek(0, soFromBeginning);
end;
{$ENDIF}
function TIpHttpDataProvider.CheckURL(const AUrl: string;
var AContentType: string): Boolean;
var
VAddrRec: TIpAddrRec;
begin
{$IFDEF VER2_6}
FillChar(VAddrRec, SizeOf(TIpAddrRec), 0);
{$ELSE}
VAddrRec := Default(TIpAddrRec);
{$ENDIF}
Initialize(VAddrRec);
try
IpParseURL(AUrl, VAddrRec);
FDocumment.Clear;
FClient.Get(AUrl, FDocumment);
Result := (FClient.ResponseStatusCode = 200) or
FClient.IsRedirect(FClient.ResponseStatusCode);
if Result then
begin
FContentType := FClient.ResponseHeaders.Values['Content-Type'];
AContentType := FContentType;
end;
finally
Finalize(VAddrRec);
end;
end;
procedure TIpHttpDataProvider.Leave(AHtml: TIpHtml);
begin
inherited Leave(AHtml);
end;
procedure TIpHttpDataProvider.Reference(const AUrl: string);
begin
inherited Reference(AUrl);
end;
procedure TIpHttpDataProvider.GetImage(ASender: TIpHtmlNode;
const AUrl: string; var APicture: TPicture);
var
VImgRaw: TStream;
begin
APicture := nil;
VImgRaw := TMemoryStream.Create;
try
FClient.Get(AUrl, VImgRaw);
if (FClient.ResponseStatusCode = 200) and
(Pos('image/', FClient.ResponseHeaders.Values['Content-Type']) > 0) then
try
VImgRaw.Seek(0, soFromBeginning);
APicture := TPicture.Create;
APicture.LoadFromStream(VImgRaw);
except
on EInvalidGraphic do
begin
APicture.Free;
APicture := nil;
end;
end;
finally
VImgRaw.Free;
end;
end;
function TIpHttpDataProvider.CanHandle(const AUrl: string): Boolean;
begin
Result := Assigned(FDocumment) and ((Pos('text/html', FContentType) > 0) or
(Pos('image/', FContentType) > 0));
end;
procedure Register;
begin
RegisterComponents('IPro', [TIpHttpDataProvider]);
end;
end.

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.1 KiB