1
0
Files
applications
bindings
components
Comba_Animation
aboutcomponent
acs
beepfp
callite
captcha
chelper
chemtext
cmdline
cmdlinecfg
colorpalette
cryptini
csvdocument
epiktimer
everettrandom
examplecomponent
exctrls
extrasyn
fpexif
fpsound
fpspreadsheet
fractions
freetypepascal
geckoport
gradcontrols
grid_semaphor
gridprinter
industrialstuff
iosdesigner
iphonelazext
jujiboutils
jvcllaz
kcontrols
lazautoupdate
lazbarcodes
lazmapviewer
examples
images
source
addons
mvcache.pas
mvde_intfgraphics.pas
mvde_lcl.pas
mvdlefpc.pas
mvdownloadengine.pas
mvdragobj.pas
mvdrawingengine.pas
mvengine.pas
mvextradata.pas
mvgeonames.pas
mvgpsobj.pas
mvgpx.pas
mvjobqueue.pas
mvjobs.pas
mvmapprovider.pas
mvmapviewer.pas
mvmapviewer_icons.res
mvmapviewerreg.pas
mvtypes.pas
lazmapviewer_bgra.lpk
lazmapviewer_bgra.pas
lazmapviewer_rgbgraphics.lpk
lazmapviewer_rgbgraphics.pas
lazmapviewer_synapse.lpk
lazmapviewer_synapse.pas
lazmapviewerpkg.lpk
lazmapviewerpkg.pas
lclextensions
longtimer
manualdock
mbColorLib
mplayer
multithreadprocs
nvidia-widgets
onguard
orpheus
playsoundpackage
poweredby
powerpdf
rgbgraphics
richmemo
richview
rtfview
rx
scrolltext
smnetgradient
spktoolbar
splashabout
svn
systools
tdi
thtmlport
tparadoxdataset
tvplanit
xdev_toolkit
zlibar
zmsql
examples
image_sources
lclbindings
wst
lazarus-ccr/components/lazmapviewer/source/mvdlefpc.pas

101 lines
2.3 KiB
ObjectPascal
Raw Normal View History

{ Map Viewer Download Engine Free Pascal HTTP Client
Copyright (C) 2011 Maciej Kaczkowski / keit.co
License: modified LGPL with linking exception (like RTL, FCL and LCL)
See the file COPYING.modifiedLGPL.txt, included in the Lazarus distribution,
for details about the license.
See also: https://wiki.lazarus.freepascal.org/FPC_modified_LGPL
Taken from:
https://forum.lazarus.freepascal.org/index.php/topic,12674.msg160255.html#msg160255
}
unit mvDLEFpc;
{$mode objfpc}{$H+}
{.$DEFINE LOG_URL}
interface
uses
SysUtils, Classes,
mvDownloadEngine;
type
{ TMVDEFPC }
TMVDEFPC = class(TMvCustomDownloadEngine)
{$IF FPC_FullVersion >= 30101}
private
FUseProxy: Boolean;
FProxyHost: string;
FProxyPort: Word;
FProxyUserName: String;
FProxyPassWord: String;
{$IFEND}
public
procedure DownloadFile(const Url: string; AStream: TStream); override;
{$IF FPC_FullVersion >= 30101}
published
property UseProxy: Boolean read FUseProxy write FUseProxy default false;
property ProxyHost: String read FProxyHost write FProxyHost;
property ProxyPort: Word read FProxyPort write FProxyPort;
property ProxyUsername: String read FProxyUserName write FProxyUserName;
property ProxyPassword: String read FProxyPassword write FProxyPassword;
{$IFEND}
end;
implementation
uses
{$IFDEF LOG_URL}
lazlogger,
{$ENDIF}
{$IF FPC_FullVersion >= 30200}
opensslsockets,
{$IFEND}
fphttpclient, openssl;
{ TMVDEFPC }
procedure TMVDEFPC.DownloadFile(const Url: string; AStream: TStream);
var
http: TFpHttpClient;
begin
{$IFDEF LOG_URL}
DebugLn(Url);
{$ENDIF}
InitSSLInterface;
http := TFpHttpClient.Create(nil);
try
http.ConnectTimeOut := 10000;
{$IF FPC_FullVersion >= 30000}
http.AllowRedirect := true;
{$IFEND}
http.AddHeader('User-Agent', 'Mozilla/5.0 (compatible; fpweb)');
{$IF FPC_FullVersion >= 30101}
if UseProxy then begin
http.Proxy.Host := FProxyHost;
http.Proxy.Port := FProxyPort;
http.Proxy.UserName := FProxyUserName;
http.Proxy.Password := FProxyPassword;
end;
{$ENDIF}
try
http.Get(Url, AStream);
except
// Eat the exception because we don't know on which server the map is found.
end;
AStream.Position := 0;
finally
http.Free;
end;
end;
end.