New implementation of GetIEProxy for IE 5.0+

git-svn-id: https://svn.code.sf.net/p/synalist/code/trunk@249 7c85be65-684b-0410-a082-b2ed4fbef004
This commit is contained in:
geby
2022-01-14 09:24:24 +00:00
parent d7dd7dcec4
commit 3a58f89410

View File

@ -1,9 +1,9 @@
{==============================================================================| {==============================================================================|
| Project : Ararat Synapse | 001.003.001 | | Project : Ararat Synapse | 001.004.000 |
|==============================================================================| |==============================================================================|
| Content: misc. procedures and functions | | Content: misc. procedures and functions |
|==============================================================================| |==============================================================================|
| Copyright (c)1999-2014, Lukas Gebauer | | Copyright (c)1999-2022, Lukas Gebauer |
| All rights reserved. | | All rights reserved. |
| | | |
| Redistribution and use in source and binary forms, with or without | | Redistribution and use in source and binary forms, with or without |
@ -33,7 +33,7 @@
| DAMAGE. | | DAMAGE. |
|==============================================================================| |==============================================================================|
| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).| | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
| Portions created by Lukas Gebauer are Copyright (c) 2002-2010. | | Portions created by Lukas Gebauer are Copyright (c) 2002-2022. |
| All Rights Reserved. | | All Rights Reserved. |
|==============================================================================| |==============================================================================|
| Contributor(s): | | Contributor(s): |
@ -80,9 +80,7 @@ uses
synautil, blcksock, SysUtils, Classes synautil, blcksock, SysUtils, Classes
{$IFDEF UNIX} {$IFDEF UNIX}
{$IFNDEF FPC} {$IFNDEF FPC}
{$IFNDEF POSIX}
, Libc , Libc
{$ENDIF}
{$ENDIF} {$ENDIF}
{$ELSE} {$ELSE}
, Windows , Windows
@ -98,10 +96,10 @@ Type
end; end;
{:With this function you can turn on a computer on the network, if this computer {:With this function you can turn on a computer on the network, if this computer
supports Wake-on-LAN feature. You need the MAC address supports Wake-on-LAN feature. You need the MAC address
(network card identifier) of the computer. You can also assign a target IP (network card identifier) of the computer. You can also assign a target IP
addres. If you do not specify it, then broadcast is used to deliver magic addres. If you do not specify it, then broadcast is used to deliver magic
wake-on-LAN packet. wake-on-LAN packet.
However broadcasts work only on your local network. When you need to wake-up a However broadcasts work only on your local network. When you need to wake-up a
computer on another network, you must specify any existing IP addres on same computer on another network, you must specify any existing IP addres on same
network segment as targeting computer.} network segment as targeting computer.}
@ -111,11 +109,11 @@ procedure WakeOnLan(MAC, IP: string);
is defined, then the result is comma-delimited.} is defined, then the result is comma-delimited.}
function GetDNS: string; function GetDNS: string;
{:Autodetect InternetExplorer proxy setting for given protocol. This function {:Read InternetExplorer 5.0+ proxy setting for given protocol. This function
works only on windows!} works only on windows!}
function GetIEProxy(protocol: string): TProxySetting; function GetIEProxy(protocol: string): TProxySetting;
{:Return all known IP addresses on the local system. Addresses are divided by {:Return all known IP addresses on the local system. Addresses are divided by
comma/comma-delimited.} comma/comma-delimited.}
function GetLocalIPs: string; function GetLocalIPs: string;
@ -140,7 +138,7 @@ begin
for n := 0 to 5 do for n := 0 to 5 do
begin begin
b := StrToIntDef('$' + MAC[n * 2 + 1] + MAC[n * 2 + 2], 0); b := StrToIntDef('$' + MAC[n * 2 + 1] + MAC[n * 2 + 2], 0);
HexMac := HexMac + AnsiChar(b); HexMac := HexMac + char(b);
end; end;
if IP = '' then if IP = '' then
IP := cBroadcast; IP := cBroadcast;
@ -298,7 +296,6 @@ end;
{$ENDIF} {$ENDIF}
{==============================================================================} {==============================================================================}
function GetIEProxy(protocol: string): TProxySetting; function GetIEProxy(protocol: string): TProxySetting;
{$IFDEF UNIX} {$IFDEF UNIX}
begin begin
@ -308,19 +305,48 @@ begin
end; end;
{$ELSE} {$ELSE}
type type
PInternetProxyInfo = ^TInternetProxyInfo; PInternetPerConnOption = ^INTERNET_PER_CONN_OPTION;
TInternetProxyInfo = packed record INTERNET_PER_CONN_OPTION = record
dwAccessType: DWORD; dwOption: DWORD;
lpszProxy: LPCSTR; case Integer of
lpszProxyBypass: LPCSTR; 0: (dwValue: DWORD);
// 1: (pszValue:LPTSTR);
1: (pszValue:PAnsiChar);
2: (ftValue: FILETIME);
end;
PInternetPerConnOptionList = ^INTERNET_PER_CONN_OPTION_LIST;
INTERNET_PER_CONN_OPTION_LIST = record
dwSize :DWORD;
// pszConnection :LPTSTR;
pszConnection :PAnsiChar;
dwOptionCount :DWORD;
dwOptionError :DWORD;
pOptions :PInternetPerConnOption;
end; end;
const const
INTERNET_OPTION_PROXY = 38; INTERNET_PER_CONN_FLAGS = 1;
INTERNET_OPEN_TYPE_PROXY = 3; INTERNET_PER_CONN_PROXY_SERVER = 2;
INTERNET_PER_CONN_PROXY_BYPASS = 3;
INTERNET_PER_CONN_AUTOCONFIG_URL = 4;
INTERNET_PER_CONN_AUTODISCOVERY_FLAGS = 5;
PROXY_TYPE_DIRECT = $00000001; // direct to net
PROXY_TYPE_PROXY = $00000002; // via named proxy
PROXY_TYPE_AUTO_PROXY_URL = $00000004; // autoproxy URL
PROXY_TYPE_AUTO_DETECT = $00000008; // use autoproxy detection
AUTO_PROXY_FLAG_USER_SET = $00000001; // user changed this setting
AUTO_PROXY_FLAG_ALWAYS_DETECT = $00000002; // force detection even when its not needed
AUTO_PROXY_FLAG_DETECTION_RUN = $00000004; // detection has been run
AUTO_PROXY_FLAG_MIGRATED = $00000008; // migration has just been done
AUTO_PROXY_FLAG_DONT_CACHE_PROXY_RESULT = $00000010; // don't cache result of host=proxy name
AUTO_PROXY_FLAG_CACHE_INIT_RUN = $00000020; // don't initalize and run unless URL expired
AUTO_PROXY_FLAG_DETECTION_SUSPECT = $00000040; // if we're on a LAN & Modem, with only one IP, bad?!?
INTERNET_OPTION_PER_CONNECTION_OPTION = 75;
WininetDLL = 'WININET.DLL'; WininetDLL = 'WININET.DLL';
var var
WininetModule: THandle; WininetModule: THandle;
ProxyInfo: PInternetProxyInfo; Option : array[0..4] of INTERNET_PER_CONN_OPTION;
List : INTERNET_PER_CONN_OPTION_LIST;
Err: Boolean; Err: Boolean;
Len: DWORD; Len: DWORD;
Proxy: string; Proxy: string;
@ -343,15 +369,25 @@ begin
if protocol = '' then if protocol = '' then
protocol := 'http'; protocol := 'http';
Len := 4096;
GetMem(ProxyInfo, Len);
ProxyList := TStringList.Create; ProxyList := TStringList.Create;
try try
Err := InternetQueryOption(nil, INTERNET_OPTION_PROXY, ProxyInfo, Len); Option[0].dwOption := INTERNET_PER_CONN_AUTOCONFIG_URL;
Option[1].dwOption := INTERNET_PER_CONN_AUTODISCOVERY_FLAGS;
Option[2].dwOption := INTERNET_PER_CONN_FLAGS;
Option[3].dwOption := INTERNET_PER_CONN_PROXY_BYPASS;
Option[4].dwOption := INTERNET_PER_CONN_PROXY_SERVER;
List.dwSize := SizeOf(INTERNET_PER_CONN_OPTION_LIST);
List.pszConnection := nil; // LAN
List.dwOptionCount := 5;
List.dwOptionError := 0;
List.pOptions := @Option;
Err := InternetQueryOption(nil, INTERNET_OPTION_PER_CONNECTION_OPTION, @List, List.dwSize);
if Err then if Err then
if ProxyInfo^.dwAccessType = INTERNET_OPEN_TYPE_PROXY then
begin begin
ProxyList.CommaText := ReplaceString(ProxyInfo^.lpszProxy, ' ', ','); ProxyList.CommaText := ReplaceString(Option[4].pszValue, ' ', ',');
Proxy := ''; Proxy := '';
DefProxy := ''; DefProxy := '';
for n := 0 to ProxyList.Count -1 do for n := 0 to ProxyList.Count -1 do
@ -371,11 +407,10 @@ begin
Result.Host := Trim(SeparateLeft(Proxy, ':')); Result.Host := Trim(SeparateLeft(Proxy, ':'));
Result.Port := Trim(SeparateRight(Proxy, ':')); Result.Port := Trim(SeparateRight(Proxy, ':'));
end; end;
Result.Bypass := ReplaceString(ProxyInfo^.lpszProxyBypass, ' ', ','); Result.Bypass := ReplaceString(Option[3].pszValue, ' ', ',');
end; end;
finally finally
ProxyList.Free; ProxyList.Free;
FreeMem(ProxyInfo);
end; end;
finally finally
FreeLibrary(WininetModule); FreeLibrary(WininetModule);