mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-11-04 07:43:13 +01:00
* updated icon for chm toc documents
* updated http dataprovider for lnet trunk. only enabled if the lnetvisual package is added as a requirement * some cleanup for chmcontentprovider git-svn-id: trunk@17842 -
This commit is contained in:
andrew
parent
12b34e10e0
commit
006f02864e
@ -5,6 +5,8 @@ unit chmcontentprovider;
|
||||
{$if (fpc_version=2) and (fpc_release>2) ((fpc_version=2) and (fpc_release=2) and (fpc_patch>2))}
|
||||
{$Note Compiling lhelp with search support}
|
||||
{$DEFINE CHM_SEARCH}
|
||||
{$else}
|
||||
{$Note Compiling lhelp *without* search support since your fpc version is not new enough}
|
||||
{$endif}
|
||||
|
||||
{off $DEFINE CHM_DEBUG_TIME}
|
||||
@ -341,8 +343,6 @@ begin
|
||||
end;
|
||||
|
||||
procedure TChmContentProvider.IpHtmlPanelDocumentOpen(Sender: TObject);
|
||||
var
|
||||
AChm: TChmReader;
|
||||
begin
|
||||
// StatusBar1.Panels.Items[1] := fHtml.DataProvider.;
|
||||
if fIsUsingHistory = False then
|
||||
@ -521,7 +521,6 @@ var
|
||||
SearchReader: TChmSearchReader;
|
||||
DocTitle: String;
|
||||
DocURL: String;
|
||||
TitleIndex: Integer = -1;
|
||||
i: Integer;
|
||||
j: Integer;
|
||||
k: Integer;
|
||||
@ -680,13 +679,10 @@ begin
|
||||
end;
|
||||
|
||||
procedure TChmContentProvider.GoBack;
|
||||
var
|
||||
HistoryChm: TChmReader;
|
||||
begin
|
||||
if CanGoBack then begin
|
||||
Dec(fHistoryIndex);
|
||||
fIsUsingHistory:=True;
|
||||
HistoryChm := TChmReader(fHistory.Objects[fHistoryIndex]);
|
||||
fHtml.OpenURL(fHistory.Strings[fHistoryIndex]);
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -172,16 +172,13 @@ end;
|
||||
|
||||
function TIpChmDataProvider.BuildURL(const OldURL, NewURL: string): string;
|
||||
var
|
||||
tmp: String;
|
||||
X: LongInt;
|
||||
fOldUrl: String;
|
||||
fNewURL: String;
|
||||
ParentDirs: TStringList;
|
||||
RemoveDirCount: Integer;
|
||||
begin
|
||||
Result := NewURL;
|
||||
|
||||
fOldUrl := OldURL;
|
||||
fNewURL := NewURL;
|
||||
if Pos('ms-its:', NewURL) = 1 then
|
||||
Exit;
|
||||
|
||||
@ -145,6 +145,8 @@ begin
|
||||
end;
|
||||
TreeNode.Url := NodeInfo.Url;
|
||||
TreeNode.Data := fChm;
|
||||
TreeNode.ImageIndex := 3;
|
||||
TreeNode.SelectedIndex := 3;
|
||||
Inc(X, NodeInfo.LineCount);
|
||||
except
|
||||
// an exception can occur if we have closed the file while the toc is still being read
|
||||
@ -180,7 +182,6 @@ end;
|
||||
function TContentsFiller.GetLIData(StartLine: Integer): TContentNode;
|
||||
var
|
||||
X: Integer;
|
||||
NameCount: Integer = 0;
|
||||
fLength: Integer;
|
||||
fPos: Integer;
|
||||
Line: String;
|
||||
@ -270,11 +271,12 @@ end;
|
||||
function TIndexFiller.GetLIEnd(StartLine: Integer): Integer;
|
||||
begin
|
||||
// for X := StartLine to
|
||||
Result := -1;
|
||||
end;
|
||||
|
||||
function TIndexFiller.GetNextLI(StartLine: Integer): Integer;
|
||||
begin
|
||||
|
||||
Result := -1;
|
||||
end;
|
||||
|
||||
function TIndexFiller.AddLIObjects(StartLine: Integer; SubItem: Boolean): Integer;
|
||||
@ -287,7 +289,7 @@ var
|
||||
fPos: Integer;
|
||||
fLength: Integer;
|
||||
Item: TIndexItem;
|
||||
X, I: LongInt;
|
||||
X: LongInt;
|
||||
begin
|
||||
for X:= StartLine to fText.Count-1 do begin
|
||||
Line := fText.Strings[X];
|
||||
|
||||
@ -31,7 +31,7 @@ type
|
||||
procedure GoBack; override;
|
||||
procedure GoForward; override;
|
||||
class function GetProperContentProvider(const AURL: String): TBaseContentProviderClass; override;
|
||||
constructor Create(AParent: TWinControl); override;
|
||||
constructor Create(AParent: TWinControl; AImageList: TImageList); override;
|
||||
|
||||
end;
|
||||
|
||||
@ -107,9 +107,9 @@ begin
|
||||
Result := THTTPContentProvider;
|
||||
end;
|
||||
|
||||
constructor THTTPContentProvider.Create(AParent: TWinControl);
|
||||
constructor THTTPContentProvider.Create(AParent: TWinControl; AImageList: TImageList);
|
||||
begin
|
||||
inherited Create(AParent);
|
||||
inherited Create(AParent, AImageList);
|
||||
fPopUp := TPopupMenu.Create(fHtml);
|
||||
fPopUp.Items.Add(TMenuItem.Create(fPopup));
|
||||
with fPopUp.Items.Items[0] do begin
|
||||
|
||||
@ -399,7 +399,7 @@ object HelpForm: THelpForm
|
||||
left = 8
|
||||
top = 80
|
||||
Bitmap = {
|
||||
4C690300000010000000100000007001E300B0CE2A000000000000000000F609
|
||||
4C690400000010000000100000007001E300B0CE2A000000000000000000F609
|
||||
0200E1281B00005959000090AF00329FCCFF75888800003A3A00000E0E00FA11
|
||||
0200FE1F0000000000000000000086180000FF3F000000000000000202006C54
|
||||
2C002BD6D4FF0088FFFF006BFFFF0067FFFF007CFFFF0095FDFF00868A00B2E3
|
||||
@ -495,7 +495,39 @@ object HelpForm: THelpForm
|
||||
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
|
||||
FFFFA6A6BBFF435D9AFF0000000000000000233858004464A0FF6C82B2FF6B82
|
||||
B2FF6A81B2FF6980B2FF687FB0FF687FB0FF677EB1FF647FB0FF647DB0FF637D
|
||||
AFFF5E77ACFF294E8FFF00000000
|
||||
AFFF5E77ACFF294E8FFF00000000A803E3000051C8000000000000000000F708
|
||||
0100EE1C0E0000313100005C7000626B9100535A9000001F1F0000070700FB10
|
||||
0100FE1F0000000000000000000086180000FF3F0000006AC9FF0091EEFF0092
|
||||
EEFF0084EAFF0084EAFF0092EEFF0084EAFF0084EAFF0080E2FF0068C00093CE
|
||||
3400FFFF00000000000000000000C1E10000FFFF000000A7FEFFCDF1FFFFCDF1
|
||||
FFFFCDF1FFFFCDF1FFFFCDF1FFFFCDF1FFFFCDF1FFFF5FDBFFFF0DACFFFF0081
|
||||
E2FFBB523E000000000000000000FC0F0000EB230D0000A7FEFFCDF1FFFFCDF1
|
||||
FFFFCDF1FFFFCDF1FFFFCDF1FFFFCDF1FFFFCDF1FFFFCDF1FFFF5BDAFFFF0FB3
|
||||
FFFF0F78D300000000000000000000000000143C7300009BFEFFCDF1FFFFCDF1
|
||||
FFFF81DAFFFF19B6FFFF00A2EEFF00A4F0FF23B9FFFFBEECFFFFCDF1FFFF5FDB
|
||||
FFFF0083E8FF0002060000000000000000001E539B00009BFEFFCDF1FFFFCDF1
|
||||
FFFF03AFFFFF009EE8FF6DD4FFFF6BD3FFFF009EE8FF17B5FFFFCDF1FFFFCDF1
|
||||
FFFF0095F4FF30518C000000000000000000225DA900009BFEFFCDF1FFFFCDF1
|
||||
FFFF009EE8FF03AFFFFFCDF1FFFFC7F0FFFF009EE8FF00A2EEFFCDF1FFFFCDF1
|
||||
FFFF0098F8FF4E65940000000000000000002667B700009BFEFFCDF1FFFFCDF1
|
||||
FFFFCDF1FFFFCDF1FFFFC9EFFFFF1BB7FFFF009EE8FF57CEFFFFCDF1FFFFCDF1
|
||||
FFFF0095F4FF546C9C0000000000000000002871C5000098F8FFCDF1FFFFCDF1
|
||||
FFFFCDF1FFFFCDF1FFFF21B8FFFF009EE8FF4BCAFFFFCDF1FFFFCDF1FFFFCDF1
|
||||
FFFF0095F2FF5C75A70000000000000000002874C9000095F4FFCDF1FFFFCDF1
|
||||
FFFFCDF1FFFFCDF1FFFF00A0EAFF009EE8FFC9EFFFFFCDF1FFFFCDF1FFFFCDF1
|
||||
FFFF008DF0FF627DAD000000000002070C002877CE000095F2FFCDF1FFFFCDF1
|
||||
FFFFCDF1FFFFCDF1FFFFCDF1FFFFCDF1FFFFCDF1FFFFCDF1FFFFCDF1FFFFCDF1
|
||||
FFFF0082E6FF6580AF0000000000091624002679D1000092EEFFCDF1FFFFCDF1
|
||||
FFFFCDF1FFFFCDF1FFFF009EE8FF009EE8FFCDF1FFFFCDF1FFFFCDF1FFFFCDF1
|
||||
FFFF0080E2FF6782B10001040800112A4200257BD6000083E8FFCDF1FFFFCDF1
|
||||
FFFFCDF1FFFFCDF1FFFF009EE8FF009EE8FFCDF1FFFFCDF1FFFFCDF1FFFFCDF1
|
||||
FFFF007CDCFF6B83AF0010263D0015395D001E79D7000080E2FFCDF1FFFFCDF1
|
||||
FFFFCDF1FFFFCDF1FFFFCDF1FFFFCDF1FFFFCDF1FFFFCDF1FFFFCDF1FFFFCDF1
|
||||
FFFF027CDCFF5974A6000A151F00071321002458AB002F6EC4FF0761C8FF005D
|
||||
C6FF005DC6FF005DC6FF005DC6FF005DC6FF005CC2FF005CC2FF005BC2FF075F
|
||||
C4FF2560B6FF435F9B000105090000000000143D6B00385C9600627CAC00627C
|
||||
AB00617BAC00607AAC005F79AA005F79AA005E79AB005C79AA005C78AA005C78
|
||||
AA005A75AA003158930003080E00
|
||||
}
|
||||
end
|
||||
end
|
||||
|
||||
@ -288,7 +288,7 @@ LazarusResources.Add('THelpForm','FORMDATA',[
|
||||
+'ist1'#7'AllocBy'#2#4#10'BlendColor'#7#6'clNone'#7'BkColor'#7#6'clNone'#12'D'
|
||||
+'rawingStyle'#7#8'dsNormal'#6'Height'#2#16#9'ImageType'#7#7'itImage'#6'Maske'
|
||||
+'d'#8#11'ShareImages'#8#5'Width'#2#16#4'left'#2#8#3'top'#2'P'#6'Bitmap'#10#14
|
||||
+#12#0#0'Li'#3#0#0#0#16#0#0#0#16#0#0#0'p'#1#227#0#176#206'*'#0#0#0#0#0#0#0#0#0
|
||||
+#16#0#0'Li'#4#0#0#0#16#0#0#0#16#0#0#0'p'#1#227#0#176#206'*'#0#0#0#0#0#0#0#0#0
|
||||
+#246#9#2#0#225'('#27#0#0'YY'#0#0#144#175#0'2'#159#204#255'u'#136#136#0#0'::'
|
||||
+#0#0#14#14#0#250#17#2#0#254#31#0#0#0#0#0#0#0#0#0#0#134#24#0#0#255'?'#0#0#0#0
|
||||
+#0#0#0#2#2#0'lT,'#0'+'#214#212#255#0#136#255#255#0'k'#255#255#0'g'#255#255#0
|
||||
@ -420,5 +420,49 @@ LazarusResources.Add('THelpForm','FORMDATA',[
|
||||
+#255#255#255#255#255#255#255#255#255#166#166#187#255'C]'#154#255#0#0#0#0#0#0
|
||||
+#0#0'#8X'#0'Dd'#160#255'l'#130#178#255'k'#130#178#255'j'#129#178#255'i'#128
|
||||
+#178#255'h'#176#255'h'#176#255'g~'#177#255'd'#176#255'd}'#176#255'c}'#175
|
||||
+#255'^w'#172#255')N'#143#255#0#0#0#0#0#0#0
|
||||
+#255'^w'#172#255')N'#143#255#0#0#0#0#168#3#227#0#0'Q'#200#0#0#0#0#0#0#0#0#0
|
||||
+#247#8#1#0#238#28#14#0#0'11'#0#0'\p'#0'bk'#145#0'SZ'#144#0#0#31#31#0#0#7#7#0
|
||||
+#251#16#1#0#254#31#0#0#0#0#0#0#0#0#0#0#134#24#0#0#255'?'#0#0#0'j'#201#255#0
|
||||
+#145#238#255#0#146#238#255#0#132#234#255#0#132#234#255#0#146#238#255#0#132
|
||||
+#234#255#0#132#234#255#0#128#226#255#0'h'#192#0#147#206'4'#0#255#255#0#0#0#0
|
||||
+#0#0#0#0#0#0#193#225#0#0#255#255#0#0#0#167#254#255#205#241#255#255#205#241
|
||||
+#255#255#205#241#255#255#205#241#255#255#205#241#255#255#205#241#255#255#205
|
||||
+#241#255#255'_'#219#255#255#13#172#255#255#0#129#226#255#187'R>'#0#0#0#0#0#0
|
||||
+#0#0#0#252#15#0#0#235'#'#13#0#0#167#254#255#205#241#255#255#205#241#255#255
|
||||
+#205#241#255#255#205#241#255#255#205#241#255#255#205#241#255#255#205#241#255
|
||||
+#255#205#241#255#255'['#218#255#255#15#179#255#255#15'x'#211#0#0#0#0#0#0#0#0
|
||||
+#0#0#0#0#0#20'<s'#0#0#155#254#255#205#241#255#255#205#241#255#255#129#218#255
|
||||
+#255#25#182#255#255#0#162#238#255#0#164#240#255'#'#185#255#255#190#236#255
|
||||
+#255#205#241#255#255'_'#219#255#255#0#131#232#255#0#2#6#0#0#0#0#0#0#0#0#0#30
|
||||
+'S'#155#0#0#155#254#255#205#241#255#255#205#241#255#255#3#175#255#255#0#158
|
||||
+#232#255'm'#212#255#255'k'#211#255#255#0#158#232#255#23#181#255#255#205#241
|
||||
+#255#255#205#241#255#255#0#149#244#255'0Q'#140#0#0#0#0#0#0#0#0#0'"]'#169#0#0
|
||||
+#155#254#255#205#241#255#255#205#241#255#255#0#158#232#255#3#175#255#255#205
|
||||
+#241#255#255#199#240#255#255#0#158#232#255#0#162#238#255#205#241#255#255#205
|
||||
+#241#255#255#0#152#248#255'Ne'#148#0#0#0#0#0#0#0#0#0'&g'#183#0#0#155#254#255
|
||||
+#205#241#255#255#205#241#255#255#205#241#255#255#205#241#255#255#201#239#255
|
||||
+#255#27#183#255#255#0#158#232#255'W'#206#255#255#205#241#255#255#205#241#255
|
||||
+#255#0#149#244#255'Tl'#156#0#0#0#0#0#0#0#0#0'(q'#197#0#0#152#248#255#205#241
|
||||
+#255#255#205#241#255#255#205#241#255#255#205#241#255#255'!'#184#255#255#0#158
|
||||
+#232#255'K'#202#255#255#205#241#255#255#205#241#255#255#205#241#255#255#0#149
|
||||
+#242#255'\u'#167#0#0#0#0#0#0#0#0#0'(t'#201#0#0#149#244#255#205#241#255#255
|
||||
+#205#241#255#255#205#241#255#255#205#241#255#255#0#160#234#255#0#158#232#255
|
||||
+#201#239#255#255#205#241#255#255#205#241#255#255#205#241#255#255#0#141#240
|
||||
+#255'b}'#173#0#0#0#0#0#2#7#12#0'(w'#206#0#0#149#242#255#205#241#255#255#205
|
||||
,#241#255#255#205#241#255#255#205#241#255#255#205#241#255#255#205#241#255#255
|
||||
+#205#241#255#255#205#241#255#255#205#241#255#255#205#241#255#255#0#130#230
|
||||
+#255'e'#128#175#0#0#0#0#0#9#22'$'#0'&y'#209#0#0#146#238#255#205#241#255#255
|
||||
+#205#241#255#255#205#241#255#255#205#241#255#255#0#158#232#255#0#158#232#255
|
||||
+#205#241#255#255#205#241#255#255#205#241#255#255#205#241#255#255#0#128#226
|
||||
+#255'g'#130#177#0#1#4#8#0#17'*B'#0'%{'#214#0#0#131#232#255#205#241#255#255
|
||||
+#205#241#255#255#205#241#255#255#205#241#255#255#0#158#232#255#0#158#232#255
|
||||
+#205#241#255#255#205#241#255#255#205#241#255#255#205#241#255#255#0'|'#220#255
|
||||
+'k'#131#175#0#16'&='#0#21'9]'#0#30'y'#215#0#0#128#226#255#205#241#255#255#205
|
||||
+#241#255#255#205#241#255#255#205#241#255#255#205#241#255#255#205#241#255#255
|
||||
+#205#241#255#255#205#241#255#255#205#241#255#255#205#241#255#255#2'|'#220#255
|
||||
+'Yt'#166#0#10#21#31#0#7#19'!'#0'$X'#171#0'/n'#196#255#7'a'#200#255#0']'#198
|
||||
+#255#0']'#198#255#0']'#198#255#0']'#198#255#0']'#198#255#0'\'#194#255#0'\'
|
||||
+#194#255#0'['#194#255#7'_'#196#255'%`'#182#255'C_'#155#0#1#5#9#0#0#0#0#0#20
|
||||
+'=k'#0'8\'#150#0'b|'#172#0'b|'#171#0'a{'#172#0'`z'#172#0'_y'#170#0'_y'#170#0
|
||||
+'^y'#171#0'\y'#170#0'\x'#170#0'\x'#170#0'Zu'#170#0'1X'#147#0#3#8#14#0#0#0#0
|
||||
]);
|
||||
|
||||
@ -17,6 +17,12 @@
|
||||
}
|
||||
unit lhelpcore;
|
||||
|
||||
{$IFDEF LNET_VISUAL}
|
||||
{$DEFINE USE_LNET} // you must manually add the lnetvisual.lpk package to the dependancy list
|
||||
{$ELSE}
|
||||
{$NOTE You can add http capability to lhelp by adding the lnetvisual package v0.6.3 or greater requirement to lhelp.}
|
||||
{$ENDIF}
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
@ -25,7 +31,7 @@ uses
|
||||
Classes, SysUtils, SimpleIPC,
|
||||
FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
|
||||
Buttons, LCLProc, StdCtrls, IpHtml, ComCtrls, ExtCtrls, Menus,
|
||||
BaseContentProvider, FileContentProvider, ChmContentProvider;
|
||||
BaseContentProvider, FileContentProvider, ChmContentProvider{$IFDEF USE_LNET}, HTTPContentProvider{$ENDIF};
|
||||
|
||||
type
|
||||
|
||||
@ -75,8 +81,6 @@ type
|
||||
|
||||
private
|
||||
{ private declarations }
|
||||
|
||||
|
||||
fServerName: String;
|
||||
fServer: TSimpleIPCServer;
|
||||
fServerTimer: TTimer;
|
||||
@ -86,6 +90,7 @@ type
|
||||
procedure StartServer(ServerName: String);
|
||||
procedure StopServer;
|
||||
procedure OpenURL(const AURL: String; AContext: THelpContext=-1);
|
||||
procedure LateOpenURL(Url: PStringItem);
|
||||
function ActivePage: TContentTab;
|
||||
procedure RefreshState;
|
||||
procedure ShowError(AError: String);
|
||||
@ -213,6 +218,8 @@ procedure THelpForm.ReadCommandLineOptions;
|
||||
var
|
||||
X: Integer;
|
||||
IsHandled: array[0..50] of boolean;
|
||||
URL: String;
|
||||
StrItem: PStringItem;
|
||||
begin
|
||||
FillChar(IsHandled, 51, 0);
|
||||
for X := 1 to ParamCount do begin
|
||||
@ -235,9 +242,12 @@ begin
|
||||
if not IsHandled[X] then begin
|
||||
//DoOpenChm(ParamStrUTF8(X));
|
||||
if Pos('://', ParamStrUTF8(X)) = 0 then
|
||||
OpenURL('file://'+ParamStrUTF8(X), fContext)
|
||||
URL := 'file://'+ParamStrUTF8(X)
|
||||
else
|
||||
OpenURL(ParamStrUTF8(X), fContext);
|
||||
URL := ParamStrUTF8(X);
|
||||
StrItem := New(PStringItem);
|
||||
StrItem^.FString := URL;
|
||||
Application.QueueAsyncCall(TDataEvent(@LateOpenURL), PtrUInt(StrItem));
|
||||
Break;
|
||||
end;
|
||||
//we reset the context because at this point the file has been loaded and the
|
||||
@ -250,7 +260,7 @@ end;
|
||||
procedure THelpForm.StartServer(ServerName: String);
|
||||
begin
|
||||
fServer := TSimpleIPCServer.Create(nil);
|
||||
fServer.ServerID := fServerName;
|
||||
fServer.ServerID := ServerName;
|
||||
fServer.Global := True;
|
||||
fServer.Active := True;
|
||||
fServerTimer := TTimer.Create(nil);
|
||||
@ -284,6 +294,7 @@ var
|
||||
fNewPage: TContentTab;
|
||||
I: Integer;
|
||||
begin
|
||||
|
||||
fURLPrefix := GetURLPrefix;
|
||||
fContentProvider := GetContentProvider(fURLPrefix);
|
||||
|
||||
@ -319,6 +330,12 @@ begin
|
||||
RefreshState;
|
||||
end;
|
||||
|
||||
procedure THelpForm.LateOpenURL ( Url: PStringItem ) ;
|
||||
begin
|
||||
OpenURL(URL^.FString, fContext);
|
||||
Dispose(Url);
|
||||
end;
|
||||
|
||||
function THelpForm.ActivePage: TContentTab;
|
||||
begin
|
||||
Result := TContentTab(PageControl.ActivePage);
|
||||
|
||||
@ -5,17 +5,28 @@ unit LNetHTTPDataProvider;
|
||||
interface
|
||||
|
||||
uses
|
||||
Forms, Classes, SysUtils, IpHtml, IpMsg, IpUtils, lnetcomponents, Graphics, lhttp;
|
||||
Forms, Classes, SysUtils, IpHtml, IpMsg, IpUtils, lnetcomponents, Graphics, lhttp, lnet;
|
||||
|
||||
type
|
||||
|
||||
TIpHTTPDataProvider = class;
|
||||
|
||||
TGettingURLCB = procedure(AProvider: TIpHTTPDataProvider; AURL: String) of object;
|
||||
|
||||
{ TIpHTTPDataProvider }
|
||||
|
||||
TIpHTTPDataProvider = class(TIpAbstractHtmlDataProvider)
|
||||
private
|
||||
fLastType: String;
|
||||
fCachedStreams: TStringList;
|
||||
fCachedEmbeddedObjects: TStringList;
|
||||
procedure AddObjectToCache(ACache: TStringList; AURL: String; AStream: TStream);
|
||||
procedure ClearCache;
|
||||
procedure ClearCachedObjects;
|
||||
function GetCachedURL(AURL: String): TStream;
|
||||
function GetCachedObject(AURL: String): TStream;
|
||||
procedure HttpError(const msg: string; aSocket: TLSocket);
|
||||
function HttpInput(ASocket: TLHTTPClientSocket; ABuffer: pchar; ASize: dword): dword;
|
||||
function HttpInput(ASocket: TLHTTPClientSocket; ABuffer: pchar; ASize: LongInt): LongInt;
|
||||
procedure HttpInputDone(ASocket: TLHTTPClientSocket);
|
||||
procedure HttpProcessHeader(ASocket: TLHTTPClientSocket);
|
||||
procedure HttpCanWrite(ASocket: TLHTTPClientSocket; var OutputEof: TWriteBlockStatus);
|
||||
@ -32,6 +43,7 @@ uses
|
||||
procedure DoReference(const URL: string); override;
|
||||
procedure DoGetImage(Sender: TIpHtmlNode; const URL: string;
|
||||
var Picture: TPicture); override;
|
||||
function DoGetStream(const URL: string): TStream; override;
|
||||
function CanHandle(const URL: string): Boolean; override;
|
||||
function BuildURL(const OldURL, NewURL: string): string; override;
|
||||
public
|
||||
@ -39,10 +51,12 @@ uses
|
||||
destructor Destroy; override;
|
||||
end;
|
||||
|
||||
TLHttpClientEx = class(TLHttpClientComponent)
|
||||
TLHttpClientEx = class(TLHTTPClientComponent)
|
||||
//TLHttpClientEx = class(TLHTTPClient)
|
||||
private
|
||||
Stream: TStream;
|
||||
Waiting: Boolean;
|
||||
HeaderOnly: Boolean;
|
||||
end;
|
||||
|
||||
|
||||
@ -60,35 +74,122 @@ uses
|
||||
|
||||
{ TIpHTTPDataProvider }
|
||||
|
||||
procedure TIpHTTPDataProvider.AddObjectToCache ( ACache: TStringList;
|
||||
AURL: String; AStream: TStream ) ;
|
||||
var
|
||||
TmpStream: TStream;
|
||||
begin
|
||||
TmpStream := TMemoryStream.Create;
|
||||
AStream.Position := 0;
|
||||
TmpStream.CopyFrom(AStream, AStream.Size);
|
||||
ACache.AddObject(AURL, TmpStream);
|
||||
AStream.Position := 0;
|
||||
end;
|
||||
|
||||
procedure TIpHTTPDataProvider.ClearCache;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
for i := 0 to fCachedStreams.Count-1 do
|
||||
if fCachedStreams.Objects[i] <> nil then
|
||||
fCachedStreams.Objects[i].Free;
|
||||
fCachedStreams.Clear;
|
||||
|
||||
end;
|
||||
|
||||
procedure TIpHTTPDataProvider.ClearCachedObjects;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
for i := 0 to fCachedStreams.Count-1 do
|
||||
if fCachedEmbeddedObjects.Objects[i] <> nil then
|
||||
fCachedEmbeddedObjects.Objects[i].Free;
|
||||
fCachedEmbeddedObjects.Clear;
|
||||
|
||||
|
||||
end;
|
||||
|
||||
function TIpHTTPDataProvider.GetCachedURL ( AURL: String ) : TStream;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
Result := nil;
|
||||
if Trim(AURL) = '' then
|
||||
Exit;
|
||||
for i := 0 to fCachedStreams.Count-1 do
|
||||
if fCachedStreams.Strings[i] = AURL then
|
||||
begin
|
||||
if fCachedStreams.Objects[i] = nil then break;
|
||||
Result := TMemoryStream.Create;
|
||||
TStream(fCachedStreams.Objects[i]).Position := 0;
|
||||
Result.CopyFrom(TStream(fCachedStreams.Objects[i]), TStream(fCachedStreams.Objects[i]).Size);
|
||||
Result.Position := 0;
|
||||
break;
|
||||
end;
|
||||
//WriteLn(AURL,' in cache = ', Result <> nil);
|
||||
if Result = nil then
|
||||
Result := GetCachedObject(AURL);
|
||||
|
||||
end;
|
||||
|
||||
function TIpHTTPDataProvider.GetCachedObject ( AURL: String ) : TStream;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
Result := nil;
|
||||
if Trim(AURL) = '' then
|
||||
Exit;
|
||||
for i := 0 to fCachedEmbeddedObjects.Count-1 do
|
||||
if fCachedEmbeddedObjects.Strings[i] = AURL then
|
||||
begin
|
||||
if fCachedEmbeddedObjects.Objects[i] = nil then break;
|
||||
Result := TMemoryStream.Create;
|
||||
TStream(fCachedEmbeddedObjects.Objects[i]).Position := 0;
|
||||
Result.CopyFrom(TStream(fCachedEmbeddedObjects.Objects[i]), TStream(fCachedEmbeddedObjects.Objects[i]).Size);
|
||||
Result.Position := 0;
|
||||
break;
|
||||
end;
|
||||
//WriteLn(AURL,' in cached objects = ', Result <> nil);
|
||||
|
||||
end;
|
||||
|
||||
procedure TIpHTTPDataProvider.HttpError(const msg: string; aSocket: TLSocket);
|
||||
begin
|
||||
TLHttpClientEx(TLHttpClientSocket(ASocket).Connection).Waiting := False;
|
||||
//WriteLn('Error occured: ', msg);
|
||||
TLHttpClientEx(ASocket.Creator).Waiting := False;
|
||||
//writeLn('Error occured: ', msg);
|
||||
|
||||
end;
|
||||
|
||||
function TIpHTTPDataProvider.HttpInput(ASocket: TLHTTPClientSocket;
|
||||
ABuffer: pchar; ASize: dword): dword;
|
||||
ABuffer: pchar; ASize: LongInt): LongInt;
|
||||
begin
|
||||
if TLHttpClientEx(ASocket.Connection).Stream = nil then
|
||||
TLHttpClientEx(ASocket.Connection).Stream := TMemoryStream.Create;
|
||||
Result := TLHttpClientEx(ASocket.Connection).Stream.Write(ABuffer^, ASize);
|
||||
//WriteLN(ASocket.Creator.ClassName);
|
||||
if TLHttpClientEx(ASocket.Creator).Stream = nil then
|
||||
TLHttpClientEx(ASocket.Creator).Stream := TMemoryStream.Create;
|
||||
Result := TLHttpClientEx(ASocket.Creator).Stream.Write(ABuffer^, ASize);
|
||||
|
||||
|
||||
end;
|
||||
|
||||
procedure TIpHTTPDataProvider.HttpInputDone(ASocket: TLHTTPClientSocket);
|
||||
begin
|
||||
TLHttpClientEx(ASocket.Connection).Waiting := False;
|
||||
TLHttpClientEx(ASocket.Creator).Waiting := False;
|
||||
aSocket.Disconnect;
|
||||
//WriteLn('InputDone');
|
||||
end;
|
||||
|
||||
procedure TIpHTTPDataProvider.HttpProcessHeader(ASocket: TLHTTPClientSocket);
|
||||
var
|
||||
i: TLHTTPParameter;
|
||||
begin
|
||||
//WriteLn('Process Header');
|
||||
//for i := Low(TLHTTPParameterArray) to High(TLHTTPParameterArray) do
|
||||
// if ASocket.Parameters[i] <> '' then
|
||||
// WriteLn(ASocket.Parameters[i]);
|
||||
//WriteLn(ASocket.Parameters[hpContentType]);
|
||||
fLastType := ASocket.Parameters[hpContentType];
|
||||
if TLHttpClientEx(ASocket.Creator).HeaderOnly then
|
||||
TLHttpClientEx(ASocket.Creator).Waiting := False;
|
||||
end;
|
||||
|
||||
procedure TIpHTTPDataProvider.HttpCanWrite(ASocket: TLHTTPClientSocket;
|
||||
@ -99,7 +200,7 @@ end;
|
||||
|
||||
procedure TIpHTTPDataProvider.HttpDisconnect(aSocket: TLSocket);
|
||||
begin
|
||||
TLHttpClientEx(TLHttpClientSocket(ASocket).Connection).Waiting := False;
|
||||
TLHttpClientEx(ASocket.Creator).Waiting := False;
|
||||
//WriteLn('Disconnected');
|
||||
end;
|
||||
|
||||
@ -110,39 +211,54 @@ var
|
||||
fHttpClient: TLHttpClientEx;
|
||||
begin
|
||||
Result := nil;
|
||||
if not GetHostAndURI(AURL, fHost, fURI) then Exit(nil);
|
||||
//WriteLn('Result := True');
|
||||
fHttpClient := TLHttpClientEx.Create(Owner);
|
||||
fHttpClient.OnInput := @HttpInput;
|
||||
fHttpClient.OnError := @HttpError;
|
||||
fHttpClient.OnDoneInput := @HttpInputDone;
|
||||
fHttpClient.OnProcessHeaders := @HttpProcessHeader;
|
||||
fHttpClient.OnCanWrite := @HttpCanWrite;
|
||||
fHttpClient.OnDisconnect := @HttpDisconnect;
|
||||
|
||||
fHttpClient.Host := fHost;
|
||||
fHttpClient.Port := 80;
|
||||
if JustHeader then
|
||||
fHttpClient.Method := hmHead
|
||||
else
|
||||
fHttpClient.Method := hmGet;
|
||||
fHttpClient.URI := fURI;
|
||||
if JustHeader = False then
|
||||
Result := GetCachedURL(AURL);
|
||||
//WriteLN('Getting: ', AURL);
|
||||
if Result = nil then
|
||||
begin
|
||||
if not GetHostAndURI(AURL, fHost, fURI) then Exit(nil);
|
||||
//WriteLn('Result := True');
|
||||
fHttpClient := TLHttpClientEx.Create(Owner);
|
||||
fHttpClient.OnInput := @HttpInput;
|
||||
fHttpClient.OnError := @HttpError;
|
||||
fHttpClient.OnDoneInput := @HttpInputDone;
|
||||
fHttpClient.OnProcessHeaders := @HttpProcessHeader;
|
||||
fHttpClient.OnCanWrite := @HttpCanWrite;
|
||||
fHttpClient.OnDisconnect := @HttpDisconnect;
|
||||
|
||||
fHttpClient.SendRequest;
|
||||
fHttpClient.Host := fHost;
|
||||
fHttpClient.Port := 80;
|
||||
fHttpClient.HeaderOnly := JustHeader;
|
||||
if JustHeader then
|
||||
fHttpClient.Method := hmHead
|
||||
else
|
||||
fHttpClient.Method := hmGet;
|
||||
fHttpClient.URI := fURI;
|
||||
|
||||
fHttpClient.Waiting := True;
|
||||
while fHttpClient.Waiting do begin
|
||||
//WriteLn('InFirstLoop');
|
||||
Application.HandleMessage;
|
||||
if csDestroying in ComponentState then Exit;
|
||||
fHttpClient.SendRequest;
|
||||
//WriteLn('Sending Request');
|
||||
|
||||
fHttpClient.Waiting := True;
|
||||
{while fHttpClient.Waiting = True do
|
||||
begin
|
||||
fHttpClient.CallAction;
|
||||
Sleep(1);
|
||||
end;}
|
||||
|
||||
while fHttpClient.Waiting do begin
|
||||
//WriteLn('InFirstLoop');
|
||||
Application.HandleMessage;
|
||||
if csDestroying in ComponentState then Exit;
|
||||
end;
|
||||
//WriteLn('LeftLoop');
|
||||
|
||||
Result:= fHttpClient.Stream;
|
||||
Result.Position := 0;
|
||||
//fDataStream.SaveToFile('temp.txt');
|
||||
//Application.Terminate;
|
||||
fHttpClient.Free;
|
||||
end;
|
||||
//WriteLn('LeftLoop');
|
||||
|
||||
Result := fHttpClient.Stream;
|
||||
Result.Position := 0;
|
||||
//fDataStream.SaveToFile('temp.txt');
|
||||
//Application.Terminate;
|
||||
fHttpClient.Free;
|
||||
end;
|
||||
|
||||
function TIpHTTPDataProvider.GetHostAndURI(const fURL: String; var AHost: String; var AURI: String): Boolean;
|
||||
@ -169,7 +285,13 @@ end;
|
||||
function TIpHTTPDataProvider.DoGetHtmlStream(const URL: string;
|
||||
PostData: TIpFormDataEntity): TStream;
|
||||
begin
|
||||
Result := GetURL(URL);
|
||||
Result := GetCachedURL(URL);
|
||||
if Result = nil then
|
||||
begin
|
||||
Result := GetURL(URL);
|
||||
if Result <> nil then
|
||||
AddObjectToCache(fCachedStreams, URL, Result);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TIpHTTPDataProvider.DoCheckURL(const URL: string;
|
||||
@ -179,14 +301,21 @@ var
|
||||
begin
|
||||
//WriteLn('Want content type: "', ContentType,'" for Url:',URL);
|
||||
Result := True;
|
||||
TmpStream := GetURL(URL, True);
|
||||
//TmpStream := GetCachedURL(URL);
|
||||
//if TmpStream = nil then
|
||||
//begin
|
||||
TmpStream := GetURL(URL, True);
|
||||
// if TmpStream <> nil then
|
||||
// AddObjectToCache(fCachedStreams, URL, TmpStream);
|
||||
//end;
|
||||
|
||||
if TmpStream <> nil then FreeAndNil(TmpStream);
|
||||
ContentType := fLastType;//}'text/html';
|
||||
end;
|
||||
|
||||
procedure TIpHTTPDataProvider.DoLeave(Html: TIpHtml);
|
||||
begin
|
||||
|
||||
ClearCache;
|
||||
end;
|
||||
|
||||
procedure TIpHTTPDataProvider.DoReference(const URL: string);
|
||||
@ -197,60 +326,50 @@ end;
|
||||
procedure TIpHTTPDataProvider.DoGetImage(Sender: TIpHtmlNode;
|
||||
const URL: string; var Picture: TPicture);
|
||||
var
|
||||
Stream: TMemoryStream = nil;
|
||||
ImageClass: TFPCustomImageReaderClass;
|
||||
ImageReader: TFPCustomImageReader;
|
||||
OutImage: TFPWriterBMP= nil;
|
||||
Img : TFPMemoryImage = nil;
|
||||
FileExt: String;
|
||||
Stream: TStream;
|
||||
FileExt: String;
|
||||
begin
|
||||
|
||||
//DebugLn('Getting Image ',(Url));
|
||||
Picture := nil;
|
||||
|
||||
FileExt := ExtractFileExt(URL);
|
||||
if FileExt[1] = '.' then Delete(FileExt,1,1);
|
||||
ImageClass := GetFPImageReaderForFileExtension(FileExt);
|
||||
|
||||
if ImageClass = nil then begin
|
||||
Stream := TMemoryStream(GetURL(URL));
|
||||
//FreeAndNil(Stream);
|
||||
Picture := TPicture.Create;
|
||||
try
|
||||
Stream := GetCachedObject(URL);
|
||||
if Stream = nil then
|
||||
begin
|
||||
Stream := GetURL(URL);
|
||||
if Stream <> nil then
|
||||
AddObjectToCache(fCachedEmbeddedObjects, URL, Stream);
|
||||
end;
|
||||
|
||||
if Pos('image/', fLastType) = 1 then FileExt := Copy(fLastType, 7, Length(fLastType));
|
||||
//FileExt := ExtractFileExt(fLastType);
|
||||
//WriteLn('Got FIleExt ',FileExt, ' for ',fLastType);
|
||||
ImageClass := GetFPImageReaderForFileExtension(FileExt);
|
||||
end;
|
||||
|
||||
//WriteLn('Getting Image ',(Url), ' Extension=',FileExt,' Image=nil=',BoolToStr(ImageClass=nil));
|
||||
if ImageClass <> nil then begin
|
||||
ImageReader := ImageClass.Create;
|
||||
if Assigned(Stream) then
|
||||
begin
|
||||
Stream.Position := 0;
|
||||
Picture.LoadFromStreamWithFileExt(Stream, FileExt);
|
||||
end
|
||||
else
|
||||
Picture.Graphic := TBitmap.Create;
|
||||
except
|
||||
try
|
||||
Picture.Free;
|
||||
finally
|
||||
Picture := TPicture.Create;
|
||||
Picture.Graphic := TBitmap.Create;
|
||||
if Stream = nil then Stream := TMemoryStream(GetURL(URL));
|
||||
if Stream = nil then exit;
|
||||
Img := TFPMemoryImage.Create(0,0);
|
||||
Img.UsePalette:=False;
|
||||
Img.LoadFromStream(Stream, ImageReader);
|
||||
Stream.Free;
|
||||
Stream := TMemoryStream.Create;
|
||||
OutImage := TFPWriterBMP.Create;
|
||||
|
||||
Img.SaveToStream(Stream, OutImage);
|
||||
|
||||
Stream.Position := 0;
|
||||
Picture.Graphic.LoadFromStream(Stream);
|
||||
|
||||
finally
|
||||
if Assigned(OutImage) then OutImage.Free;
|
||||
if Assigned(Img) then Img.Free;
|
||||
if Assigned(ImageReader) then ImageReader.Free;
|
||||
if Assigned(Stream) then Stream.Free;
|
||||
end;
|
||||
end
|
||||
else begin
|
||||
// Couldn't find the picture we wanted.
|
||||
FreeAndNil(Stream);
|
||||
Picture := nil;
|
||||
end;
|
||||
Stream.Free;
|
||||
end;
|
||||
|
||||
function TIpHTTPDataProvider.DoGetStream ( const URL: string ) : TStream;
|
||||
begin
|
||||
Result := GetCachedObject(URL);
|
||||
if Result = nil then
|
||||
begin
|
||||
Result := GetURL(URL);
|
||||
if Result <> nil then
|
||||
AddObjectToCache(fCachedEmbeddedObjects, URL, Result);
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -268,10 +387,16 @@ end;
|
||||
constructor TIpHTTPDataProvider.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
fCachedEmbeddedObjects := TStringList.Create;
|
||||
fCachedStreams := TStringList.Create;
|
||||
end;
|
||||
|
||||
destructor TIpHTTPDataProvider.Destroy;
|
||||
begin
|
||||
ClearCache;
|
||||
ClearCachedObjects;
|
||||
fCachedStreams.Free;
|
||||
fCachedEmbeddedObjects.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user