mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-09 15:56:07 +02:00
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:
parent
6fe2a8440e
commit
51be79de05
6
.gitattributes
vendored
6
.gitattributes
vendored
@ -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
|
||||
|
93
components/turbopower_ipro/examples/browser.lpi
Normal file
93
components/turbopower_ipro/examples/browser.lpi
Normal 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>
|
19
components/turbopower_ipro/examples/browser.lpr
Normal file
19
components/turbopower_ipro/examples/browser.lpr
Normal 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.
|
||||
|
212
components/turbopower_ipro/examples/browserfrm.lfm
Normal file
212
components/turbopower_ipro/examples/browserfrm.lfm
Normal 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
|
71
components/turbopower_ipro/examples/browserfrm.pas
Normal file
71
components/turbopower_ipro/examples/browserfrm.pas
Normal 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.
|
||||
|
189
components/turbopower_ipro/iphttpbroker.pas
Normal file
189
components/turbopower_ipro/iphttpbroker.pas
Normal 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.
|
BIN
components/turbopower_ipro/tiphttpdataprovider.png
Normal file
BIN
components/turbopower_ipro/tiphttpdataprovider.png
Normal file
Binary file not shown.
After Width: | Height: | Size: 1.1 KiB |
Loading…
Reference in New Issue
Block a user