123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693 |
- {==============================================================================|
- | Project : Ararat Synapse | 001.004.000 |
- |==============================================================================|
- | Content: misc. procedures and functions |
- |==============================================================================|
- | Copyright (c)1999-2022, Lukas Gebauer |
- | All rights reserved. |
- | |
- | Redistribution and use in source and binary forms, with or without |
- | modification, are permitted provided that the following conditions are met: |
- | |
- | Redistributions of source code must retain the above copyright notice, this |
- | list of conditions and the following disclaimer. |
- | |
- | Redistributions in binary form must reproduce the above copyright notice, |
- | this list of conditions and the following disclaimer in the documentation |
- | and/or other materials provided with the distribution. |
- | |
- | Neither the name of Lukas Gebauer nor the names of its contributors may |
- | be used to endorse or promote products derived from this software without |
- | specific prior written permission. |
- | |
- | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" |
- | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
- | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
- | ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR |
- | ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
- | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR |
- | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER |
- | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
- | LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
- | OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH |
- | DAMAGE. |
- |==============================================================================|
- | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
- | Portions created by Lukas Gebauer are Copyright (c) 2002-2022. |
- | All Rights Reserved. |
- |==============================================================================|
- | Contributor(s): |
- |==============================================================================|
- | History: see HISTORY.HTM from distribution package |
- | (Found at URL: http://www.ararat.cz/synapse/) |
- |==============================================================================}
- {:@abstract(Miscellaneous network based utilities)}
- {$IFDEF FPC}
- {$MODE DELPHI}
- {$ENDIF}
- {$Q-}
- {$H+}
- //Kylix does not known UNIX define
- {$IFDEF LINUX}
- {$IFNDEF UNIX}
- {$DEFINE UNIX}
- {$ENDIF}
- {$ENDIF}
- {$IFDEF POSIX}
- {$IFNDEF UNIX}
- {$DEFINE UNIX}
- {$ENDIF}
- {$ENDIF}
- {$TYPEDADDRESS OFF}
- {$IFDEF UNICODE}
- {$WARN IMPLICIT_STRING_CAST OFF}
- {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
- {$ENDIF}
- unit synamisc;
- interface
- {$IFDEF VER125}
- {$DEFINE BCB}
- {$ENDIF}
- {$IFDEF BCB}
- {$ObjExportAll On}
- {$HPPEMIT '#pragma comment( lib , "wininet.lib" )'}
- {$ENDIF}
- uses
- synautil, blcksock, SysUtils, Classes
- {$IFDEF POSIX}
- ,Types,Posix.Stdlib
- {$ELSE}
- {$IFDEF UNIX}
- {$IFNDEF FPC}
- , Libc
- {$ENDIF}
- {$ELSE}
- {$IFDEF ULTIBO}
- , GlobalConst, Iphlpapi
- {$ELSE}
- , Windows
- {$ENDIF}
- {$ENDIF}
- ;
- const
- lIPV4 = 1;
- lIPV6 = 2;
- Type
- {:@abstract(This record contains information about proxy settings.)}
- TProxySetting = record
- Host: string;
- Port: string;
- Bypass: string;
- ResultCode: integer;
- Autodetected: boolean;
- end;
- {: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
- (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
- wake-on-LAN packet.
- 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
- network segment as targeting computer.}
- procedure WakeOnLan(MAC, IP: string);
- {:Autodetect current DNS servers used by the system. If more than one DNS server
- is defined, then the result is comma-delimited.}
- function GetDNS: string;
- {:Read InternetExplorer 5.0+ proxy setting for given protocol. This function
- works only on windows!}
- function GetIEProxy(protocol: string): TProxySetting;
- {:Return all known IP addresses of required type on the local system. Addresses are divided by
- comma/comma-delimited.}
- function GetLocalIPsFamily(value: TSocketFamily): string;
- {:Return all known IP addresses on the local system. Addresses are divided by
- comma/comma-delimited.}
- function GetLocalIPs: string;
- {$IFDEF MSWINDOWS}
- {:Autodetect system proxy setting for specified URL. This function
- works only on windows!}
- function GetProxyForURL(const AURL: WideString): TProxySetting;
- {$ENDIF}
- implementation
- {==============================================================================}
- procedure WakeOnLan(MAC, IP: string);
- var
- sock: TUDPBlockSocket;
- HexMac: string;
- data: string;
- n: integer;
- b: Byte;
- begin
- if MAC <> '' then
- begin
- MAC := ReplaceString(MAC, '-', '');
- MAC := ReplaceString(MAC, ':', '');
- if Length(MAC) < 12 then
- Exit;
- HexMac := '';
- for n := 0 to 5 do
- begin
- b := StrToIntDef('$' + MAC[n * 2 + 1] + MAC[n * 2 + 2], 0);
- HexMac := HexMac + char(b);
- end;
- if IP = '' then
- IP := cBroadcast;
- sock := TUDPBlockSocket.Create;
- try
- sock.CreateSocket;
- sock.EnableBroadcast(true);
- sock.Connect(IP, '9');
- data := #$FF + #$FF + #$FF + #$FF + #$FF + #$FF;
- for n := 1 to 16 do
- data := data + HexMac;
- sock.SendString(data);
- finally
- sock.Free;
- end;
- end;
- end;
- {==============================================================================}
- {$IFNDEF UNIX}
- function GetDNSbyIpHlp: string;
- {$IFDEF ULTIBO}
- var
- InfoSize: DWORD;
- FixedInfo: TFixedInfo;
- PDnsServer: PIP_ADDR_STRING;
- ResultCode: DWORD;
- begin
- Result:='';
-
- InfoSize:=SizeOf(TFixedInfo);
- ResultCode:=GetNetworkParams(@FixedInfo,InfoSize);
- if ResultCode <> ERROR_SUCCESS then Exit;
-
- Result:=FixedInfo.DnsServerList.IpAddress.S;
- PDnsServer:=FixedInfo.DnsServerList.Next;
- while PDnsServer <> nil do
- begin
- if Result <> '' then Result:=Result + ',';
- Result:=Result + PDnsServer^.IPAddress.S;
- PDnsServer:=PDnsServer.Next;
- end;
- end;
- {$ELSE}
- type
- PTIP_ADDRESS_STRING = ^TIP_ADDRESS_STRING;
- TIP_ADDRESS_STRING = array[0..15] of Ansichar;
- PTIP_ADDR_STRING = ^TIP_ADDR_STRING;
- TIP_ADDR_STRING = packed record
- Next: PTIP_ADDR_STRING;
- IpAddress: TIP_ADDRESS_STRING;
- IpMask: TIP_ADDRESS_STRING;
- Context: DWORD;
- end;
- PTFixedInfo = ^TFixedInfo;
- TFixedInfo = packed record
- HostName: array[1..128 + 4] of Ansichar;
- DomainName: array[1..128 + 4] of Ansichar;
- CurrentDNSServer: PTIP_ADDR_STRING;
- DNSServerList: TIP_ADDR_STRING;
- NodeType: UINT;
- ScopeID: array[1..256 + 4] of Ansichar;
- EnableRouting: UINT;
- EnableProxy: UINT;
- EnableDNS: UINT;
- end;
- const
- IpHlpDLL = 'IPHLPAPI.DLL';
- var
- IpHlpModule: THandle;
- FixedInfo: PTFixedInfo;
- InfoSize: Longint;
- PDnsServer: PTIP_ADDR_STRING;
- err: integer;
- GetNetworkParams: function(FixedInfo: PTFixedInfo; pOutPutLen: PULONG): DWORD; stdcall;
- begin
- InfoSize := 0;
- Result := '...';
- IpHlpModule := LoadLibrary(IpHlpDLL);
- if IpHlpModule = 0 then
- exit;
- try
- GetNetworkParams := GetProcAddress(IpHlpModule,PAnsiChar(AnsiString('GetNetworkParams')));
- if @GetNetworkParams = nil then
- Exit;
- err := GetNetworkParams(Nil, @InfoSize);
- if err <> ERROR_BUFFER_OVERFLOW then
- Exit;
- Result := '';
- GetMem (FixedInfo, InfoSize);
- try
- err := GetNetworkParams(FixedInfo, @InfoSize);
- if err <> ERROR_SUCCESS then
- exit;
- with FixedInfo^ do
- begin
- Result := DnsServerList.IpAddress;
- PDnsServer := DnsServerList.Next;
- while PDnsServer <> Nil do
- begin
- if Result <> '' then
- Result := Result + ',';
- Result := Result + PDnsServer^.IPAddress;
- PDnsServer := PDnsServer.Next;
- end;
- end;
- finally
- FreeMem(FixedInfo);
- end;
- finally
- FreeLibrary(IpHlpModule);
- end;
- end;
- function ReadReg(SubKey, Vn: PChar): string;
- var
- OpenKey: HKEY;
- DataType, DataSize: integer;
- Temp: array [0..2048] of char;
- begin
- Result := '';
- if RegOpenKeyEx(HKEY_LOCAL_MACHINE, SubKey, REG_OPTION_NON_VOLATILE,
- KEY_READ, OpenKey) = ERROR_SUCCESS then
- begin
- DataType := REG_SZ;
- DataSize := SizeOf(Temp);
- if RegQueryValueEx(OpenKey, Vn, nil, @DataType, @Temp, @DataSize) = ERROR_SUCCESS then
- SetString(Result, Temp, DataSize div SizeOf(Char) - 1);
- RegCloseKey(OpenKey);
- end;
- end ;
- {$ENDIF}
- {$ENDIF}
- function GetDNS: string;
- {$IFDEF ULTIBO}
- begin
- Result := GetDNSbyIpHlp;
- end;
- {$ELSE}
- {$IFDEF UNIX}
- var
- l: TStringList;
- n: integer;
- begin
- Result := '';
- l := TStringList.Create;
- try
- l.LoadFromFile('/etc/resolv.conf');
- for n := 0 to l.Count - 1 do
- if Pos('NAMESERVER', uppercase(l[n])) = 1 then
- begin
- if Result <> '' then
- Result := Result + ',';
- Result := Result + SeparateRight(l[n], ' ');
- end;
- finally
- l.Free;
- end;
- end;
- {$ELSE}
- const
- NTdyn = 'System\CurrentControlSet\Services\Tcpip\Parameters\Temporary';
- NTfix = 'System\CurrentControlSet\Services\Tcpip\Parameters';
- W9xfix = 'System\CurrentControlSet\Services\MSTCP';
- begin
- Result := GetDNSbyIpHlp;
- if Result = '...' then
- begin
- if Win32Platform = VER_PLATFORM_WIN32_NT then
- begin
- Result := ReadReg(NTdyn, 'NameServer');
- if result = '' then
- Result := ReadReg(NTfix, 'NameServer');
- if result = '' then
- Result := ReadReg(NTfix, 'DhcpNameServer');
- end
- else
- Result := ReadReg(W9xfix, 'NameServer');
- Result := ReplaceString(trim(Result), ' ', ',');
- end;
- end;
- {$ENDIF}
- {$ENDIF}
- {==============================================================================}
- function GetIEProxy(protocol: string): TProxySetting;
- {$IFDEF ULTIBO}
- begin
- Result.Host := '';
- Result.Port := '';
- Result.Bypass := '';
- end;
- {$ELSE}
- {$IFDEF UNIX}
- begin
- Result.Host := '';
- Result.Port := '';
- Result.Bypass := '';
- Result.ResultCode := -1;
- Result.Autodetected := false;
- end;
- {$ELSE}
- type
- PInternetPerConnOption = ^INTERNET_PER_CONN_OPTION;
- INTERNET_PER_CONN_OPTION = record
- dwOption: DWORD;
- case Integer of
- 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;
- const
- INTERNET_PER_CONN_FLAGS = 1;
- 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';
- var
- WininetModule: THandle;
- Option : array[0..4] of INTERNET_PER_CONN_OPTION;
- List : INTERNET_PER_CONN_OPTION_LIST;
- Err: Boolean;
- Len: DWORD;
- Proxy: string;
- DefProxy: string;
- ProxyList: TStringList;
- n: integer;
- InternetQueryOption: function (hInet: Pointer; dwOption: DWORD;
- lpBuffer: Pointer; var lpdwBufferLength: DWORD): BOOL; stdcall;
- begin
- Result.Host := '';
- Result.Port := '';
- Result.Bypass := '';
- Result.ResultCode := 0;
- Result.Autodetected := false;
- WininetModule := LoadLibrary(WininetDLL);
- if WininetModule = 0 then
- exit;
- try
- InternetQueryOption := GetProcAddress(WininetModule,PAnsiChar(AnsiString('InternetQueryOptionA')));
- if @InternetQueryOption = nil then
- Exit;
- if protocol = '' then
- protocol := 'http';
- ProxyList := TStringList.Create;
- try
- 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
- begin
- ProxyList.CommaText := ReplaceString(Option[4].pszValue, ' ', ',');
- Proxy := '';
- DefProxy := '';
- for n := 0 to ProxyList.Count -1 do
- begin
- if Pos(lowercase(protocol) + '=', lowercase(ProxyList[n])) = 1 then
- begin
- Proxy := SeparateRight(ProxyList[n], '=');
- break;
- end;
- if Pos('=', ProxyList[n]) < 1 then
- DefProxy := ProxyList[n];
- end;
- if Proxy = '' then
- Proxy := DefProxy;
- if Proxy <> '' then
- begin
- Result.Host := Trim(SeparateLeft(Proxy, ':'));
- Result.Port := Trim(SeparateRight(Proxy, ':'));
- end;
- Result.Bypass := ReplaceString(Option[3].pszValue, ' ', ',');
- end;
- finally
- ProxyList.Free;
- end;
- finally
- FreeLibrary(WininetModule);
- end;
- end;
- {$ENDIF}
- {$ENDIF}
- {==============================================================================}
- function GetLocalIPsFamily(value: TSocketFamily): string;
- var
- TcpSock: TTCPBlockSocket;
- ipList: TStringList;
- begin
- Result := '';
- ipList := TStringList.Create;
- try
- TcpSock := TTCPBlockSocket.create;
- try
- if value <> SF_Any then
- TcpSock.family := value;
- TcpSock.ResolveNameToIP(TcpSock.LocalName, ipList);
- Result := ipList.CommaText;
- finally
- TcpSock.Free;
- end;
- finally
- ipList.Free;
- end;
- end;
- function GetLocalIPs: string;
- begin
- Result := GetLocalIPsFamily(SF_Any);
- end;
- {==============================================================================}
- {$IFDEF MSWINDOWS}
- function GetProxyForURL(const AURL: WideString): TProxySetting;
- type
- HINTERNET = Pointer;
- INTERNET_PORT = Word;
- PWinHTTPProxyInfo = ^TWinHTTPProxyInfo;
- WINHTTP_PROXY_INFO = record
- dwAccessType: DWORD;
- lpszProxy: LPWSTR;
- lpszProxyBypass: LPWSTR;
- end;
- TWinHTTPProxyInfo = WINHTTP_PROXY_INFO;
- LPWINHTTP_PROXY_INFO = PWinHTTPProxyInfo;
- PWinHTTPAutoProxyOptions = ^TWinHTTPAutoProxyOptions;
- WINHTTP_AUTOPROXY_OPTIONS = record
- dwFlags: DWORD;
- dwAutoDetectFlags: DWORD;
- lpszAutoConfigUrl: LPCWSTR;
- lpvReserved: Pointer;
- dwReserved: DWORD;
- fAutoLogonIfChallenged: BOOL;
- end;
- TWinHTTPAutoProxyOptions = WINHTTP_AUTOPROXY_OPTIONS;
- LPWINHTTP_AUTOPROXY_OPTIONS = PWinHTTPAutoProxyOptions;
- PWinHTTPCurrentUserIEProxyConfig = ^TWinHTTPCurrentUserIEProxyConfig;
- WINHTTP_CURRENT_USER_IE_PROXY_CONFIG = record
- fAutoDetect: BOOL;
- lpszAutoConfigUrl: LPWSTR;
- lpszProxy: LPWSTR;
- lpszProxyBypass: LPWSTR;
- end;
- TWinHTTPCurrentUserIEProxyConfig = WINHTTP_CURRENT_USER_IE_PROXY_CONFIG;
- LPWINHTTP_CURRENT_USER_IE_PROXY_CONFIG = PWinHTTPCurrentUserIEProxyConfig;
- const
- WINHTTP_NO_REFERER = nil;
- WINHTTP_NO_PROXY_NAME = nil;
- WINHTTP_NO_PROXY_BYPASS = nil;
- WINHTTP_DEFAULT_ACCEPT_TYPES = nil;
- WINHTTP_ACCESS_TYPE_DEFAULT_PROXY = 0;
- WINHTTP_ACCESS_TYPE_NO_PROXY = 1;
- WINHTTP_OPTION_PROXY = 38;
- WINHTTP_OPTION_PROXY_USERNAME = $1002;
- WINHTTP_OPTION_PROXY_PASSWORD = $1003;
- WINHTTP_AUTOPROXY_AUTO_DETECT = $00000001;
- WINHTTP_AUTOPROXY_CONFIG_URL = $00000002;
- WINHTTP_AUTO_DETECT_TYPE_DHCP = $00000001;
- WINHTTP_AUTO_DETECT_TYPE_DNS_A = $00000002;
- WINHTTP_FLAG_BYPASS_PROXY_CACHE = $00000100;
- WINHTTP_FLAG_REFRESH = WINHTTP_FLAG_BYPASS_PROXY_CACHE;
- var
- WinHttpModule: THandle;
- Session: HINTERNET;
- AutoDetectProxy: Boolean;
- WinHttpProxyInfo: TWinHTTPProxyInfo;
- AutoProxyOptions: TWinHTTPAutoProxyOptions;
- IEProxyConfig: TWinHTTPCurrentUserIEProxyConfig;
- WinHttpOpen: function (pwszUserAgent: LPCWSTR; dwAccessType: DWORD;
- pwszProxyName, pwszProxyBypass: LPCWSTR; dwFlags: DWORD): HINTERNET; stdcall;
- WinHttpConnect: function(hSession: HINTERNET; pswzServerName: LPCWSTR;
- nServerPort: INTERNET_PORT; dwReserved: DWORD): HINTERNET; stdcall;
- WinHttpOpenRequest: function(hConnect: HINTERNET; pwszVerb: LPCWSTR;
- pwszObjectName: LPCWSTR; pwszVersion: LPCWSTR; pwszReferer: LPCWSTR;
- ppwszAcceptTypes: PLPWSTR; dwFlags: DWORD): HINTERNET; stdcall;
- WinHttpQueryOption: function(hInet: HINTERNET; dwOption: DWORD;
- lpBuffer: Pointer; var lpdwBufferLength: DWORD): BOOL; stdcall;
- WinHttpGetProxyForUrl: function(hSession: HINTERNET; lpcwszUrl: LPCWSTR;
- pAutoProxyOptions: LPWINHTTP_AUTOPROXY_OPTIONS;
- var pProxyInfo: WINHTTP_PROXY_INFO): BOOL; stdcall;
- WinHttpGetIEProxyConfigForCurrentUser: function(
- var pProxyInfo: WINHTTP_CURRENT_USER_IE_PROXY_CONFIG): BOOL; stdcall;
- WinHttpCloseHandle: function(hInternet: HINTERNET): BOOL; stdcall;
- begin
- Result.Host := '';
- Result.Port := '';
- Result.Bypass := '';
- Result.ResultCode := 0;
- Result.Autodetected := false;
- WinHttpModule := LoadLibrary('winhttp.dll');
- if WinHttpModule = 0 then
- exit;
- try
- WinHttpOpen := GetProcAddress(WinHttpModule,PAnsiChar(AnsiString('WinHttpOpen')));
- if @WinHttpOpen = nil then
- Exit;
- WinHttpConnect := GetProcAddress(WinHttpModule,PAnsiChar(AnsiString('WinHttpConnect')));
- if @WinHttpConnect = nil then
- Exit;
- WinHttpOpenRequest := GetProcAddress(WinHttpModule,PAnsiChar(AnsiString('WinHttpOpenRequest')));
- if @WinHttpOpenRequest = nil then
- Exit;
- WinHttpQueryOption := GetProcAddress(WinHttpModule,PAnsiChar(AnsiString('WinHttpQueryOption')));
- if @WinHttpQueryOption = nil then
- Exit;
- WinHttpGetProxyForUrl := GetProcAddress(WinHttpModule,PAnsiChar(AnsiString('WinHttpGetProxyForUrl')));
- if @WinHttpGetProxyForUrl = nil then
- Exit;
- WinHttpGetIEProxyConfigForCurrentUser := GetProcAddress(WinHttpModule,PAnsiChar(AnsiString('WinHttpGetIEProxyConfigForCurrentUser')));
- if @WinHttpGetIEProxyConfigForCurrentUser = nil then
- Exit;
- WinHttpCloseHandle := GetProcAddress(WinHttpModule,PAnsiChar(AnsiString('WinHttpCloseHandle')));
- if @WinHttpCloseHandle = nil then
- Exit;
- AutoDetectProxy := False;
- FillChar(AutoProxyOptions, SizeOf(AutoProxyOptions), 0);
- if WinHttpGetIEProxyConfigForCurrentUser(IEProxyConfig) then
- begin
- if IEProxyConfig.fAutoDetect then
- begin
- AutoProxyOptions.dwFlags := WINHTTP_AUTOPROXY_AUTO_DETECT;
- AutoProxyOptions.dwAutoDetectFlags := WINHTTP_AUTO_DETECT_TYPE_DHCP or
- WINHTTP_AUTO_DETECT_TYPE_DNS_A;
- AutoDetectProxy := True;
- end;
- if IEProxyConfig.lpszAutoConfigURL <> '' then
- begin
- AutoProxyOptions.dwFlags := AutoProxyOptions.dwFlags or
- WINHTTP_AUTOPROXY_CONFIG_URL;
- AutoProxyOptions.lpszAutoConfigUrl := IEProxyConfig.lpszAutoConfigUrl;
- AutoDetectProxy := True;
- end;
- if not AutoDetectProxy then
- begin
- Result.Host := IEProxyConfig.lpszProxy;
- Result.Bypass := IEProxyConfig.lpszProxyBypass;
- Result.Autodetected := false;
- end;
- end
- else
- begin
- AutoProxyOptions.dwFlags := WINHTTP_AUTOPROXY_AUTO_DETECT;
- AutoProxyOptions.dwAutoDetectFlags := WINHTTP_AUTO_DETECT_TYPE_DHCP or
- WINHTTP_AUTO_DETECT_TYPE_DNS_A;
- AutoDetectProxy := True;
- end;
- if AutoDetectProxy then
- begin
- Session := WinHttpOpen(nil, WINHTTP_ACCESS_TYPE_DEFAULT_PROXY,
- WINHTTP_NO_PROXY_NAME, WINHTTP_NO_PROXY_BYPASS, 0);
- if Assigned(Session) then
- try
- if WinHttpGetProxyForUrl(Session, LPCWSTR(AURL),
- @AutoProxyOptions, WinHttpProxyInfo) then
- begin
- Result.Host := WinHttpProxyInfo.lpszProxy;
- Result.Bypass := WinHttpProxyInfo.lpszProxyBypass;
- Result.Autodetected := True;
- end
- else
- Result.ResultCode := GetLastError;
- finally
- WinHttpCloseHandle(Session);
- end
- else
- Result.ResultCode := GetLastError;
- end;
- if Result.Host <> '' then
- begin
- Result.Port := Trim(SeparateRight(Result.Host, ':'));
- Result.Host := Trim(SeparateLeft(Result.Host, ':'));
- end;
- finally
- FreeLibrary(WinHttpModule);
- end;
- end;
- {$ENDIF}
- end.
|