synamisc.pas 22 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693
  1. {==============================================================================|
  2. | Project : Ararat Synapse | 001.004.000 |
  3. |==============================================================================|
  4. | Content: misc. procedures and functions |
  5. |==============================================================================|
  6. | Copyright (c)1999-2022, Lukas Gebauer |
  7. | All rights reserved. |
  8. | |
  9. | Redistribution and use in source and binary forms, with or without |
  10. | modification, are permitted provided that the following conditions are met: |
  11. | |
  12. | Redistributions of source code must retain the above copyright notice, this |
  13. | list of conditions and the following disclaimer. |
  14. | |
  15. | Redistributions in binary form must reproduce the above copyright notice, |
  16. | this list of conditions and the following disclaimer in the documentation |
  17. | and/or other materials provided with the distribution. |
  18. | |
  19. | Neither the name of Lukas Gebauer nor the names of its contributors may |
  20. | be used to endorse or promote products derived from this software without |
  21. | specific prior written permission. |
  22. | |
  23. | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" |
  24. | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
  25. | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
  26. | ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR |
  27. | ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
  28. | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR |
  29. | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER |
  30. | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
  31. | LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
  32. | OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH |
  33. | DAMAGE. |
  34. |==============================================================================|
  35. | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
  36. | Portions created by Lukas Gebauer are Copyright (c) 2002-2022. |
  37. | All Rights Reserved. |
  38. |==============================================================================|
  39. | Contributor(s): |
  40. |==============================================================================|
  41. | History: see HISTORY.HTM from distribution package |
  42. | (Found at URL: http://www.ararat.cz/synapse/) |
  43. |==============================================================================}
  44. {:@abstract(Miscellaneous network based utilities)}
  45. {$IFDEF FPC}
  46. {$MODE DELPHI}
  47. {$ENDIF}
  48. {$Q-}
  49. {$H+}
  50. //Kylix does not known UNIX define
  51. {$IFDEF LINUX}
  52. {$IFNDEF UNIX}
  53. {$DEFINE UNIX}
  54. {$ENDIF}
  55. {$ENDIF}
  56. {$IFDEF POSIX}
  57. {$IFNDEF UNIX}
  58. {$DEFINE UNIX}
  59. {$ENDIF}
  60. {$ENDIF}
  61. {$TYPEDADDRESS OFF}
  62. {$IFDEF UNICODE}
  63. {$WARN IMPLICIT_STRING_CAST OFF}
  64. {$WARN IMPLICIT_STRING_CAST_LOSS OFF}
  65. {$ENDIF}
  66. unit synamisc;
  67. interface
  68. {$IFDEF VER125}
  69. {$DEFINE BCB}
  70. {$ENDIF}
  71. {$IFDEF BCB}
  72. {$ObjExportAll On}
  73. {$HPPEMIT '#pragma comment( lib , "wininet.lib" )'}
  74. {$ENDIF}
  75. uses
  76. synautil, blcksock, SysUtils, Classes
  77. {$IFDEF POSIX}
  78. ,Types,Posix.Stdlib
  79. {$ELSE}
  80. {$IFDEF UNIX}
  81. {$IFNDEF FPC}
  82. , Libc
  83. {$ENDIF}
  84. {$ELSE}
  85. {$IFDEF ULTIBO}
  86. , GlobalConst, Iphlpapi
  87. {$ELSE}
  88. , Windows
  89. {$ENDIF}
  90. {$ENDIF}
  91. ;
  92. const
  93. lIPV4 = 1;
  94. lIPV6 = 2;
  95. Type
  96. {:@abstract(This record contains information about proxy settings.)}
  97. TProxySetting = record
  98. Host: string;
  99. Port: string;
  100. Bypass: string;
  101. ResultCode: integer;
  102. Autodetected: boolean;
  103. end;
  104. {:With this function you can turn on a computer on the network, if this computer
  105. supports Wake-on-LAN feature. You need the MAC address
  106. (network card identifier) of the computer. You can also assign a target IP
  107. addres. If you do not specify it, then broadcast is used to deliver magic
  108. wake-on-LAN packet.
  109. However broadcasts work only on your local network. When you need to wake-up a
  110. computer on another network, you must specify any existing IP addres on same
  111. network segment as targeting computer.}
  112. procedure WakeOnLan(MAC, IP: string);
  113. {:Autodetect current DNS servers used by the system. If more than one DNS server
  114. is defined, then the result is comma-delimited.}
  115. function GetDNS: string;
  116. {:Read InternetExplorer 5.0+ proxy setting for given protocol. This function
  117. works only on windows!}
  118. function GetIEProxy(protocol: string): TProxySetting;
  119. {:Return all known IP addresses of required type on the local system. Addresses are divided by
  120. comma/comma-delimited.}
  121. function GetLocalIPsFamily(value: TSocketFamily): string;
  122. {:Return all known IP addresses on the local system. Addresses are divided by
  123. comma/comma-delimited.}
  124. function GetLocalIPs: string;
  125. {$IFDEF MSWINDOWS}
  126. {:Autodetect system proxy setting for specified URL. This function
  127. works only on windows!}
  128. function GetProxyForURL(const AURL: WideString): TProxySetting;
  129. {$ENDIF}
  130. implementation
  131. {==============================================================================}
  132. procedure WakeOnLan(MAC, IP: string);
  133. var
  134. sock: TUDPBlockSocket;
  135. HexMac: string;
  136. data: string;
  137. n: integer;
  138. b: Byte;
  139. begin
  140. if MAC <> '' then
  141. begin
  142. MAC := ReplaceString(MAC, '-', '');
  143. MAC := ReplaceString(MAC, ':', '');
  144. if Length(MAC) < 12 then
  145. Exit;
  146. HexMac := '';
  147. for n := 0 to 5 do
  148. begin
  149. b := StrToIntDef('$' + MAC[n * 2 + 1] + MAC[n * 2 + 2], 0);
  150. HexMac := HexMac + char(b);
  151. end;
  152. if IP = '' then
  153. IP := cBroadcast;
  154. sock := TUDPBlockSocket.Create;
  155. try
  156. sock.CreateSocket;
  157. sock.EnableBroadcast(true);
  158. sock.Connect(IP, '9');
  159. data := #$FF + #$FF + #$FF + #$FF + #$FF + #$FF;
  160. for n := 1 to 16 do
  161. data := data + HexMac;
  162. sock.SendString(data);
  163. finally
  164. sock.Free;
  165. end;
  166. end;
  167. end;
  168. {==============================================================================}
  169. {$IFNDEF UNIX}
  170. function GetDNSbyIpHlp: string;
  171. {$IFDEF ULTIBO}
  172. var
  173. InfoSize: DWORD;
  174. FixedInfo: TFixedInfo;
  175. PDnsServer: PIP_ADDR_STRING;
  176. ResultCode: DWORD;
  177. begin
  178. Result:='';
  179. InfoSize:=SizeOf(TFixedInfo);
  180. ResultCode:=GetNetworkParams(@FixedInfo,InfoSize);
  181. if ResultCode <> ERROR_SUCCESS then Exit;
  182. Result:=FixedInfo.DnsServerList.IpAddress.S;
  183. PDnsServer:=FixedInfo.DnsServerList.Next;
  184. while PDnsServer <> nil do
  185. begin
  186. if Result <> '' then Result:=Result + ',';
  187. Result:=Result + PDnsServer^.IPAddress.S;
  188. PDnsServer:=PDnsServer.Next;
  189. end;
  190. end;
  191. {$ELSE}
  192. type
  193. PTIP_ADDRESS_STRING = ^TIP_ADDRESS_STRING;
  194. TIP_ADDRESS_STRING = array[0..15] of Ansichar;
  195. PTIP_ADDR_STRING = ^TIP_ADDR_STRING;
  196. TIP_ADDR_STRING = packed record
  197. Next: PTIP_ADDR_STRING;
  198. IpAddress: TIP_ADDRESS_STRING;
  199. IpMask: TIP_ADDRESS_STRING;
  200. Context: DWORD;
  201. end;
  202. PTFixedInfo = ^TFixedInfo;
  203. TFixedInfo = packed record
  204. HostName: array[1..128 + 4] of Ansichar;
  205. DomainName: array[1..128 + 4] of Ansichar;
  206. CurrentDNSServer: PTIP_ADDR_STRING;
  207. DNSServerList: TIP_ADDR_STRING;
  208. NodeType: UINT;
  209. ScopeID: array[1..256 + 4] of Ansichar;
  210. EnableRouting: UINT;
  211. EnableProxy: UINT;
  212. EnableDNS: UINT;
  213. end;
  214. const
  215. IpHlpDLL = 'IPHLPAPI.DLL';
  216. var
  217. IpHlpModule: THandle;
  218. FixedInfo: PTFixedInfo;
  219. InfoSize: Longint;
  220. PDnsServer: PTIP_ADDR_STRING;
  221. err: integer;
  222. GetNetworkParams: function(FixedInfo: PTFixedInfo; pOutPutLen: PULONG): DWORD; stdcall;
  223. begin
  224. InfoSize := 0;
  225. Result := '...';
  226. IpHlpModule := LoadLibrary(IpHlpDLL);
  227. if IpHlpModule = 0 then
  228. exit;
  229. try
  230. GetNetworkParams := GetProcAddress(IpHlpModule,PAnsiChar(AnsiString('GetNetworkParams')));
  231. if @GetNetworkParams = nil then
  232. Exit;
  233. err := GetNetworkParams(Nil, @InfoSize);
  234. if err <> ERROR_BUFFER_OVERFLOW then
  235. Exit;
  236. Result := '';
  237. GetMem (FixedInfo, InfoSize);
  238. try
  239. err := GetNetworkParams(FixedInfo, @InfoSize);
  240. if err <> ERROR_SUCCESS then
  241. exit;
  242. with FixedInfo^ do
  243. begin
  244. Result := DnsServerList.IpAddress;
  245. PDnsServer := DnsServerList.Next;
  246. while PDnsServer <> Nil do
  247. begin
  248. if Result <> '' then
  249. Result := Result + ',';
  250. Result := Result + PDnsServer^.IPAddress;
  251. PDnsServer := PDnsServer.Next;
  252. end;
  253. end;
  254. finally
  255. FreeMem(FixedInfo);
  256. end;
  257. finally
  258. FreeLibrary(IpHlpModule);
  259. end;
  260. end;
  261. function ReadReg(SubKey, Vn: PChar): string;
  262. var
  263. OpenKey: HKEY;
  264. DataType, DataSize: integer;
  265. Temp: array [0..2048] of char;
  266. begin
  267. Result := '';
  268. if RegOpenKeyEx(HKEY_LOCAL_MACHINE, SubKey, REG_OPTION_NON_VOLATILE,
  269. KEY_READ, OpenKey) = ERROR_SUCCESS then
  270. begin
  271. DataType := REG_SZ;
  272. DataSize := SizeOf(Temp);
  273. if RegQueryValueEx(OpenKey, Vn, nil, @DataType, @Temp, @DataSize) = ERROR_SUCCESS then
  274. SetString(Result, Temp, DataSize div SizeOf(Char) - 1);
  275. RegCloseKey(OpenKey);
  276. end;
  277. end ;
  278. {$ENDIF}
  279. {$ENDIF}
  280. function GetDNS: string;
  281. {$IFDEF ULTIBO}
  282. begin
  283. Result := GetDNSbyIpHlp;
  284. end;
  285. {$ELSE}
  286. {$IFDEF UNIX}
  287. var
  288. l: TStringList;
  289. n: integer;
  290. begin
  291. Result := '';
  292. l := TStringList.Create;
  293. try
  294. l.LoadFromFile('/etc/resolv.conf');
  295. for n := 0 to l.Count - 1 do
  296. if Pos('NAMESERVER', uppercase(l[n])) = 1 then
  297. begin
  298. if Result <> '' then
  299. Result := Result + ',';
  300. Result := Result + SeparateRight(l[n], ' ');
  301. end;
  302. finally
  303. l.Free;
  304. end;
  305. end;
  306. {$ELSE}
  307. const
  308. NTdyn = 'System\CurrentControlSet\Services\Tcpip\Parameters\Temporary';
  309. NTfix = 'System\CurrentControlSet\Services\Tcpip\Parameters';
  310. W9xfix = 'System\CurrentControlSet\Services\MSTCP';
  311. begin
  312. Result := GetDNSbyIpHlp;
  313. if Result = '...' then
  314. begin
  315. if Win32Platform = VER_PLATFORM_WIN32_NT then
  316. begin
  317. Result := ReadReg(NTdyn, 'NameServer');
  318. if result = '' then
  319. Result := ReadReg(NTfix, 'NameServer');
  320. if result = '' then
  321. Result := ReadReg(NTfix, 'DhcpNameServer');
  322. end
  323. else
  324. Result := ReadReg(W9xfix, 'NameServer');
  325. Result := ReplaceString(trim(Result), ' ', ',');
  326. end;
  327. end;
  328. {$ENDIF}
  329. {$ENDIF}
  330. {==============================================================================}
  331. function GetIEProxy(protocol: string): TProxySetting;
  332. {$IFDEF ULTIBO}
  333. begin
  334. Result.Host := '';
  335. Result.Port := '';
  336. Result.Bypass := '';
  337. end;
  338. {$ELSE}
  339. {$IFDEF UNIX}
  340. begin
  341. Result.Host := '';
  342. Result.Port := '';
  343. Result.Bypass := '';
  344. Result.ResultCode := -1;
  345. Result.Autodetected := false;
  346. end;
  347. {$ELSE}
  348. type
  349. PInternetPerConnOption = ^INTERNET_PER_CONN_OPTION;
  350. INTERNET_PER_CONN_OPTION = record
  351. dwOption: DWORD;
  352. case Integer of
  353. 0: (dwValue: DWORD);
  354. // 1: (pszValue:LPTSTR);
  355. 1: (pszValue:PAnsiChar);
  356. 2: (ftValue: FILETIME);
  357. end;
  358. PInternetPerConnOptionList = ^INTERNET_PER_CONN_OPTION_LIST;
  359. INTERNET_PER_CONN_OPTION_LIST = record
  360. dwSize :DWORD;
  361. // pszConnection :LPTSTR;
  362. pszConnection :PAnsiChar;
  363. dwOptionCount :DWORD;
  364. dwOptionError :DWORD;
  365. pOptions :PInternetPerConnOption;
  366. end;
  367. const
  368. INTERNET_PER_CONN_FLAGS = 1;
  369. INTERNET_PER_CONN_PROXY_SERVER = 2;
  370. INTERNET_PER_CONN_PROXY_BYPASS = 3;
  371. INTERNET_PER_CONN_AUTOCONFIG_URL = 4;
  372. INTERNET_PER_CONN_AUTODISCOVERY_FLAGS = 5;
  373. PROXY_TYPE_DIRECT = $00000001; // direct to net
  374. PROXY_TYPE_PROXY = $00000002; // via named proxy
  375. PROXY_TYPE_AUTO_PROXY_URL = $00000004; // autoproxy URL
  376. PROXY_TYPE_AUTO_DETECT = $00000008; // use autoproxy detection
  377. AUTO_PROXY_FLAG_USER_SET = $00000001; // user changed this setting
  378. AUTO_PROXY_FLAG_ALWAYS_DETECT = $00000002; // force detection even when its not needed
  379. AUTO_PROXY_FLAG_DETECTION_RUN = $00000004; // detection has been run
  380. AUTO_PROXY_FLAG_MIGRATED = $00000008; // migration has just been done
  381. AUTO_PROXY_FLAG_DONT_CACHE_PROXY_RESULT = $00000010; // don't cache result of host=proxy name
  382. AUTO_PROXY_FLAG_CACHE_INIT_RUN = $00000020; // don't initalize and run unless URL expired
  383. AUTO_PROXY_FLAG_DETECTION_SUSPECT = $00000040; // if we're on a LAN & Modem, with only one IP, bad?!?
  384. INTERNET_OPTION_PER_CONNECTION_OPTION = 75;
  385. WininetDLL = 'WININET.DLL';
  386. var
  387. WininetModule: THandle;
  388. Option : array[0..4] of INTERNET_PER_CONN_OPTION;
  389. List : INTERNET_PER_CONN_OPTION_LIST;
  390. Err: Boolean;
  391. Len: DWORD;
  392. Proxy: string;
  393. DefProxy: string;
  394. ProxyList: TStringList;
  395. n: integer;
  396. InternetQueryOption: function (hInet: Pointer; dwOption: DWORD;
  397. lpBuffer: Pointer; var lpdwBufferLength: DWORD): BOOL; stdcall;
  398. begin
  399. Result.Host := '';
  400. Result.Port := '';
  401. Result.Bypass := '';
  402. Result.ResultCode := 0;
  403. Result.Autodetected := false;
  404. WininetModule := LoadLibrary(WininetDLL);
  405. if WininetModule = 0 then
  406. exit;
  407. try
  408. InternetQueryOption := GetProcAddress(WininetModule,PAnsiChar(AnsiString('InternetQueryOptionA')));
  409. if @InternetQueryOption = nil then
  410. Exit;
  411. if protocol = '' then
  412. protocol := 'http';
  413. ProxyList := TStringList.Create;
  414. try
  415. Option[0].dwOption := INTERNET_PER_CONN_AUTOCONFIG_URL;
  416. Option[1].dwOption := INTERNET_PER_CONN_AUTODISCOVERY_FLAGS;
  417. Option[2].dwOption := INTERNET_PER_CONN_FLAGS;
  418. Option[3].dwOption := INTERNET_PER_CONN_PROXY_BYPASS;
  419. Option[4].dwOption := INTERNET_PER_CONN_PROXY_SERVER;
  420. List.dwSize := SizeOf(INTERNET_PER_CONN_OPTION_LIST);
  421. List.pszConnection := nil; // LAN
  422. List.dwOptionCount := 5;
  423. List.dwOptionError := 0;
  424. List.pOptions := @Option;
  425. Err := InternetQueryOption(nil, INTERNET_OPTION_PER_CONNECTION_OPTION, @List, List.dwSize);
  426. if Err then
  427. begin
  428. ProxyList.CommaText := ReplaceString(Option[4].pszValue, ' ', ',');
  429. Proxy := '';
  430. DefProxy := '';
  431. for n := 0 to ProxyList.Count -1 do
  432. begin
  433. if Pos(lowercase(protocol) + '=', lowercase(ProxyList[n])) = 1 then
  434. begin
  435. Proxy := SeparateRight(ProxyList[n], '=');
  436. break;
  437. end;
  438. if Pos('=', ProxyList[n]) < 1 then
  439. DefProxy := ProxyList[n];
  440. end;
  441. if Proxy = '' then
  442. Proxy := DefProxy;
  443. if Proxy <> '' then
  444. begin
  445. Result.Host := Trim(SeparateLeft(Proxy, ':'));
  446. Result.Port := Trim(SeparateRight(Proxy, ':'));
  447. end;
  448. Result.Bypass := ReplaceString(Option[3].pszValue, ' ', ',');
  449. end;
  450. finally
  451. ProxyList.Free;
  452. end;
  453. finally
  454. FreeLibrary(WininetModule);
  455. end;
  456. end;
  457. {$ENDIF}
  458. {$ENDIF}
  459. {==============================================================================}
  460. function GetLocalIPsFamily(value: TSocketFamily): string;
  461. var
  462. TcpSock: TTCPBlockSocket;
  463. ipList: TStringList;
  464. begin
  465. Result := '';
  466. ipList := TStringList.Create;
  467. try
  468. TcpSock := TTCPBlockSocket.create;
  469. try
  470. if value <> SF_Any then
  471. TcpSock.family := value;
  472. TcpSock.ResolveNameToIP(TcpSock.LocalName, ipList);
  473. Result := ipList.CommaText;
  474. finally
  475. TcpSock.Free;
  476. end;
  477. finally
  478. ipList.Free;
  479. end;
  480. end;
  481. function GetLocalIPs: string;
  482. begin
  483. Result := GetLocalIPsFamily(SF_Any);
  484. end;
  485. {==============================================================================}
  486. {$IFDEF MSWINDOWS}
  487. function GetProxyForURL(const AURL: WideString): TProxySetting;
  488. type
  489. HINTERNET = Pointer;
  490. INTERNET_PORT = Word;
  491. PWinHTTPProxyInfo = ^TWinHTTPProxyInfo;
  492. WINHTTP_PROXY_INFO = record
  493. dwAccessType: DWORD;
  494. lpszProxy: LPWSTR;
  495. lpszProxyBypass: LPWSTR;
  496. end;
  497. TWinHTTPProxyInfo = WINHTTP_PROXY_INFO;
  498. LPWINHTTP_PROXY_INFO = PWinHTTPProxyInfo;
  499. PWinHTTPAutoProxyOptions = ^TWinHTTPAutoProxyOptions;
  500. WINHTTP_AUTOPROXY_OPTIONS = record
  501. dwFlags: DWORD;
  502. dwAutoDetectFlags: DWORD;
  503. lpszAutoConfigUrl: LPCWSTR;
  504. lpvReserved: Pointer;
  505. dwReserved: DWORD;
  506. fAutoLogonIfChallenged: BOOL;
  507. end;
  508. TWinHTTPAutoProxyOptions = WINHTTP_AUTOPROXY_OPTIONS;
  509. LPWINHTTP_AUTOPROXY_OPTIONS = PWinHTTPAutoProxyOptions;
  510. PWinHTTPCurrentUserIEProxyConfig = ^TWinHTTPCurrentUserIEProxyConfig;
  511. WINHTTP_CURRENT_USER_IE_PROXY_CONFIG = record
  512. fAutoDetect: BOOL;
  513. lpszAutoConfigUrl: LPWSTR;
  514. lpszProxy: LPWSTR;
  515. lpszProxyBypass: LPWSTR;
  516. end;
  517. TWinHTTPCurrentUserIEProxyConfig = WINHTTP_CURRENT_USER_IE_PROXY_CONFIG;
  518. LPWINHTTP_CURRENT_USER_IE_PROXY_CONFIG = PWinHTTPCurrentUserIEProxyConfig;
  519. const
  520. WINHTTP_NO_REFERER = nil;
  521. WINHTTP_NO_PROXY_NAME = nil;
  522. WINHTTP_NO_PROXY_BYPASS = nil;
  523. WINHTTP_DEFAULT_ACCEPT_TYPES = nil;
  524. WINHTTP_ACCESS_TYPE_DEFAULT_PROXY = 0;
  525. WINHTTP_ACCESS_TYPE_NO_PROXY = 1;
  526. WINHTTP_OPTION_PROXY = 38;
  527. WINHTTP_OPTION_PROXY_USERNAME = $1002;
  528. WINHTTP_OPTION_PROXY_PASSWORD = $1003;
  529. WINHTTP_AUTOPROXY_AUTO_DETECT = $00000001;
  530. WINHTTP_AUTOPROXY_CONFIG_URL = $00000002;
  531. WINHTTP_AUTO_DETECT_TYPE_DHCP = $00000001;
  532. WINHTTP_AUTO_DETECT_TYPE_DNS_A = $00000002;
  533. WINHTTP_FLAG_BYPASS_PROXY_CACHE = $00000100;
  534. WINHTTP_FLAG_REFRESH = WINHTTP_FLAG_BYPASS_PROXY_CACHE;
  535. var
  536. WinHttpModule: THandle;
  537. Session: HINTERNET;
  538. AutoDetectProxy: Boolean;
  539. WinHttpProxyInfo: TWinHTTPProxyInfo;
  540. AutoProxyOptions: TWinHTTPAutoProxyOptions;
  541. IEProxyConfig: TWinHTTPCurrentUserIEProxyConfig;
  542. WinHttpOpen: function (pwszUserAgent: LPCWSTR; dwAccessType: DWORD;
  543. pwszProxyName, pwszProxyBypass: LPCWSTR; dwFlags: DWORD): HINTERNET; stdcall;
  544. WinHttpConnect: function(hSession: HINTERNET; pswzServerName: LPCWSTR;
  545. nServerPort: INTERNET_PORT; dwReserved: DWORD): HINTERNET; stdcall;
  546. WinHttpOpenRequest: function(hConnect: HINTERNET; pwszVerb: LPCWSTR;
  547. pwszObjectName: LPCWSTR; pwszVersion: LPCWSTR; pwszReferer: LPCWSTR;
  548. ppwszAcceptTypes: PLPWSTR; dwFlags: DWORD): HINTERNET; stdcall;
  549. WinHttpQueryOption: function(hInet: HINTERNET; dwOption: DWORD;
  550. lpBuffer: Pointer; var lpdwBufferLength: DWORD): BOOL; stdcall;
  551. WinHttpGetProxyForUrl: function(hSession: HINTERNET; lpcwszUrl: LPCWSTR;
  552. pAutoProxyOptions: LPWINHTTP_AUTOPROXY_OPTIONS;
  553. var pProxyInfo: WINHTTP_PROXY_INFO): BOOL; stdcall;
  554. WinHttpGetIEProxyConfigForCurrentUser: function(
  555. var pProxyInfo: WINHTTP_CURRENT_USER_IE_PROXY_CONFIG): BOOL; stdcall;
  556. WinHttpCloseHandle: function(hInternet: HINTERNET): BOOL; stdcall;
  557. begin
  558. Result.Host := '';
  559. Result.Port := '';
  560. Result.Bypass := '';
  561. Result.ResultCode := 0;
  562. Result.Autodetected := false;
  563. WinHttpModule := LoadLibrary('winhttp.dll');
  564. if WinHttpModule = 0 then
  565. exit;
  566. try
  567. WinHttpOpen := GetProcAddress(WinHttpModule,PAnsiChar(AnsiString('WinHttpOpen')));
  568. if @WinHttpOpen = nil then
  569. Exit;
  570. WinHttpConnect := GetProcAddress(WinHttpModule,PAnsiChar(AnsiString('WinHttpConnect')));
  571. if @WinHttpConnect = nil then
  572. Exit;
  573. WinHttpOpenRequest := GetProcAddress(WinHttpModule,PAnsiChar(AnsiString('WinHttpOpenRequest')));
  574. if @WinHttpOpenRequest = nil then
  575. Exit;
  576. WinHttpQueryOption := GetProcAddress(WinHttpModule,PAnsiChar(AnsiString('WinHttpQueryOption')));
  577. if @WinHttpQueryOption = nil then
  578. Exit;
  579. WinHttpGetProxyForUrl := GetProcAddress(WinHttpModule,PAnsiChar(AnsiString('WinHttpGetProxyForUrl')));
  580. if @WinHttpGetProxyForUrl = nil then
  581. Exit;
  582. WinHttpGetIEProxyConfigForCurrentUser := GetProcAddress(WinHttpModule,PAnsiChar(AnsiString('WinHttpGetIEProxyConfigForCurrentUser')));
  583. if @WinHttpGetIEProxyConfigForCurrentUser = nil then
  584. Exit;
  585. WinHttpCloseHandle := GetProcAddress(WinHttpModule,PAnsiChar(AnsiString('WinHttpCloseHandle')));
  586. if @WinHttpCloseHandle = nil then
  587. Exit;
  588. AutoDetectProxy := False;
  589. FillChar(AutoProxyOptions, SizeOf(AutoProxyOptions), 0);
  590. if WinHttpGetIEProxyConfigForCurrentUser(IEProxyConfig) then
  591. begin
  592. if IEProxyConfig.fAutoDetect then
  593. begin
  594. AutoProxyOptions.dwFlags := WINHTTP_AUTOPROXY_AUTO_DETECT;
  595. AutoProxyOptions.dwAutoDetectFlags := WINHTTP_AUTO_DETECT_TYPE_DHCP or
  596. WINHTTP_AUTO_DETECT_TYPE_DNS_A;
  597. AutoDetectProxy := True;
  598. end;
  599. if IEProxyConfig.lpszAutoConfigURL <> '' then
  600. begin
  601. AutoProxyOptions.dwFlags := AutoProxyOptions.dwFlags or
  602. WINHTTP_AUTOPROXY_CONFIG_URL;
  603. AutoProxyOptions.lpszAutoConfigUrl := IEProxyConfig.lpszAutoConfigUrl;
  604. AutoDetectProxy := True;
  605. end;
  606. if not AutoDetectProxy then
  607. begin
  608. Result.Host := IEProxyConfig.lpszProxy;
  609. Result.Bypass := IEProxyConfig.lpszProxyBypass;
  610. Result.Autodetected := false;
  611. end;
  612. end
  613. else
  614. begin
  615. AutoProxyOptions.dwFlags := WINHTTP_AUTOPROXY_AUTO_DETECT;
  616. AutoProxyOptions.dwAutoDetectFlags := WINHTTP_AUTO_DETECT_TYPE_DHCP or
  617. WINHTTP_AUTO_DETECT_TYPE_DNS_A;
  618. AutoDetectProxy := True;
  619. end;
  620. if AutoDetectProxy then
  621. begin
  622. Session := WinHttpOpen(nil, WINHTTP_ACCESS_TYPE_DEFAULT_PROXY,
  623. WINHTTP_NO_PROXY_NAME, WINHTTP_NO_PROXY_BYPASS, 0);
  624. if Assigned(Session) then
  625. try
  626. if WinHttpGetProxyForUrl(Session, LPCWSTR(AURL),
  627. @AutoProxyOptions, WinHttpProxyInfo) then
  628. begin
  629. Result.Host := WinHttpProxyInfo.lpszProxy;
  630. Result.Bypass := WinHttpProxyInfo.lpszProxyBypass;
  631. Result.Autodetected := True;
  632. end
  633. else
  634. Result.ResultCode := GetLastError;
  635. finally
  636. WinHttpCloseHandle(Session);
  637. end
  638. else
  639. Result.ResultCode := GetLastError;
  640. end;
  641. if Result.Host <> '' then
  642. begin
  643. Result.Port := Trim(SeparateRight(Result.Host, ':'));
  644. Result.Host := Trim(SeparateLeft(Result.Host, ':'));
  645. end;
  646. finally
  647. FreeLibrary(WinHttpModule);
  648. end;
  649. end;
  650. {$ENDIF}
  651. end.