From d4deef5ba8226cd81e5fa8011864cbdf637d3d59 Mon Sep 17 00:00:00 2001 From: Fr0sT-Brutal Date: Tue, 1 Nov 2022 11:12:42 +0300 Subject: [PATCH 1/6] [API] * Major redesign of NetworkRequest. Reuse connections to speedup downloads and reduce server load. Engine capabilities are checked against request details. * OSM.NetworkRequest.pas, THttpRequestCapabilities => THttpRequestCapability; TBlockingNetworkRequestFunc => TBlockingNetworkRequestProc, must raise exception on error thus removing excess ErrMsg and result flag; add Client parameter + OSM.NetworkRequest.pas, CheckEngineCap, CheckEngineCaps, IsHTTPError, CheckHTTPError --- Source/OSM.NetworkRequest.pas | 126 +++++++++++++++++++++++++++------- 1 file changed, 102 insertions(+), 24 deletions(-) diff --git a/Source/OSM.NetworkRequest.pas b/Source/OSM.NetworkRequest.pas index 4b2d5d0..0dcc884 100644 --- a/Source/OSM.NetworkRequest.pas +++ b/Source/OSM.NetworkRequest.pas @@ -16,13 +16,14 @@ interface uses - SysUtils, Classes, Contnrs, SyncObjs, Types, + SysUtils, Classes, Contnrs, SyncObjs, Types, TypInfo, OSM.SlippyMapUtils, OSM.TilesProvider; const // Prefix to add to proxy URLs if it only contains host:port - some URL parsers // handle such inputs as proto:path HTTPProxyProto = 'http://'; + HTTPTLSProto = 'https'; // Internal constant to designate OS-wide proxy SystemProxy = HTTPProxyProto + 'SYSTEM'; // Timeout for connect and request @@ -30,7 +31,7 @@ interface type // Capabilities that a network engine has - THttpRequestCapabilities = + THttpRequestCapability = ( htcProxy, // Can use custom HTTP CONNECT proxy htcDirect, // Can force direct connect bypassing OS-wide proxy @@ -42,6 +43,7 @@ interface htcTimeout, // Support request timeout htcTLS // Support HTTPS ); + THttpRequestCapabilities = set of THttpRequestCapability; // Generic properties of request. All of them except URL are **common** - could be set once // and applied to all requests @@ -69,20 +71,30 @@ THttpRequestProps = class function Clone: THttpRequestProps; virtual; end; - // Generic type of blocking network request function. - // Function must: + // Base class for network client object. Used when request queue is performed + // through the same connection. Destructor of the object is called when the + // queue is empty and it must free all allocated resources. + TNetworkClient = TObject; + + // Generic type of blocking network request procedure. + // Procedure must: // // - Ensure URL requisites have priority over field requisites // - Set timeouts for request to ReqTimeout - // - Not raise any exception - // - Check response code + // - Raise exception on validation/connection/request error + // - Free all resources it has allocated // // @param RequestProps - all details regarding a request // @param ResponseStm - stream that accepts response data - // @param ErrMsg - [OUT] error description if any - // @returns success flag - TBlockingNetworkRequestFunc = function (RequestProps: THttpRequestProps; - ResponseStm: TStream; out ErrMsg: string): Boolean; + // @param Client - [IN/OUT] If the engine supports multiple requests inside + // the same client, this parameter is the current client object. Request + // properties are supposed to remain unchanged throughout the whole queue + // (only URL changes) so it's enough to assign them at client creation only @br + // IN: client object to use for requests. @br + // OUT: newly created client object if Client was @nil at input. + // @raises exception on error + TBlockingNetworkRequestProc = procedure (RequestProps: THttpRequestProps; + ResponseStm: TStream; var Client: TNetworkClient); // Generic type of method to call when request is completed @br // ! **Called from the context of a background thread** ! @@ -106,7 +118,7 @@ TNetworkRequestQueue = class FMaxTasksPerThread: Cardinal; FMaxThreads: Cardinal; FGotTileCb: TGotTileCallbackBgThr; - FRequestFunc: TBlockingNetworkRequestFunc; + FRequestProc: TBlockingNetworkRequestProc; FTilesProvider: TTilesProvider; FDumbQueueOrder: Boolean; FCurrTileNumbersRect: TRect; // rect of current view set in tile numbers @@ -122,11 +134,11 @@ TNetworkRequestQueue = class // @param MaxTasksPerThread - if number of tasks becomes more than \ // `MaxTasksPerThread*%currentThreadCount%`, add one more thread // @param MaxThreads - limit of the number of threads - // @param RequestFunc - implementator of network request + // @param RequestProc - implementator of network request // @param TilesProvider - object holding properties of current tile provider. // Object takes ownership on this object and destroys it on release. constructor Create(MaxTasksPerThread, MaxThreads: Cardinal; - RequestFunc: TBlockingNetworkRequestFunc; + RequestProc: TBlockingNetworkRequestProc; TilesProvider: TTilesProvider); destructor Destroy; override; @@ -153,17 +165,32 @@ TNetworkRequestQueue = class end; const + SampleUserAgent = 'Mozilla/5.0 (Windows NT 6.1; WOW64; rv:51.0) Gecko/20100101 Firefox/51.0'; // Headers that you could add to TNetworkRequestQueue. F.ex., openstreetmap.org // dislikes requests without user-agent. SampleHeaders: array[0..2] of string = ( - 'User-Agent: Mozilla/5.0 (Windows NT 6.1; WOW64; rv:51.0) Gecko/20100101 Firefox/51.0', + 'User-Agent: ' + SampleUserAgent, 'Accept-Language: en-US;q=0.7,en;q=0.3', 'Accept: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8' ); +// Check if capability is in set of capabilities and raise exception if not +procedure CheckEngineCap(NeededCap: THttpRequestCapability; Caps: THttpRequestCapabilities); +// Check if a network engine is capable of handling all the request properties. +// Checks for: htcProxy, htcSystemProxy, htcProxyAuth, htcAuth, htcAuthURL, htcTLS, htcHeaders. +procedure CheckEngineCaps(RequestProps: THttpRequestProps; EngineCapabilities: THttpRequestCapabilities); +// Return true if response code means HTTP error +function IsHTTPError(ResponseCode: Word): Boolean; +// Check if response code means HTTP error, raise exception then +procedure CheckHTTPError(ResponseCode: Word; const ResponseText: string); + implementation +const + S_EMsg_UnsuppCap = 'Required capability "%s" is not supported by network engine'; + S_EMsg_HTTPErr = 'HTTP error: %d %s'; + type // Thread has completed a request. // Ms could be nil or empty even if Error is not set @@ -175,10 +202,10 @@ TNetworkRequestThread = class(TThread) strict private FOwner: TNetworkRequestQueue; FOnRequestComplete: TOnRequestComplete; - FRequestFunc: TBlockingNetworkRequestFunc; + FRequestProc: TBlockingNetworkRequestProc; FTilesProvider: TTilesProvider; public - constructor Create(Owner: TNetworkRequestQueue; RequestFunc: TBlockingNetworkRequestFunc; + constructor Create(Owner: TNetworkRequestQueue; RequestProc: TBlockingNetworkRequestProc; TilesProvider: TTilesProvider); procedure Execute; override; @@ -186,6 +213,49 @@ TNetworkRequestThread = class(TThread) property OnRequestComplete: TOnRequestComplete read FOnRequestComplete write FOnRequestComplete; end; +procedure CheckEngineCap(NeededCap: THttpRequestCapability; Caps: THttpRequestCapabilities); +begin + if not (NeededCap in Caps) then + raise Exception.CreateFmt(S_EMsg_UnsuppCap, [GetEnumName(TypeInfo(THttpRequestCapability), Ord(NeededCap))]); +end; + +procedure CheckEngineCaps(RequestProps: THttpRequestProps; EngineCapabilities: THttpRequestCapabilities); +begin + if Pos(RequestProps.URL, HTTPTLSProto) = 1 then + CheckEngineCap(htcTLS, EngineCapabilities); + + if (RequestProps.HttpUserName <> '') and (RequestProps.HttpPassword <> '') then + CheckEngineCap(htcAuth, EngineCapabilities); + + // Does URL contain auth info? "http://user:pass@host/path" + if Pos('@', RequestProps.URL) <> 0 then + CheckEngineCap(htcAuthURL, EngineCapabilities); + + if RequestProps.Proxy <> '' then + begin + CheckEngineCap(htcProxy, EngineCapabilities); + if RequestProps.Proxy = SystemProxy then + CheckEngineCap(htcSystemProxy, EngineCapabilities); + // Does proxy URL contain auth info? "http://user:pass@host/path" + if Pos('@', RequestProps.Proxy) <> 0 then + CheckEngineCap(htcProxyAuth, EngineCapabilities); + end; + + if RequestProps.HeaderLines <> nil then + CheckEngineCap(htcHeaders, EngineCapabilities); +end; + +function IsHTTPError(ResponseCode: Word): Boolean; +begin + Result := ResponseCode >= 400; +end; + +procedure CheckHTTPError(ResponseCode: Word; const ResponseText: string); +begin + if IsHTTPError(ResponseCode) then + raise Exception.CreateFmt(S_EMsg_HTTPErr, [ResponseCode, ResponseText]); +end; + { THttpRequestProps } destructor THttpRequestProps.Destroy; @@ -212,11 +282,11 @@ function THttpRequestProps.Clone: THttpRequestProps; { TNetworkRequestThread } constructor TNetworkRequestThread.Create(Owner: TNetworkRequestQueue; - RequestFunc: TBlockingNetworkRequestFunc; TilesProvider: TTilesProvider); + RequestProc: TBlockingNetworkRequestProc; TilesProvider: TTilesProvider); begin inherited Create(True); FOwner := Owner; - FRequestFunc := RequestFunc; + FRequestProc := RequestProc; FTilesProvider := TilesProvider; end; @@ -228,6 +298,7 @@ procedure TNetworkRequestThread.Execute; sErrMsg: string; ms: TMemoryStream; ReqProps: THttpRequestProps; + cli: TNetworkClient; begin while not Terminated do begin @@ -242,10 +313,16 @@ procedure TNetworkRequestThread.Execute; ReqProps.Proxy := HTTPProxyProto + ReqProps.Proxy; ms := TMemoryStream.Create; - if not FRequestFunc(ReqProps, ms, sErrMsg) then - FreeAndNil(ms) - else + try + FRequestProc(ReqProps, ms, cli); ms.Position := 0; + except on E: Exception do + begin + sErrMsg := E.Message; + FreeAndNil(ms); + FreeAndNil(cli); + end; + end; FreeAndNil(ReqProps); if Assigned(FOnRequestComplete) then @@ -253,12 +330,13 @@ procedure TNetworkRequestThread.Execute; else // unlikely but possible FreeAndNil(ms) end; + FreeAndNil(cli); end; { TNetworkRequestQueue } constructor TNetworkRequestQueue.Create(MaxTasksPerThread, MaxThreads: Cardinal; - RequestFunc: TBlockingNetworkRequestFunc; TilesProvider: TTilesProvider); + RequestProc: TBlockingNetworkRequestProc; TilesProvider: TTilesProvider); begin FTaskQueue := TQueue.Create; FCS := TCriticalSection.Create; @@ -266,7 +344,7 @@ constructor TNetworkRequestQueue.Create(MaxTasksPerThread, MaxThreads: Cardinal; FCurrentTasks := TList.Create; FMaxTasksPerThread := MaxTasksPerThread; FMaxThreads := MaxThreads; - FRequestFunc := RequestFunc; + FRequestProc := RequestProc; FRequestProps := THttpRequestProps.Create; FTilesProvider := TilesProvider; end; @@ -391,7 +469,7 @@ procedure TNetworkRequestQueue.AddThread; begin Lock; try - thr := TNetworkRequestThread.Create(Self, FRequestFunc, FTilesProvider); + thr := TNetworkRequestThread.Create(Self, FRequestProc, FTilesProvider); thr.OnRequestComplete := DoRequestComplete; thr.Start; FThreads.Add(thr); From 912a02a1902fde429a29fcd7854ded205b25486e Mon Sep 17 00:00:00 2001 From: Fr0sT-Brutal Date: Tue, 1 Nov 2022 11:13:57 +0300 Subject: [PATCH 2/6] OSM.NetworkRequest.Synapse.pas: * To use SSL, define SynapseSSL in project options. * Update to changes in OSM.NetworkRequest.pas --- Source/OSM.NetworkRequest.Synapse.pas | 102 ++++++++++++++------------ 1 file changed, 54 insertions(+), 48 deletions(-) diff --git a/Source/OSM.NetworkRequest.Synapse.pas b/Source/OSM.NetworkRequest.Synapse.pas index 60cdbe5..5cdc009 100644 --- a/Source/OSM.NetworkRequest.Synapse.pas +++ b/Source/OSM.NetworkRequest.Synapse.pas @@ -4,9 +4,8 @@ based on code by Simon Kroik, 06.2018, kroiksm@@gmx.de For HTTPS-Support: - 1) USES ssl_openssl; - 2) copy libeay32.dll - 3) copy ssleay32.dll + 1) DEFINE SynapseSSL + 2) copy libeay32.dll and ssleay32.dll near the binary (c) Fr0sT-Brutal https://github.com/Fr0sT-Brutal/Delphi_OSMMap @@ -19,80 +18,87 @@ interface uses SysUtils, Classes, - HTTPSend, SynaUtil, + HTTPSend, SynaUtil, {$IFDEF SynapseSSL} ssl_openssl, {$ENDIF} OSM.NetworkRequest; const // Capabilities of Synapse engine EngineCapabilities = [htcProxy, htcDirect, htcProxyAuth, htcAuth, htcAuthURL, - htcHeaders, htcTimeout - {$IF DECLARED(TSSLOpenSSL)} , htcTLS {$ENDIF} ]; + htcHeaders, htcTimeout {$IF DECLARED(TSSLOpenSSL)} , htcTLS {$IFEND} ]; -// Function executing a network request. See description of -// OSM.NetworkRequest.TBlockingNetworkRequestFunc type.@br -function NetworkRequest(RequestProps: THttpRequestProps; - ResponseStm: TStream; out ErrMsg: string): Boolean; +// Procedure executing a network request. See description of +// OSM.NetworkRequest.TBlockingNetworkRequestProc type. +procedure NetworkRequest(RequestProps: THttpRequestProps; + ResponseStm: TStream; var Client: TNetworkClient); implementation const - SEMsg_HTTPErr = 'HTTP error: %d %s'; + SUserAgentHdrName = 'User-Agent: '; -function NetworkRequest(RequestProps: THttpRequestProps; - ResponseStm: TStream; out ErrMsg: string): Boolean; +// Procedure executing a network request. See description of +// OSM.NetworkRequest.TBlockingNetworkRequestProc type. +procedure NetworkRequest(RequestProps: THttpRequestProps; + ResponseStm: TStream; var Client: TNetworkClient); var - HTTP: THTTPSend; + httpCli: THTTPSend; User, Pass, ProxyUser, ProxyPass, ProxyHost, ProxyPort, Dummy: string; begin - ErrMsg := ''; - - HTTP := THTTPSend.Create; - try - HTTP.Timeout := ReqTimeout; + if Client = nil then + begin + CheckEngineCaps(RequestProps, EngineCapabilities); + Client := THTTPSend.Create; + httpCli := THTTPSend(Client); + httpCli.Protocol := '1.1'; // 1.0 by default thus killing keep-alive feature + if htcTimeout in EngineCapabilities then + httpCli.Timeout := ReqTimeout; // Ensure URL requisites have priority over field requisites ParseURL(RequestProps.URL, Dummy, User, Pass, Dummy, Dummy, Dummy, Dummy); if (User <> '') and (Pass <> '') then begin - HTTP.UserName := User; - HTTP.Password := Pass; + httpCli.UserName := User; + httpCli.Password := Pass; end else begin - HTTP.UserName := RequestProps.HttpUserName; - HTTP.Password := RequestProps.HttpPassword; + httpCli.UserName := RequestProps.HttpUserName; + httpCli.Password := RequestProps.HttpPassword; end; if RequestProps.Proxy <> '' then begin ParseURL(RequestProps.Proxy, Dummy, ProxyUser, ProxyPass, ProxyHost, ProxyPort, Dummy, Dummy); - HTTP.ProxyHost := ProxyHost; - HTTP.ProxyPort := ProxyPort; - HTTP.ProxyUser := ProxyUser; - HTTP.ProxyPass := ProxyPass; + httpCli.ProxyHost := ProxyHost; + httpCli.ProxyPort := ProxyPort; + httpCli.ProxyUser := ProxyUser; + httpCli.ProxyPass := ProxyPass; end; + end + else + begin + httpCli := THTTPSend(Client); + // Synapse fills Headers with response headers so we need to clear them and + // fill again before the new request + httpCli.Clear; + end; - if RequestProps.HeaderLines <> nil then - HTTP.Headers.AddStrings(RequestProps.HeaderLines); - - Result := HTTP.HTTPMethod('GET', RequestProps.URL); - - // check network error - if not Result then - begin - ErrMsg := HTTP.Sock.LastErrorDesc; - Exit; - end; - // check HTTP error - if HTTP.ResultCode >= 400 then - begin - ErrMsg := Format(SEMsg_HTTPErr, [HTTP.ResultCode, HTTP.ResultString]); - Exit(False); - end; - // OK - ResponseStm.CopyFrom(HTTP.Document, 0); - finally - FreeAndNil(HTTP); + if RequestProps.HeaderLines <> nil then + begin + httpCli.Headers.AddStrings(RequestProps.HeaderLines); + // Synapse doesn't take User agent from headers but from .UserAgent property. + // So check if we have it defined and set explicitly + for Dummy in RequestProps.HeaderLines do + if Pos(SUserAgentHdrName, Dummy) = 1 then + httpCli.UserAgent := Copy(Dummy, Length(SUserAgentHdrName) + 1, MaxInt); end; + + // try to get, check network error + if not httpCli.HTTPMethod('GET', RequestProps.URL) then + raise Exception.Create(httpCli.Sock.LastErrorDesc); + // check httpCli error + CheckHTTPError(httpCli.ResultCode, httpCli.ResultString); + // OK + ResponseStm.CopyFrom(httpCli.Document, 0); end; end. From 1718c18000988b57bb8cd63b4fd2965e7ed4fc12 Mon Sep 17 00:00:00 2001 From: Fr0sT-Brutal Date: Tue, 1 Nov 2022 11:51:01 +0300 Subject: [PATCH 3/6] OSM.NetworkRequest.pas: * comments regarding htcDirect cap --- Source/OSM.NetworkRequest.pas | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/Source/OSM.NetworkRequest.pas b/Source/OSM.NetworkRequest.pas index 0dcc884..3857dce 100644 --- a/Source/OSM.NetworkRequest.pas +++ b/Source/OSM.NetworkRequest.pas @@ -33,8 +33,11 @@ interface // Capabilities that a network engine has THttpRequestCapability = ( - htcProxy, // Can use custom HTTP CONNECT proxy - htcDirect, // Can force direct connect bypassing OS-wide proxy + htcProxy, // Support HTTP proxy + htcDirect, // Support direct connect bypassing OS-wide proxy. In fact, + // only WinInet-based engines (WinInet, RTL in Windows) use + // OS-wide proxy by default. In other engines and in Linux proxy + // must be set explicitly so this cap is actual for all engines. htcSystemProxy, // Can use OS-wide proxy htcProxyAuth, // Support auth to proxy defined in URL htcAuth, // Support auth to host From 702652da4cbeac04fb17a4cd9f0fb365e4364d3d Mon Sep 17 00:00:00 2001 From: Fr0sT-Brutal Date: Tue, 1 Nov 2022 11:52:38 +0300 Subject: [PATCH 4/6] OSM.NetworkRequest.Synapse.pas: + supports System proxy --- Source/OSM.NetworkRequest.Synapse.pas | 23 +++++++++++++++++++---- 1 file changed, 19 insertions(+), 4 deletions(-) diff --git a/Source/OSM.NetworkRequest.Synapse.pas b/Source/OSM.NetworkRequest.Synapse.pas index 5cdc009..a56ab4b 100644 --- a/Source/OSM.NetworkRequest.Synapse.pas +++ b/Source/OSM.NetworkRequest.Synapse.pas @@ -18,13 +18,15 @@ interface uses SysUtils, Classes, - HTTPSend, SynaUtil, {$IFDEF SynapseSSL} ssl_openssl, {$ENDIF} + HTTPSend, SynaUtil, SynaMisc, {$IFDEF SynapseSSL} ssl_openssl, {$ENDIF} OSM.NetworkRequest; const // Capabilities of Synapse engine EngineCapabilities = [htcProxy, htcDirect, htcProxyAuth, htcAuth, htcAuthURL, - htcHeaders, htcTimeout {$IF DECLARED(TSSLOpenSSL)} , htcTLS {$IFEND} ]; + htcHeaders, htcTimeout + {$IFDEF MSWINDOWS} , htcSystemProxy {$ENDIF} + {$IF DECLARED(TSSLOpenSSL)} , htcTLS {$IFEND} ]; // Procedure executing a network request. See description of // OSM.NetworkRequest.TBlockingNetworkRequestProc type. @@ -42,7 +44,10 @@ procedure NetworkRequest(RequestProps: THttpRequestProps; ResponseStm: TStream; var Client: TNetworkClient); var httpCli: THTTPSend; - User, Pass, ProxyUser, ProxyPass, ProxyHost, ProxyPort, Dummy: string; + Prot, User, Pass, ProxyUser, ProxyPass, ProxyHost, ProxyPort, Dummy: string; + {$IFDEF MSWINDOWS} + ProxyProps: TProxySetting; + {$ENDIF} begin if Client = nil then begin @@ -53,7 +58,7 @@ procedure NetworkRequest(RequestProps: THttpRequestProps; if htcTimeout in EngineCapabilities then httpCli.Timeout := ReqTimeout; // Ensure URL requisites have priority over field requisites - ParseURL(RequestProps.URL, Dummy, User, Pass, Dummy, Dummy, Dummy, Dummy); + ParseURL(RequestProps.URL, Prot, User, Pass, Dummy, Dummy, Dummy, Dummy); if (User <> '') and (Pass <> '') then begin httpCli.UserName := User; @@ -67,6 +72,16 @@ procedure NetworkRequest(RequestProps: THttpRequestProps; if RequestProps.Proxy <> '' then begin + {$IFDEF MSWINDOWS} + if RequestProps.Proxy = SystemProxy then + begin + ProxyProps := GetIEProxy(Prot); + // Bypass list is ignored + ProxyHost := ProxyProps.Host; + ProxyPort := ProxyProps.Port; + end + else + {$ENDIF} ParseURL(RequestProps.Proxy, Dummy, ProxyUser, ProxyPass, ProxyHost, ProxyPort, Dummy, Dummy); httpCli.ProxyHost := ProxyHost; httpCli.ProxyPort := ProxyPort; From c7c07d892c33255d99011790644abb77d2dd5ea8 Mon Sep 17 00:00:00 2001 From: Fr0sT-Brutal Date: Tue, 1 Nov 2022 11:54:20 +0300 Subject: [PATCH 5/6] OSM.NetworkRequest.WinInet.pas: * Update to changes in OSM.NetworkRequest.pas --- Source/OSM.NetworkRequest.WinInet.pas | 104 ++++++++++++++++---------- 1 file changed, 65 insertions(+), 39 deletions(-) diff --git a/Source/OSM.NetworkRequest.WinInet.pas b/Source/OSM.NetworkRequest.WinInet.pas index a9bfa5c..94fabd2 100644 --- a/Source/OSM.NetworkRequest.WinInet.pas +++ b/Source/OSM.NetworkRequest.WinInet.pas @@ -22,15 +22,25 @@ interface const // Capabilities of WinInet engine - EngineCapabilities = [htcProxy, htcDirect, htcSystemProxy, htcHeaders, htcTimeout, htcTLS]; + EngineCapabilities = [htcProxy, htcDirect, htcSystemProxy, htcHeaders, + htcTimeout, htcTLS]; -// Function executing a network request. See description of -// OSM.NetworkRequest.TBlockingNetworkRequestFunc type.@br -function NetworkRequest(RequestProps: THttpRequestProps; - ResponseStm: TStream; out ErrMsg: string): Boolean; +// Procedure executing a network request. See description of +// OSM.NetworkRequest.TBlockingNetworkRequestProc type. +procedure NetworkRequest(RequestProps: THttpRequestProps; + ResponseStm: TStream; var Client: TNetworkClient); implementation +type + TWinInetClient = class(TNetworkClient) + private + hInet: HINTERNET; + public + constructor Create(RequestProps: THttpRequestProps); + destructor Destroy; override; + end; + // Advanced SysErrorMessage version that handles WinInet errors function SysErrorMessageEx(ErrorCode: Cardinal): string; var @@ -75,43 +85,65 @@ function WinInetErr: Exception; Result := Exception.CreateFmt('%s [%d]', [SysErrorMessageEx(errCode), errCode]); end; -function NetworkRequest(RequestProps: THttpRequestProps; - ResponseStm: TStream; out ErrMsg: string): Boolean; +{ TWinInetClient } + +constructor TWinInetClient.Create(RequestProps: THttpRequestProps); var - hInet: HINTERNET; - Proxy, Headers: string; - Buf: array[0..1024-1] of Byte; - dwAccessType, read, opt: DWORD; - hFile: HINTERNET; + Proxy: string; + dwAccessType, opt: DWORD; begin - ErrMsg := ''; Result := False; hInet := nil; hFile := nil; - - try try - // Init WinInet - Proxy := ''; - if RequestProps.Proxy <> '' then - if RequestProps.Proxy = SystemProxy then - dwAccessType := INTERNET_OPEN_TYPE_PRECONFIG - else - begin - dwAccessType := INTERNET_OPEN_TYPE_PROXY; - Proxy := RequestProps.Proxy; - end + CheckEngineCaps(RequestProps, EngineCapabilities); + // Init WinInet + Proxy := ''; + if RequestProps.Proxy <> '' then + if RequestProps.Proxy = SystemProxy then + dwAccessType := INTERNET_OPEN_TYPE_PRECONFIG else - dwAccessType := INTERNET_OPEN_TYPE_DIRECT; - hInet := InternetOpen('Foo', dwAccessType, PChar(Proxy), nil, 0); - if hInet = nil then - raise WinInetErr; - // Set options + begin + dwAccessType := INTERNET_OPEN_TYPE_PROXY; + Proxy := RequestProps.Proxy; + end + else + dwAccessType := INTERNET_OPEN_TYPE_DIRECT; + hInet := InternetOpen('Foo', dwAccessType, PChar(Proxy), nil, 0); + if hInet = nil then + raise WinInetErr; + // Set options + if htcTimeout in EngineCapabilities then + begin opt := ReqTimeout; InternetSetOption(hInet, INTERNET_OPTION_CONNECT_TIMEOUT, @opt, SizeOf(opt)); InternetSetOption(hInet, INTERNET_OPTION_RECEIVE_TIMEOUT, @opt, SizeOf(opt)); InternetSetOption(hInet, INTERNET_OPTION_SEND_TIMEOUT, @opt, SizeOf(opt)); - // Open address + end; +end; + +destructor TWinInetClient.Destroy; +begin + InternetCloseHandle(hInet); + inherited; +end; + +procedure NetworkRequest(RequestProps: THttpRequestProps; + ResponseStm: TStream; var Client: TNetworkClient); +var + Headers: string; + hFile: HINTERNET; + Buf: array[0..1024-1] of Byte; + read: DWORD; +begin + hFile := nil; + + try + if Client = nil then + Client := TWinInetClient.Create(RequestProps); + if RequestProps.HeaderLines <> nil then Headers := RequestProps.HeaderLines.Text; - hFile := InternetOpenUrl(hInet, PChar(RequestProps.URL), PChar(Headers), 0, - INTERNET_FLAG_NO_CACHE_WRITE or INTERNET_FLAG_NO_COOKIES or INTERNET_FLAG_NO_UI, + + // Open address + hFile := InternetOpenUrl(TWinInetClient(Client).hInet, PChar(RequestProps.URL), PChar(Headers), 0, + INTERNET_FLAG_NO_CACHE_WRITE or INTERNET_FLAG_NO_COOKIES or INTERNET_FLAG_NO_UI or INTERNET_FLAG_EXISTING_CONNECT, 0); if hFile = nil then raise WinInetErr; @@ -122,14 +154,8 @@ function NetworkRequest(RequestProps: THttpRequestProps; if read = 0 then Break; ResponseStm.Write(Buf, read); end; - - Result := True; - except on E: Exception do - ErrMsg := E.Message; - end; finally InternetCloseHandle(hFile); - InternetCloseHandle(hInet); end; end; From 59eb2bca1267f184d468e3a576392c75c28388c6 Mon Sep 17 00:00:00 2001 From: Fr0sT-Brutal Date: Tue, 1 Nov 2022 12:05:34 +0300 Subject: [PATCH 6/6] OSM.NetworkRequest.RTL.pas: * Update to changes in OSM.NetworkRequest.pas --- Source/OSM.NetworkRequest.RTL.pas | 105 ++++++++++++++++-------------- 1 file changed, 56 insertions(+), 49 deletions(-) diff --git a/Source/OSM.NetworkRequest.RTL.pas b/Source/OSM.NetworkRequest.RTL.pas index 2a0ed9d..a67b250 100644 --- a/Source/OSM.NetworkRequest.RTL.pas +++ b/Source/OSM.NetworkRequest.RTL.pas @@ -37,10 +37,10 @@ interface htcProxyAuth, htcAuth, htcAuthURL, htcHeaders, htcTimeout, htcTLS]; {$ENDIF} -// Function executing a network request. See description of -// OSM.NetworkRequest.TBlockingNetworkRequestFunc type.@br -function NetworkRequest(RequestProps: THttpRequestProps; - ResponseStm: TStream; out ErrMsg: string): Boolean; +// Procedure executing a network request. See description of +// OSM.NetworkRequest.TBlockingNetworkRequestProc type. +procedure NetworkRequest(RequestProps: THttpRequestProps; + ResponseStm: TStream; var Client: TNetworkClient); implementation @@ -52,8 +52,10 @@ implementation {$ENDIF} {$ENDIF} -function NetworkRequest(RequestProps: THttpRequestProps; - ResponseStm: TStream; out ErrMsg: string): Boolean; +// Procedure executing a network request. See description of +// OSM.NetworkRequest.TBlockingNetworkRequestProc type. +procedure NetworkRequest(RequestProps: THttpRequestProps; + ResponseStm: TStream; var Client: TNetworkClient); var uri: TURI; {$IFDEF FPC} @@ -66,13 +68,17 @@ function NetworkRequest(RequestProps: THttpRequestProps; Resp: IHttpResponse; {$ENDIF} begin - ErrMsg := ''; Result := False; - - try try - {$IFDEF FPC} - httpCli := TFPHTTPClient.Create(nil); - httpCli.ConnectTimeout := ReqTimeout; - httpCli.IOTimeout := ReqTimeout; + {$IFDEF FPC} + if Client = nil then + begin + CheckEngineCaps(RequestProps, EngineCapabilities); + Client := TFPHTTPClient.Create(nil); + httpCli := TFPHTTPClient(Client); + if htcTimeout in EngineCapabilities then + begin + httpCli.ConnectTimeout := ReqTimeout; + httpCli.IOTimeout := ReqTimeout; + end; // Ensure URL requisites have priority over field requisites uri := ParseURI(RequestProps.URL); @@ -87,9 +93,6 @@ function NetworkRequest(RequestProps: THttpRequestProps; httpCli.Password := RequestProps.HttpPassword; end; - if RequestProps.HeaderLines <> nil then - httpCli.RequestHeaders.Assign(RequestProps.HeaderLines); - if RequestProps.Proxy <> '' then begin uri := ParseURI(RequestProps.Proxy); @@ -99,19 +102,29 @@ function NetworkRequest(RequestProps: THttpRequestProps; httpCli.Proxy.Password := uri.Password; end; - httpCli.Get(RequestProps.URL, ResponseStm); + if RequestProps.HeaderLines <> nil then + httpCli.RequestHeaders.Assign(RequestProps.HeaderLines); + end + else + httpCli := TFPHTTPClient(Client); + + httpCli.Get(RequestProps.URL, ResponseStm); + + // check HTTP error + CheckHTTPError(httpCli.ResponseStatusCode, httpCli.ResponseStatusText); + {$ENDIF} - // check HTTP error - if httpCli.ResponseStatusCode >= 400 then + {$IFDEF DCC} + if Client = nil then + begin + CheckEngineCaps(RequestProps, EngineCapabilities); + Client := TNetHTTPClient.Create(nil); + httpCli := TNetHTTPClient(Client); + if htcTimeout in EngineCapabilities then begin - ErrMsg := Format(SEMsg_HTTPErr, [httpCli.ResponseStatusCode, httpCli.ResponseStatusText]); - Exit(False); + httpCli.ConnectionTimeout := ReqTimeout; + httpCli.ResponseTimeout := ReqTimeout; end; - {$ENDIF} - {$IFDEF DCC} - httpCli := TNetHTTPClient.Create(nil); - httpCli.ConnectionTimeout := ReqTimeout; - httpCli.ResponseTimeout := ReqTimeout; // Ensure URL requisites have priority over field requisites uri := TURI.Create(RequestProps.URL); @@ -121,15 +134,6 @@ function NetworkRequest(RequestProps: THttpRequestProps; httpCli.CredentialsStorage.AddCredential(TCredentialsStorage.TCredential.Create( TAuthTargetType.Server, '', '', User, Pass)); - if RequestProps.HeaderLines <> nil then - begin - for s in RequestProps.HeaderLines do - begin - HdrArr := SplitString(s, ':'); - httpCli.CustomHeaders[HdrArr[0]] := HdrArr[1]; - end; - end; - // http://docwiki.embarcadero.com/RADStudio/Sydney/en/Using_an_HTTP_Client#Sending_a_Request_Behind_a_Proxy // '' means system, bypassing only allowed for Windows: to bypass the system proxy settings, create proxy settings // for the HTTP Client and specify http://direct as the URL @@ -137,29 +141,32 @@ function NetworkRequest(RequestProps: THttpRequestProps; // - '' => Direct (Windows only) // - SYSTEM => '' if RequestProps.Proxy = '' then + begin {$IFDEF MSWINDOWS} + CheckEngineCap(htcDirect, EngineCapabilities); httpCli.ProxySettings := TProxySettings.Create(DirectConnection) {$ENDIF} + end else if RequestProps.Proxy <> SystemProxy then httpCli.ProxySettings := TProxySettings.Create(RequestProps.Proxy); - Resp := httpCli.Get(RequestProps.URL, ResponseStm); - - // check HTTP error - if Resp.StatusCode >= 400 then + if RequestProps.HeaderLines <> nil then begin - ErrMsg := Format(SEMsg_HTTPErr, [Resp.StatusCode, Resp.StatusText]); - Exit(False); + for s in RequestProps.HeaderLines do + begin + HdrArr := SplitString(s, ':'); + httpCli.CustomHeaders[HdrArr[0]] := HdrArr[1]; + end; end; - {$ENDIF} + end + else + httpCli := TNetHTTPClient(Client); - Result := ResponseStm.Size > 0; - except on E: Exception do - ErrMsg := E.Message; - end; - finally - FreeAndNil(httpCli); - end; + Resp := httpCli.Get(RequestProps.URL, ResponseStm); + + // check HTTP error + CheckHTTPError(Resp.StatusCode, Resp.StatusText); + {$ENDIF} end; end.