From 006f02864e1b45901aae5b43382abb6f2bced514 Mon Sep 17 00:00:00 2001 From: andrew Date: Mon, 15 Dec 2008 17:15:56 +0000 Subject: [PATCH] * 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 - --- .../chmhelp/lhelp/chmcontentprovider.pas | 8 +- components/chmhelp/lhelp/chmdataprovider.pas | 3 - components/chmhelp/lhelp/chmspecialparser.pas | 8 +- .../chmhelp/lhelp/httpcontentprovider.pas | 6 +- components/chmhelp/lhelp/lhelpcore.lfm | 36 ++- components/chmhelp/lhelp/lhelpcore.lrs | 48 ++- components/chmhelp/lhelp/lhelpcore.pas | 29 +- .../chmhelp/lhelp/lnethttpdataprovider.pas | 301 +++++++++++++----- 8 files changed, 326 insertions(+), 113 deletions(-) diff --git a/components/chmhelp/lhelp/chmcontentprovider.pas b/components/chmhelp/lhelp/chmcontentprovider.pas index 1e2f5f9e55..b2010f564f 100644 --- a/components/chmhelp/lhelp/chmcontentprovider.pas +++ b/components/chmhelp/lhelp/chmcontentprovider.pas @@ -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; diff --git a/components/chmhelp/lhelp/chmdataprovider.pas b/components/chmhelp/lhelp/chmdataprovider.pas index bba063a242..d30ee37b22 100644 --- a/components/chmhelp/lhelp/chmdataprovider.pas +++ b/components/chmhelp/lhelp/chmdataprovider.pas @@ -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; diff --git a/components/chmhelp/lhelp/chmspecialparser.pas b/components/chmhelp/lhelp/chmspecialparser.pas index 2ab5dd5004..80e0d4981a 100644 --- a/components/chmhelp/lhelp/chmspecialparser.pas +++ b/components/chmhelp/lhelp/chmspecialparser.pas @@ -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]; diff --git a/components/chmhelp/lhelp/httpcontentprovider.pas b/components/chmhelp/lhelp/httpcontentprovider.pas index 0aab30c519..d30070f3a1 100644 --- a/components/chmhelp/lhelp/httpcontentprovider.pas +++ b/components/chmhelp/lhelp/httpcontentprovider.pas @@ -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 diff --git a/components/chmhelp/lhelp/lhelpcore.lfm b/components/chmhelp/lhelp/lhelpcore.lfm index 4a63b87094..bc605915ea 100644 --- a/components/chmhelp/lhelp/lhelpcore.lfm +++ b/components/chmhelp/lhelp/lhelpcore.lfm @@ -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 diff --git a/components/chmhelp/lhelp/lhelpcore.lrs b/components/chmhelp/lhelp/lhelpcore.lrs index f881a93eb3..5f0ba60f49 100644 --- a/components/chmhelp/lhelp/lhelpcore.lrs +++ b/components/chmhelp/lhelp/lhelpcore.lrs @@ -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' 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;