PageRenderTime 94ms CodeModel.GetById 21ms RepoModel.GetById 0ms app.codeStats 2ms

/trunk/Common/Overbyte ICS 7/OverbyteIcsWSocket.pas

http://castlesand.googlecode.com/
Pascal | 13101 lines | 8520 code | 1213 blank | 3368 comment | 953 complexity | 18a1064fb08682cabeaaa7b92ee1e260 MD5 | raw file
Possible License(s): MIT, LGPL-2.0, LGPL-3.0 
    

  1. {*_* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

    2. 

  2. 

    3. 

  3. Author:       François PIETTE

    4. 

  4. Description:  TWSocket class encapsulate the Windows Socket paradigm

    5. 

  5. Creation:     April 1996

    6. 

  6. Version:      7.47

    7. 

  7. EMail:        francois.piette@overbyte.be  http://www.overbyte.be

    8. 

  8. Support:      Use the mailing list twsocket@elists.org

    9. 

  9.               Follow "support" link at http://www.overbyte.be for subscription.

    10. 

  10. Legal issues: Copyright (C) 1996-2010 by François PIETTE

    11. 

  11.               Rue de Grady 24, 4053 Embourg, Belgium. Fax: +32-4-365.74.56

    12. 

  12.               <francois.piette@overbyte.be>

    13. 

  13.               SSL implementation includes code written by Arno Garrels,

    14. 

  14.               Berlin, Germany, contact: <arno.garrels@gmx.de>

    15. 

  15. 

    16. 

  16.               This software is provided 'as-is', without any express or

    17. 

  17.               implied warranty.  In no event will the author be held liable

    18. 

  18.               for any  damages arising from the use of this software.

    19. 

  19. 

    20. 

  20.               Permission is granted to anyone to use this software for any

    21. 

  21.               purpose, including commercial applications, and to alter it

    22. 

  22.               and redistribute it freely, subject to the following

    23. 

  23.               restrictions:

    24. 

  24. 

    25. 

  25.               1. The origin of this software must not be misrepresented,

    26. 

  26.                  you must not claim that you wrote the original software.

    27. 

  27.                  If you use this software in a product, an acknowledgment

    28. 

  28.                  in the product documentation would be appreciated but is

    29. 

  29.                  not required.

    30. 

  30. 

    31. 

  31.               2. Altered source versions must be plainly marked as such, and

    32. 

  32.                  must not be misrepresented as being the original software.

    33. 

  33. 

    34. 

  34.               3. This notice may not be removed or altered from any source

    35. 

  35.                  distribution.

    36. 

  36. 

    37. 

  37.               4. You must register this software by sending a picture postcard

    38. 

  38.                  to the author. Use a nice stamp and mention your name, street

    39. 

  39.                  address, EMail address and any comment you like to say.

    40. 

  40. 

    41. 

  41. History:

    42. 

  42. If not otherwise noted, changes are by Francois Piette

    43. 

  43. Jul 18, 1996  Move all low level socket to winsock to be Delphi 2.x compatible

    44. 

  44. Sep 18, 1996  Use structured exception for handling errors

    45. 

  45. Sep 19, 1996  Check csDestroying before invoking event handler

    46. 

  46. Nov 04, 1996  Better error handling

    47. 

  47. Jan 31, 1997  Changed property assignation for Addr, Port and Proto

    48. 

  48.               Added notification handler

    49. 

  49. Feb 14, 1997  Corrected bug in property assignation for Addr, Port and Proto

    50. 

  50. Mar 26, 1997  Make UDP protocol work correctly

    51. 

  51.               Enable UDP broadcasting by using addr 255.255.255.255

    52. 

  52. Apr 1, 1997   Added class function when independent of any open socket

    53. 

  53.               Moved InitData as global

    54. 

  54.               Added ReceivedFrom function

    55. 

  55.               Added ResolveHost function

    56. 

  56. Jul 22, 1997  Adapted to Delphi 3 which has a modified winsock.accept

    57. 

  57. Aug 13, 1997  'sin' member made public

    58. 

  58. Aug 24, 1997  Create the only help

    59. 

  59.               Makes writing HSocket the same as calling Dup.

    60. 

  60. Sep 5, 1997   Version 2.01, added WinsockInfo function

    61. 

  61. Sep 21, 1997  Version 2.02, make it really thread safe

    62. 

  62.                             created global WSocketVersion

    63. 

  63. Sep 25, 1997  Version 2.04, port to C++Builder

    64. 

  64. Sep 27, 1997  Version 2.05. All class methods converted to global

    65. 

  65.               procedure or function because C++Builder do not like

    66. 

  66.               class method very much.

    67. 

  67.               Old class method              New global function

    68. 

  68.               ----------------              -------------------

    69. 

  69.               WinsockInfo                   WinsockInfo

    70. 

  70.               SocketErrorDesc               WSocketErrorDesc

    71. 

  71.               GetHostByAddr                 WSocketGetHostByAddr

    72. 

  72.               GetHostByName                 WSocketGetHostByName

    73. 

  73.               ResolveHost                   WSocketResolveHost

    74. 

  74.               HostName                      LocalHostName

    75. 

  75. Oct 02, 1997  V2.06 Added a check in destructor to avoid calling WSACleanup at

    76. 

  76.               design time which crashes the excellent Eagle Software CDK.

    77. 

  77. Oct 16, 1997  V2.07 Added PortNum property with numeric value for Port.

    78. 

  78.               Added RcvdCount property to return the number of

    79. 

  79.               characters received in the buffer but not read yet. Do not

    80. 

  80.               confuse with ReadCount which returns the number of chars

    81. 

  81.               already received.

    82. 

  82.               Added a check for FWait assignation in front of ReadLine

    83. 

  83.               Prefixed each TSocketState value by 'ws' to avoid name conflict.

    84. 

  84.               Moved FHSocket member to private section because the property

    85. 

  85.               HSocket does the right job.

    86. 

  86.               Added a check for state closed when changing Port, Proto and Addr.

    87. 

  87. Oct 22, 1997  V2.08 Added Flush method (asked by john@nexnix.co.uk) and

    88. 

  88.               FlushTimeout property (default to 60 seconds).

    89. 

  89. Oct 22, 1997  V2.09 Added SendFlags property to enable sending in or out of

    90. 

  90.               band data (normal or urgent, see RFC-1122)

    91. 

  91. Oct 28, 1997  V2.10 Added an OnLineTooLong event and code to handle the case

    92. 

  92.               where ReadLine has been called and the buffer overflowed (line

    93. 

  93.               long)

    94. 

  94. Oct 29, 1997  V2.11 Added DnsLookup functionnality (DnsLookup method, DnsResult

    95. 

  95.               property and DnsLookupDone event).

    96. 

  96.               Calling the connect method with a hostname work well except that

    97. 

  97.               it could block for a long period (ie: 2 minutes) if DNS do not

    98. 

  98.               respond. Calling the connect method with a numeric IP address will

    99. 

  99.               never block. So you can call DnsLookup to start hostname

    100. 

  100.               resolution in the background, after some time you evenutually

    101. 

  101.               receive the OnDnsLookupDone event. The copy the DnsResult property

    102. 

  102.               to the Addr property and call connect.

    103. 

  103. Oct 30, 1997  V2.12 added a check in DnsLookup to handel numeric IP which do

    104. 

  104.               not require any lookup. The numeric IP is treated immediately

    105. 

  105.               and immediately trigger the DnsLookupDone event.

    106. 

  106.               I modified the code to be compatible with Delphi 1.

    107. 

  107. Oct 31, 1997  V2.13 added CancelDnsLookup procedure.

    108. 

  108. Nov 09, 1997  V2.14 add LocalIPList function to get the list of local IP

    109. 

  109.               addresses (you have two IP addresses when connected to a LAN

    110. 

  110.               and an ISP).

    111. 

  111. Nov 11, 1997  V2.15 Made TCustomWSocket with virtual functions. This will

    112. 

  112.               allow to easily descend a new component from TCustomWSocket.

    113. 

  113.               Make ReadLine stop when the connection is broken.

    114. 

  114. Nov 12, 1997  V2.16 Corrected bug (Justin Yunke <yunke@productivity.org>)

    115. 

  115.               in LocalIPList: phe should be checked for nil.

    116. 

  116. Nov 18, 1997  Added ReceiveStr function (Suggested by FLDKNHA@danisco.com)

    117. 

  117. Nov 30, 1997  V2.18 Added a call to OnDnsLookupDone when canceling.

    118. 

  118. Dec 04, 1997  V2.19 Added LocalPort property and SessionConnected event

    119. 

  119.               for UDP socket.

    120. 

  120.               V2.20 Modified MessageLoop and ProcessMessages to process not

    121. 

  121.               only the socket messages, but all messages (necessary if the

    122. 

  122.               thread has several TWSocket for example).

    123. 

  123. Dec 09, 1997  V2.21 Corrected a minor bug in ReceiveStr. Detected by

    124. 

  124.               david@e.co.za (David Butler).

    125. 

  125. Dec 10, 1997  V2.22 Corrected a minor bug in Send which now correctly

    126. 

  126.               returns the number of bytes sent. Detected by

    127. 

  127.               james.huggins@blockbuster.com

    128. 

  128. Dec 16, 1997  V2.23 Corrected a bug which prevented the receiving of datagram

    129. 

  129.               from a UDP socket.

    130. 

  130.               Thank to Mark Melvin (melvin@misrg.ml.org) for pointing it.

    131. 

  131. Dec 20, 1997  V2.24 Added the PeekData function as suggested by Matt Rose

    132. 

  132.               mcrose@avproinc.com

    133. 

  133. Dec 26, 1997  V2.25 Added the Text property as suggested by Daniel P. Stasinski

    134. 

  134.               <dse@pacific.net>. Made GetXPort work even when listening as

    135. 

  135.               suggested by is81024@cis.nctu.edu.tw.

    136. 

  136. Jan 10, 1998  V2.26 Check for null hostname in DNSLookup

    137. 

  137.               Added DnsResultList with all IP addresses returned form DNS

    138. 

  138. Jan 13, 1998  V2.27 a Added MultiThreaaded property to tell the component that

    139. 

  139.               it is working in a thread and should take care of it (call

    140. 

  140.               internal ProcessMessages in place of Application.ProcessMessages,

    141. 

  141.               and do not use the WaitCtrl object).

    142. 

  142. Jan 15, 1998  V2.28 WMAsyncSelect revisited to work properly with NT winsock 2.

    143. 

  143. Feb 10, 1998  V2.29 Added an OnError event. If not assigned, then the component

    144. 

  144.               raise an exception when the error occurs.

    145. 

  145. Feb 14, 1998  V2.30 Published Text property

    146. 

  146. Feb 16, 1998  V2.31 Added virtual methods to trigger events

    147. 

  147.               Renamed all event handler variable to begin with FOn

    148. 

  148. Feb 26, 1998  V2.32 Added procedure PutDataInSendBuffer and PutStringInSendBuffer

    149. 

  149.               Using PutDataInSendBuffer you can place data in the send buffer

    150. 

  150.               without actualy trying to send it. This allows to place several

    151. 

  151.               (probably small) data chunk before the component attempt to send

    152. 

  152.               it. This prevent small packet to be sent. You can call

    153. 

  153.               Send(nil, 0) to force the component to begin to send data.

    154. 

  154.               If the buffer was not empty, PutDataInSendBuffer will just queue

    155. 

  155.               data to the buffer. This data will be sent in sequence.

    156. 

  156. Mar 02, 1998  V2.33 Changed the error check with WSAstartup as pointed out by

    157. 

  157.               Donald Strenczewilk (dstrenz@servtech.com)

    158. 

  158. Mar 06, 1998  V2.34 Added a runtime property to change the buffer size.

    159. 

  159. Mar 27, 1998  V2.35 Adapted for C++Builder 3

    160. 

  160. Apr 08, 1998  V2.36 Made SetDefaultValue virtual

    161. 

  161. Apr 13, 1998  V2.37 Reset FDnsLookupHandle to 0 after a failed call to

    162. 

  162.               WSACancelAsyncRequest

    163. 

  163. Apr 22, 1998  V2.38 Published AllSent property to let outside know if our

    164. 

  164.               buffer has some data unsent.

    165. 

  165. Apr 28, 1998  V2.39 Added LingerOnOff and LingerTimeout. Default values are

    166. 

  166.               wsLingerOn and timeout = 0 to behave by default as before.

    167. 

  167.               This value is setup just before Connect. Call SetLingerOption to

    168. 

  168.               set the linger option on the fly (the connection must be

    169. 

  169.               established to set the option). See winsock.closesocket on line

    170. 

  170.               help (winsock.hlp or win32.hlp) for a dsicussion of this option

    171. 

  171.               usage.

    172. 

  172. May 06, 1998  V2.40 Added a workaround for Trumpet winsock inet_addr bug.

    173. 

  173.               Thanks to Andrej Cuckov <andrej@cuckov.com> for his code.

    174. 

  174. May 18, 1998  V2.41 Jan Tomasek <xtomasej@feld.cvut.cz> found that Trumpet

    175. 

  175.               Winsock (Win 3.11) has some bugs and suggested a workaround in

    176. 

  176.               TryToSend procedure. This workaround makes TWSocket blocking in

    177. 

  177.               some cases. A new property enables the workaround. See code.

    178. 

  178. Jun 01, 1998  V2.42 In finalization section, check for not assigned IPList.

    179. 

  179. Jun 15, 1998  V2.43 Added code to finalization section to unload winsock if

    180. 

  180.               still loaded at that point (this happend if no socket where

    181. 

  181.               created but WinsockInfo called). Suggested by Daniel Fazekas

    182. 

  182.               <fdsoft@dns.gyor-ph.hu>

    183. 

  183. Jun 27, 1998  V2.44 Added checks for valid arguments in SetPort, SetProto

    184. 

  184.               and SetAddr. Deferred address resolution until Connect or Listen.

    185. 

  185. Jul 08, 1998  V2.45 Adadpted for Delphi 4

    186. 

  186. Jul 20, 1998  V2.46 Added SetWindowLong(FWindowHandle, 0, 0) in the destructor

    187. 

  187.               and a check for TWSocket class in XSocketWindowProc.

    188. 

  188.               Added virtual method RealSend.

    189. 

  189. Jul 23, 1998  V2.47 Added a TriggerSessionClosed from TryToSend in case of

    190. 

  190.               send error. This was called before, but with a nul error argument.

    191. 

  191.               Now it correctly gives the error number.

    192. 

  192.               Added a trashcan to receive data if no OnDataAvailable event

    193. 

  193.               handler is installed. Just receive the data and throw it away.

    194. 

  194.               Added reverse dns lookup asynchronous code (IP -> HostName).

    195. 

  195.               Thanks to Daniel Fazekas <fdsoft@dns.gyor-ph.hu> for his code.

    196. 

  196. Jul 30, 1998  V2.48 Changed local variable "error" by FLastError in SocketError

    197. 

  197.               to make it available from the OnError handler. Thanks to

    198. 

  198.               dana@medical-info.com for finding this bug.

    199. 

  199.               In Abort procedure, deleted all buffered data because it was send

    200. 

  200.               the next time the socket is opened !

    201. 

  201.               Added CancelDnsLookup in Abort procedure.

    202. 

  202. Aug 28, 1998  V2.49 Made InternalClose and ReceiveStr virtual

    203. 

  203. Sep 01, 1998  V2.50 Ignore CancelDnsLookup exception during destroy

    204. 

  204. Sep 29, 1998  V2.51 In InternalClose, protect AssignDefaultValue with

    205. 

  205.               try/except because SessionClosed event handler may have destroyed

    206. 

  206.               the component.

    207. 

  207. Oct 11, 1998  V2.52 Changed Shutdown(2) to Shutdown(1) in Internal Close to

    208. 

  208.               prevent data lost on send. You may have to call Shutdown(2) in

    209. 

  209.               your own code before calling Close to have the same behaviour as

    210. 

  210.               before.

    211. 

  211.               Changed argument type for ASyncReceive and passed 0 from FD_CLOSE

    212. 

  212.               message handler.

    213. 

  213. Oct 28, 1998  V2.53 Made WSocketLoadWinsock and WSocketUnloadWinsock public.

    214. 

  214. Nov 11, 1998  V2.54 Added OnDisplay event for debugging purpose

    215. 

  215. Nov 16, 1998  V2.55 Ignore WSANOTINITIALIZED error calling CloseSocket. This

    216. 

  216.               occurs when using TWSocket from a DLL and the finalization

    217. 

  217.               section is called before destroying TWSocket components (this is

    218. 

  218.               a program logic error).

    219. 

  219.               Made some properties and methods protected instead of private.

    220. 

  220.               Made some methods virtual.

    221. 

  221.               Added an Error argument to InternalClose.

    222. 

  222.               Added DoRecv virtual function.

    223. 

  223.               Added WSocketResolvePort

    224. 

  224.               Added WSocketResolveProto

    225. 

  225.               Deferred port and protocol resolution until really needed

    226. 

  226.               Transformed Listen to procedure (in case of failure Listen

    227. 

  227.               always calls SocketError which triggers an exception or the

    228. 

  228.               OnError event).

    229. 

  229. Nov 22, 1998  V3.00 Skipped from V2.55 to V3.00. Socks support is major update!

    230. 

  230.               Added SOCKS5 (RFC-1928) support for TCP connection and

    231. 

  231.               simple usercode passwword authentication.

    232. 

  232.               Consider the socks code as beta !

    233. 

  233.               New properties: SocksServer, SocksPort, SocksUsercode,

    234. 

  234.               SocksPassword, FSocksAuthentication. New events: OnSocksError,

    235. 

  235.               OnSocksConnected, OnSocksAuthState.

    236. 

  236.               I used WinGate 2.1d to test my code. Unfortunately WinGate do

    237. 

  237.               not correctly handle user authentication, so the code here is

    238. 

  238.               just untested...

    239. 

  239. Dec 05, 1998  V3.10 Removed ReadLine feature using TWait component.

    240. 

  240.               Added new TCustomLineWSocket and TCustomSyncWSocket.

    241. 

  241.               Those modifications implies that the ReadLine functionnality is

    242. 

  242.               slightly changed. Notably, the end of line marker is now

    243. 

  243.               configurable and remains in the received line unless a timeout

    244. 

  244.               occurs or the buffer is too small.

    245. 

  245. Dec 10, 1998  V3.11 Added missing code to resolve port in the Listen method.

    246. 

  246. Dec 12, 1998  V3.12 Added write method for LocalPort property. Thanks to

    247. 

  247.               Jan Tomasek <xtomasej@feld.cvut.cz> for his code.

    248. 

  248.               Added background exception handling.

    249. 

  249.               Fixed a bug in TCustomLineWSocket.TriggerDataAvailable which was

    250. 

  250.               not calling the inherited function when it actually should.

    251. 

  251.               Added a check on multithreaded in WaitForClose to call the

    252. 

  252.               correct ProcessMessages procedure.

    253. 

  253.               Added SOCKS4 support (only tcp connect is supported).

    254. 

  254. Dec 28, 1998  V3.13 Changed WSocketResolveHost to check for invalid numeric

    255. 

  255.               IP addresses whitout trying to use them as hostnames.

    256. 

  256. Dec 30, 1998  V3.14 Changed SetPort to SetRemotePort to solve the SetPort

    257. 

  257.               syndrome with BCB. Also chnaged GetPort to be consistant.

    258. 

  258. Jan 12, 1999  V3.15 Introduced DoRecvFrom virtual function. This correct a bug

    259. 

  259.               introduced in V3.14 related to UDP and RecvFrom.

    260. 

  260. Jan 23, 1999  V3.16 Changed FRcvdFlag computation in DoRecv and DoRecvFrom

    261. 

  261.               because it caused problems with HTTP component and large blocks.

    262. 

  262.               Removed modification by Jan Tomasek in TriggerDataAvailable

    263. 

  263. Jan 30, 1999  V3.17 Added WSocketResolveIp function.

    264. 

  264.               Checked for tcp protocol before setting linger off in abort.

    265. 

  265.               Moved a lot of variables from private to protected sections.

    266. 

  266.               Removed check for Assigned(FOnDataSent) in WMASyncSelect.

    267. 

  267. Feb 03, 1999  V3.18 Removed useless units in the uses clause.

    268. 

  268. Feb 14, 1999  V4.00 Jump to next major version number because lots of

    269. 

  269.               fundamental changes have been done. See below.

    270. 

  270. 

    271. 

  271.               Use runtime dynamic link with winsock. All winsock functions

    272. 

  272.               used by TWSocket are linked at runtime instead of loadtime. This

    273. 

  273.               allows programs to run without winsock installed, provided program

    274. 

  274.               doesn't try to use TWSocket or winsock function without first

    275. 

  275.               checking for winsock installation.

    276. 

  276.               Removed WSocketLoadWinsock and all use to DllStarted because it

    277. 

  277.               is no longer necessary because winsock is automatically loaded

    278. 

  278.               and initialized with the first call to a winsock function.

    279. 

  279. 

    280. 

  280.               Added MessagePump to centralize call to the message pump.

    281. 

  281.               It is a virtual procedure so that you can override it to

    282. 

  282.               cutomize your message pump. Also changed slightly ProcessMessages

    283. 

  283.               to closely match what is done in the forms unit.

    284. 

  284. 

    285. 

  285.               Removed old stuff related to WaitCtrl (was already excluded from

    286. 

  286.               compilation using a conditional directive).

    287. 

  287. 

    288. 

  288.               Added NOFORMS conditional compilation to exclude the Forms unit

    289. 

  289.               from wsocket. This will reduce exe or dll size by 100 to 150KB.

    290. 

  290.               To use this feature, you have to add NOFORMS in your project

    291. 

  291.               options in the "defines" edit box in the "directory/conditional"

    292. 

  292.               tab. Then you must add a message pump to your application and

    293. 

  293.               call it from TWSocket.OnMessagePump event handler. TWSocket really

    294. 

  294.               need a message pump in order to receive messages from winsock.

    295. 

  295.               Depending on how your application is built, you can use either

    296. 

  296.               TWSocket.MessageLoop or TWSocket.ProcessMessages to quickly build

    297. 

  297.               a working message pump. Or you may build your own custom message

    298. 

  298.               pump taylored to your needs. Your message pump must set

    299. 

  299.               TWSocket.Terminated property to TRUE when your application

    300. 

  300.               terminates or you may experience long delays when closing your

    301. 

  301.               application.

    302. 

  302.               You may use NOFORMS setting even if you use the forms unit (GUI

    303. 

  303.               application). Simply call Application.ProcessMessages in the

    304. 

  304.               OnMessagePump event handler.

    305. 

  305.               OnMessagePump event is not visible in the object inspector. You

    306. 

  306.               must assign it at run-time before using the component and after

    307. 

  307.               having created it (in a GUI application you can do that in the

    308. 

  308.               FormCreate event, in a console application, you can do it right

    309. 

  309.               after TWSocket.Create call).

    310. 

  310. Feb 17, 1999  V4.01 Added LineEcho and LineEdit features.

    311. 

  311. Feb 27, 1999  V4.02 Added TCustomLineWSocket.GetRcvdCount to make RcvdCount

    312. 

  312.               property and ReceiveStr work in line mode.

    313. 

  313. Mar 01, 1999  V4.03 Added conditional compile for BCB4. Thanks to James

    314. 

  314.               Legg <jlegg@iname.com>.

    315. 

  315. Mar 14, 1999  V4.04 Corrected a bug: wsocket hangup when there was no

    316. 

  316.               OnDataAvailable handler and line mode was on.

    317. 

  317. Apr 21, 1999  V4.05 Added H+ (long strings) and X+ (extended syntax)

    318. 

  318.               compilation options

    319. 

  319. May 07, 1999  V4.06 Added WSAECONNABORTED to valid error codes in TryToSend.

    320. 

  320. Jul 21, 1999  V4.07 Added GetPeerPort method, PeerPort and PeerAddr propertied

    321. 

  321.               as suggested by J. Punter <JPunter@login-bv.com>.

    322. 

  322. Aug 20, 1999  V4.05 Changed conditional compilation so that default is same

    323. 

  323.               as latest compiler (currently Delphi 4, Bcb 4). Should be ok for

    324. 

  324.               Delphi 5.

    325. 

  325.               Added LocalAddr property as suggested by Rod Pickering

    326. 

  326.               <fuzzylogic123@yahoo.com>. LocalAddr default to '0.0.0.0' and is

    327. 

  327.               intended to be used by a client when connecting to a server, to

    328. 

  328.               select a local interface for multihomed computer. Note that to

    329. 

  329.               select an interface for a server, use Addr property before

    330. 

  330.               listening.

    331. 

  331.               LocalAddr has to be an IP address in dotted form. Valid values are

    332. 

  332.               '0.0.0.0' for any interface, '127.0.0.1' for localhost or any

    333. 

  333.               value returned by LocalIPList.

    334. 

  334.               Replaced loadtime import for ntohs and getpeername by runtime

    335. 

  335.               load.

    336. 

  336.               Revised check for dotted numeric IP address in WSocketResolveHost

    337. 

  337.               to allow correct handling of hostnames beginning by a digit.

    338. 

  338.               Added OnSendData event. Triggered each time data has been sent

    339. 

  339.               to winsock. Do not confuse with OnDataSent which is triggered

    340. 

  340.               when TWSocket internal buffer is emptyed. This event has been

    341. 

  341.               suggested by Paul Gertzen" <pgertzen@livetechnology.com> to

    342. 

  342.               easyly implement progress bar.

    343. 

  343.               Corrected WSocketGetHostByAddr to make it dynamically link to

    344. 

  344.               winsock.

    345. 

  345. Sep 5, 1999   V4.09 Added CloseDelayed method.

    346. 

  346.               Make sure that TriggerSessionClosed is called from WMASyncSelect

    347. 

  347.               and InternalClose, even if there is no OnSessionClosed event

    348. 

  348.               handler assigned. This is required to make derived components

    349. 

  349.               work correctly.

    350. 

  350.               Created message WM_TRIGGER_EXCEPTION to help checking background

    351. 

  351.               exception handling (OnBgException event).

    352. 

  352.               Corrected bug for Delphi 1 and ReallocMem.

    353. 

  353. Oct 02, 1999  V4.10 Added Release method.

    354. 

  354. Oct 16, 1999  V4.11 Corrected a bug in TCustomLineWSocket.DoRecv: need to move

    355. 

  355.               data in front of buffer instead of changing buffer pointer which

    356. 

  356.               will crash the whole thing at free time.

    357. 

  357. Oct 23, 1999  V4.12 Made WSocketIsDottedIP a public function

    358. 

  358. Nov 12, 1999  V4.13 removed 3 calls to TriggerSocksAuthState because it was

    359. 

  359.                     called twice. By A. Burlakov <alex@helexis.com>.

    360. 

  360. Jan 24, 1999  V4.14 Call Receive instead of DoRecv from ReceiveStr to be sure

    361. 

  361.               to set LastError correctly. Thanks to Farkas Balazs

    362. 

  362.               <megasys@www.iridium.hu>

    363. 

  363.               Suppressed FDllName and used winsocket constant directly. I had

    364. 

  364.               troubles with some DLL code and string handling at program

    365. 

  365.               termination.

    366. 

  366. Apr 09, 2000 V4.15 Added error number when resolving proto and port

    367. 

  367. Apr 29, 2000 V4.16 Added WSocketForceLoadWinsock and

    368. 

  368.              WSocketCancelForceLoadWinsock. Thanks to Steve Williams.

    369. 

  369.              Created variable FSelectEvent to store current async event mask.

    370. 

  370.              Added ComponentOptions property with currently only one options

    371. 

  371.              wsoNoReceiveLoop which disable a receive loop in AsyncReceive.

    372. 

  372.              This loop breaking was suggested by Davie <smatters@smatters.com>

    373. 

  373.              to lower resource usage with really fast LAN and large transfers.

    374. 

  374.              By default, this option is disabled so there is no change needed

    375. 

  375.              in current code.

    376. 

  376. May 20, 2000 V4.17 Made TSocket = u_int (same def as in winsock.pas)

    377. 

  377.              Moved bind after setting options.

    378. 

  378.              Thanks to Primoz Gabrijelcic <fab@siol.net>

    379. 

  379. Jul 15, 2000 V4.18 Alon Gingold <gingold@hiker.org.il> changed

    380. 

  380.              TCustomSocksWSocket calls to inherited triggers of

    381. 

  381.              TriggerSessionConnected and TriggerDataAvailable.

    382. 

  382.              Now, it calls the trigger directly. This solves the problem

    383. 

  383.              of descendent classes with overridden triggers, not being

    384. 

  384.              called when a REAL connection was established, and when real

    385. 

  385.              data starts coming in. Special care MUST be taken in such

    386. 

  386.              overridden triggers to ONLY call the inherited trigger AND

    387. 

  387.              IMMEDIATELY EXIT when FSocksState <> socksData to avoid loopback

    388. 

  388. Jul 22, 2000 V4.19 John Goodwin <john@jjgoodwin.com> found a failure in the

    389. 

  389.              logic for DnsLookup. He also implemented a workaround.

    390. 

  390.              See DnsLookup comments for explanation.

    391. 

  391. Aug 09, 2000 V4.20 Alon Gingold <gingold2@mrm-multicat.com> found a bug in

    392. 

  392.              SOCKS4 implementation where a nul byte was incorrectly added

    393. 

  393.              (it should be added only with SOCKS4A version, not straith

    394. 

  394.              SOCKS4).

    395. 

  395. Sep 17, 2000 V4.21 Eugene Mayevski <Mayevski@eldos.org> added TWndMethod for

    396. 

  396.              NOFORMS applications in other components.

    397. 

  397. Oct 15, 2000 V4.22 Added method GetXAddr which returns local IP address to

    398. 

  398.              which a socket has been bound. There was already a GetXPort.

    399. 

  399.              Thanks to Wilfried Mestdagh <wilfried_sonal@compuserve.com>

    400. 

  400.              and Steve Williams <stevewilliams@kromestudios.com>.

    401. 

  401. Nov 08, 2000 V4.23 Moved FSelectEvent from private to protected section.

    402. 

  402. Nov 11, 2000 V4.24 Added LineLimit property and OnLineLimitExceeded event.

    403. 

  403.              When using line mode, line length is checked as each data block is

    404. 

  404.              comming. If the length is greater than the limit, then the event

    405. 

  405.              is triggered. You have the opportunity to close the socket or

    406. 

  406.              change the limit to a higher value. Thus you can prevent a hacker

    407. 

  407.              from locking your system by sending unlimited line which otherwise

    408. 

  408.              would eat up all system resources.

    409. 

  409.              Changed line handling variables to LongInt

    410. 

  410.              Checked all length involved in StrPCopy calls.

    411. 

  411. Nov 26, 2000 V4.25 Do not trust GetRcvdCount. Always call Receive to check for

    412. 

  412.              incomming data (sometime NT4 will hang if we don't do that).

    413. 

  413. Jan 24, 2001 V4.26 Blaine R Southam <bsoutham@iname.com> fixed out of bound

    414. 

  414.              error in TCustomLineWSocket.TriggerDataAvailable

    415. 

  415. Feb 17, 2001 V4.27 Davie <smatters@smatters.com> fixed a bug causing byte lost

    416. 

  416.              when closing (related to wsoNoReceiveLoop option).

    417. 

  417. May 04, 2001 V4.28 Fixed W2K bug (winsock message ordering)

    418. 

  418. Jun 18, 2001 V4.29 Added AllocateHWnd and DeallocateHWnd from Forms unit to

    419. 

  419.              avoid warning from Delphi 6 in all other components.

    420. 

  420. Jul 08, 2001 V4.30 Fixed small bug related to NOFOMRS and V4.29

    421. 

  421. Jul 26, 2001 V4.31 Checked csDesigning in GetRcvdCount so that Delphi 6 does'nt

    422. 

  422.              crash when object inspector wants to display RcvdCount value.

    423. 

  423.              Added multicast capability and UDP ReuseAddr. Thanks to Mark

    424. 

  424.              G. Lewis <Lewis@erg.sri.com> for his code.

    425. 

  425.              Added TriggerSessionClosed to SocketError as suggested by Wilfried

    426. 

  426.              Mestdagh <wilfried_sonal@compuserve.com>

    427. 

  427. Jul 28, 2001 V4.32 New option wsoTcpNoDelay implemented. Code by Arnaldo Braun

    428. 

  428.              <abraun@th.com.br>

    429. 

  429. Jul 30, 2001 V4.33 Corrected at few glitches with Delphi 1

    430. 

  430. Sep 08, 2001 V4.34 Added ThreadAttach and related functions

    431. 

  431. Nov 27, 2001 V4.35 Added type definition for in_addr and Delphi 2 (Yes there are

    432. 

  432.              still some peoples who wants to use it. Don't ask me why !).

    433. 

  433. Dec 02, 2001 V4.36 david.brock2@btinternet.com found a bug in SOCKS4 where

    434. 

  434.              error check incorrectly checked "FRcvBuf[1] = #$90" instead of

    435. 

  435.              "FRcvBuf[1] <> #90". He also found a bug when receiving domain name

    436. 

  436.              where length of name was incorrectly copyed to the buffer.

    437. 

  437. Dec 23, 2001 V4.37 Removed bWrite, nMoreCnt, bMoreFlag and nMoreMax which where

    438. 

  438.              not more really used. Thanks to Al Kirk <akirk@pacific.net> for

    439. 

  439.              showing that.

    440. 

  440. Feb 24, 2002 V4.38 Wilfried Mestdagh <wilfried@mestdagh.biz> added ThreadDetach

    441. 

  441.              and a property editor for LineEnd. XSocketDeallocateHWnd made a

    442. 

  442.              function.

    443. 

  443.              I created a new unit WSocketE.pas to put Wilfried's property

    444. 

  444.              editor so that it works correctly with Delphi 6.

    445. 

  445. Apr 24, 2002 V4.39 Removed OnLineTooLong event which was not used anywhere.

    446. 

  446.              Use OnLineLimitExceeded event if you used this event.

    447. 

  447.              Thanks to Alex Kook <cookis@mail.ru> for finding this one.

    448. 

  448. Apr 27, 2002 V4.40 Added procedure WSocketUnregisterClass to be able to

    449. 

  449.              unregister hidden window. This is necessary when TWSocket is

    450. 

  450.              used within a DLL which is unloaded and reloaded by applications,

    451. 

  451.              specially when running with Windows-XP. Thanks to Jean-Michel Aliu

    452. 

  452.              <jmaliu@jmasoftware.com> who provided a test case.

    453. 

  453. Jun 02, 2002 V4.41 allow SOCK_RAW in Connect method for any protocol which is

    454. 

  454.              not TCP or UDP. Thanks to Holger Lembke <holger@hlembke.de>.

    455. 

  455. Jun 04, 2002 V4.42 Do not call Listen for SOCK_RAW.

    456. 

  456.              Thanks to Holger Lembke <holger@hlembke.de>.

    457. 

  457. Jun 08, 2002 V4.43 Add a dummy Register procedure for BCB1.

    458. 

  458.              Thanks to Marc-Alexander Prowe <listen@mohajer.de>.

    459. 

  459. Jul 07, 2002 V4.44 Added code in Connect method to check if socket still opened

    460. 

  460.              after OnChangeState event. If not, trigger an error WSAINVAL.

    461. 

  461. Sep 16, 2002 V4.45 Exposed RcvdPtr and RcvdCnt readonly properties.

    462. 

  462. Sep 17, 2002 V4.46 Used InterlockedIncrement/InterlockedDecrement to Inc/Dec

    463. 

  463.              socket count safely when TWSocket is used within a thread. This

    464. 

  464.              was proposed by Matthew Meadows <matthew.meadows@inquisite.com>

    465. 

  465. Sep 28, 2002 V4.47 Changed DnsLookup so that a hostname is checked for dotted

    466. 

  466.              IP addresse and resolve it numerically. Thanks to Bogdan Calin

    467. 

  467.              <soul4blade@yahoo.com> who found this bug. Alos loaded the result

    468. 

  468.              list with the address to be consistant with real lookup result.

    469. 

  469. Nov 17, 2002 V4.48 Roland Klabunde <roland.klabunde@gmx.net> found a bug in

    470. 

  470.              multicast code: listening on a specific interface was ignored.

    471. 

  471.              He fixed Listen and Connect.

    472. 

  472. Nov 27, 2002 V4.49 Added ListenBacklog property, default to 5.

    473. 

  473. Dec 17, 2002 V4.50 Moved code to virtual function to permit SSL implementation.

    474. 

  474. Jan 19, 2003 V5.00 First pre-release for ICS-SSL. New major version number

    475. 

  475.              V5.01 Gabi Slonto <buffne01@gmx.net> found a bug in DnsLookup

    476. 

  476.              when hostname was actulally a dotted IP address.

    477. 

  477. Mar 18, 2003 V5.02 Fixed WSocketIsDottedIP: reordering of boolean expressions

    478. 

  478.              involaving a string. Thanks to Ian Baker <ibaker@codecutters.org>

    479. 

  479. Apr 30, 2003 V5.03 Replaced all calls to setsockopt by calls to

    480. 

  480.              WSocket_setsockopt to avoid statically linked winsock DLL.

    481. 

  481.              Thanks to Piotr Dalek <enigmatical@interia.pl>.

    482. 

  482.              Also replaced inet_addr by WSocket_inet_addr.

    483. 

  483. Aug 27, 2003 V5.04 Marco van de Voort <marcov@stack.nl> added FreePascal (FPC)

    484. 

  484.              conditional compilation. Please contact him for any FPC support

    485. 

  485.              question.

    486. 

  486. Aug 28, 2003 V5.05 Fixed a multithreading issue related to windows class

    487. 

  487.              registration. Now using a critical section around the code.

    488. 

  488.              Thanks to Bogdan Ureche <bureche@omnivex.com> for his precious help.

    489. 

  489. Aug 31, 2003 V5.06 Added warning about deprecated procedures Synchronize,

    490. 

  490.              WaitUntilReady and ReadLine. Do not use them in new applications.

    491. 

  491. Sep 03, 2003 V5.07 Bogdan Ureche <bureche@omnivex.com> added a critical section

    492. 

  492.              to avoid problem when winsock.dll is unloaded by a thread while

    493. 

  493.              another thread is still using some TWSocket.

    494. 

  494. Sep 15, 2003 V5.08 Fixed finalization section to no free critical section if

    495. 

  495.              a TWSocket is still existing. This happend for example when a

    496. 

  496.              TWSocket is on a form and Halt is called from FormCreate event.

    497. 

  497.              Changed SendStr argument to const.

    498. 

  498. Nov 09, 2003 V5.09 Added manifest constants for Shutdown

    499. 

  499.              Added TCustomLineWSocket.SendLine method.

    500. 

  500. Jan 16, 2004 V5.10 Added "const" in front of all method using strings.

    501. 

  501. Jan 17, 2004 V5.11 Modified TriggerDataAvailable so that when in LineMode, we

    502. 

  502.              check if a line is still in the buffer of already received data.

    503. 

  503.              Also updated WMTriggerDataAvailable to avoid infinite loops.

    504. 

  504.              Introduced FLineFound to flag when a line has been found.

    505. 

  505.              See "OLD_20040117" to find this code.

    506. 

  506. Jan 21, 2004 V5.12 Checked null string in PutStringInSendBuffer and null

    507. 

  507.              pointer in PutDataInSendBuffer.

    508. 

  508. Jan 26, 2004 V5.13 Conditional compilation for BCB for constants for Shutdown.

    509. 

  509.              Reordered uses clause for FPC compatibility.

    510. 

  510.              Fixed TCustomLineWSocket.TriggerDataAvailable to deliver data

    511. 

  511.              already received while in line mode but after component user

    512. 

  512.              turned line mode off in the middle of the way. This could occur

    513. 

  513.              for example in a HTTP application where line mode is used to

    514. 

  514.              receive HTTP header line and turned off when last header line is

    515. 

  515.              found. At that point, if posted data (HTTP document) was completely

    516. 

  516.              in the same packet as the last header line, that data was not

    517. 

  517.              delivered until the next packet comes, which could never occur !

    518. 

  518. Mar 20, 2004 V5.14 Added partial support for RAW socket.

    519. 

  519.              To use RAW sockets, set Proto to 'raw_ip', 'raw_icmp', ...

    520. 

  520.              Set Port to '0' or whatever value is useful for the protocol.

    521. 

  521.              When using IP protocol, you can add option wsoSIO_RCVALL so that

    522. 

  522.              your program receive ALL datagrams when you listen on a given

    523. 

  523.              interface (You can't use 0.0.0.0).

    524. 

  524.              Do not use Connect with RAW socket. Always use Listen and then

    525. 

  525.              use SendTo to send datagrams use the socket.

    526. 

  526.              Added ReqVerHigh and ReqVerLow properties to be able to select

    527. 

  527.              which winsock version you want to load. Default to 1.1 but need

    528. 

  528.              2.2 for RAW sockets to be used.

    529. 

  529. Mar 24, 2004 V5.15 Changed WSocket_Synchronized_ResolveProto to hard code

    530. 

  530.              protocol number for tcp, udp and raw.

    531. 

  531. Apr 17, 2004 V6.00 New major release started. Move all platform and runtime

    532. 

  532.              dependencies to separate units. New base component for handling

    533. 

  533.              component with window handle.

    534. 

  534. Jun 20, 2004 V 5.16 John Mulvey <john@mulvey.eurobell.co.uk> fixed error message

    535. 

  535.              in GetPeerAddr which incorrectly reported an error about

    536. 

  536.              GetPeerName.

    537. 

  537. May 23, 2005 V5.17 PutDataInSendBuffer set bAllSent to false.

    538. 

  538. Jun 03, 2005 V5.18 Added SocketSndBufSize property which gives the size of

    539. 

  539.              winsock internal send buffer. When using TCP, you must make sure

    540. 

  540.              you never use a BufSize equal or greater than this value or

    541. 

  541.              you'll experience bad performances. See description in MSDN

    542. 

  542.              http://support.microsoft.com/default.aspx?scid=kb;en-us;823764

    543. 

  543.              Default value for BufSize is 1460 and SocketSndBufSize is 8192 so

    544. 

  544.              there is no problem when not changing those values.

    545. 

  545. Jun 18, 2005 V5.19 Made TCustomSocksWSocket.Connect accept 'tcp' as well as '6'

    546. 

  546.              for protocol. By Piotr "Hellrayzer" Dalek.

    547. 

  547.              Renamed event OnDisplay to OnDebugDisplay.

    548. 

  548. Sept 4, 2005 V5.20 added BufferedByteCount property used to ensure winsock has sent

    549. 

  549.              data, currently used in TFtpCli to check a put has finished correctly

    550. 

  550.              Thanks to Tobias Giesen <tobias@tgtools.de> for the fix

    551. 

  551. Dec 27, 2005 V6.00a Updated new release with change done in the old release.

    552. 

  552. Dec 31, 2005 V6.00b added new debug and logging event and log levels, replacing

    553. 

  553.              conditional debug code with optional code to avoid rebuilding apps.

    554. 

  554.              Works in combination with new component TIcsLogger.

    555. 

  555.              This is controlled by the new LogOptions property:

    556. 

  556.                loDestEvent - write to OnIcsLogEvent (called from higher level protocols)

    557. 

  557.                loDestFile - write to file debug_out.myprog.txt

    558. 

  558.                loDestOutDebug - write to OutputDebugString (shown in Debugger Event Log window)

    559. 

  559.                loAddStamp - time stamp each log line (accurate only to about 18ms)

    560. 

  560.                loWsockErr - log wsocket errors

    561. 

  561.                loWsockInfo - log wsocket general information

    562. 

  562.                loWsockDump - log wsocket data (not implemented yet)

    563. 

  563.                loSslErr - log SSL errors

    564. 

  564.                loSslInfo - log SSL general information

    565. 

  565.                loSslDump - log SSL packets and data

    566. 

  566.                loProtSpecErr - log protocol specific error

    567. 

  567.                loProtSpecInfo - log protocol specific general information

    568. 

  568.                loProtSpecDump - log protocol specific data and packets

    569. 

  569. Jan 22, 2006 V6.00c Added some KeepAlive stuff (seems winsock is bugged and

    570. 

  570.              doesn't care any setting done !).

    571. 

  571. Jan 28, 2006 V6.00d Gerhard Rattinger fixed SetKeepAliveOption for Delphi 3

    572. 

  572. Mar 09, 2006 V6.00e Arno made properties to select keepalive parameters.

    573. 

  573.              He also fixed ReverseDnsLookup to return a list of

    574. 

  574.              host names (aliases) instead of just the first entry. Added func.

    575. 

  575.              ReverseDnsLookupSync.

    576. 

  576. Apr 27, 2006 V6.00f Roger Tinembart <tinembart@brain.ch> added a critical section

    577. 

  577.              around the list of sendbuffers (FBufHandler) to avoid problems when

    578. 

  578.              the data is placed in the sendbuffer (for example with SendStr)

    579. 

  579.              by a different thread than the one that is effectively sending the

    580. 

  580.              data with TryToSend

    581. 

  581. June 11, 2006 V6.01 Use new TIcsBufferHandler.

    582. 

  582. Aug 06, 2006 V6.02 Angus added GetWinsockErr to give alpha and numeric winsock

    583. 

  583.              errors and improved many other error messages,

    584. 

  584.              and fixed FReadCount for 64-bit downloads

    585. 

  585.              added some EXTERNALSYM for BCB compatiblity

    586. 

  586. Aug 18, 2006 V6.03 Fixed a bug in ASyncReceive(). This bug caused data loss.

    587. 

  587. Oct 28, 2006 V6.04 Added setter for SocketSndBufSize and SocketRcvBufSize

    588. 

  588. Dec 22, 2006 V6.05 Oliver Grahl fixed SendLine to properly count LineEnd characters.

    589. 

  589. Jan 18, 2007 V6.06 Fixed constructor and DeleteBufferedData to behave correctly

    590. 

  590.              when an exception occur in AllocateSocketHWnd.

    591. 

  591. Mar 23, 2007 V6.07 Removed FD_CONNECT from dup().

    592. 

  592. Apr 04, 2007 V6.08 Arno Garrels updated SetKeepAliveOption

    593. 

  593. Mar 10, 2008 V6.09 Francois Piette & Arno Garrels made some changes to

    594. 

  594.                    prepare code for Unicode

    595. 

  595.                    WSocket_gethostname conversion from String to AnsiString

    596. 

  596.                    WSocketGetProc and WSocket2GetProc use AnsiString

    597. 

  597.                    GetAliasList simplified and use AnsiString

    598. 

  598. Apr 25, 2008 V6.10 A. Garrels, added some getters/setters to store and use some

    599. 

  599.              string-property-values as AnsiString internally.

    600. 

  600.              This reduced number of string casts with potential data loss to 17.

    601. 

  601.              These ansi-values are used to call winsock API that doesn't provide

    602. 

  602.              W functions. Modified depending code including some type changes

    603. 

  603.              from PChar to PAnsiChar. Made some casts Unicode => Ansi with

    604. 

  604.              potential data loss *explicit* casts (conditionally compiled) some

    605. 

  605.              unicode strings with only 7 bit ASCII characters are casted using

    606. 

  606.              new function UnicodeToAscii() in new unit OverbyteIcsUtils which

    607. 

  607.              should be fast and reliable and doesn't produce compiler warnings.

    608. 

  608.              Added new warning symbols.

    609. 

  609. Apr 30, 2008 V6.11 A. Garrels - Function names adjusted according to changes in

    610. 

  610.              OverbyteIcsLibrary.pas.

    611. 

  611. May 11, 2008 V6.12 USchuster removed local atoi implementation (atoi is now in

    612. 

  612.              OverbyteIcsUtils.pas)

    613. 

  613. May 15, 2008 V6.13 AGarrels type change of some published String properties

    614. 

  614.              to AnsiString, this is an attempt to avoid too many implicit

    615. 

  615.              string casts, only a few higher level components have been adjusted

    616. 

  616.              accordingly so far.

    617. 

  617. Jun 30, 2008 A.Garrels made some changes to prepare SSL code for Unicode.

    618. 

  618. Jul 04, 2008 V6.11 Rev.58 SSL - Still lacked a few changes I made last year.

    619. 

  619. Jul 13, 2008 V6.12 Added SafeWSocketGCount

    620. 

  620. Aug 03, 2008 V6.16 A. Garrels removed packed from record TExtension.

    621. 

  621. Jul 07, 2008 V6.17 Still a small fix from December 2007 missing in SSL code.

    622. 

  622. Aug 11, 2008 V6.18 A. Garrels - Type AnsiString rolled back to String.

    623. 

  623.              Two bugs fixed in SSL code introduced with Unicode change.

    624. 

  624.              Socks was not fully prepared for Unicode.

    625. 

  625. Sep 19, 2008 V6.19 A. Garrels changed some AnsiString types to RawByteString.

    626. 

  626. Sep 21, 2008 V6.20 A. Garrels removed BoolToStr(), available since D7

    627. 

  627. Oct 22, 2008 V7.21 A. Garrels removed the const modifier from parameter Data

    628. 

  628.              in function SendTo to fix a bug in C++ Builder.

    629. 

  629. Nov 03, 2008 V7.22 Added property Counter, a class reference to TWSocketCounter

    630. 

  630.              which provides some useful automatic counters. By default property

    631. 

  631.              Counter is unassigned and has to be enabled by a call to

    632. 

  632.              CreateCounter.

    633. 

  633. Apr 24, 2009 V7.23 A. Garrels added *experimental* OpenSSL engine support which

    634. 

  634.              is not compiled in by default. You have to uncomment conditional

    635. 

  635.              define OPENSSL_NO_ENGINE in OverbyteIcsSslDefs.inc and rebuild your

    636. 

  636.              packages to get it included. With engine support included a new

    637. 

  637.              published property AutoEnableBuiltinEngines of TSslContext has to

    638. 

  638.              be set to TRUE in order to enable OpenSSL's built-in hardware

    639. 

  639.              accelerators support, that's all.

    640. 

  640. 

    641. 

  641.              ******************************************************************

    642. 

  642.              * Due to the lack of hardware this feature is completely untested*

    643. 

  643.              ******************************************************************

    644. 

  644. 

    645. 

  645.              Any feedback and fixes are welcome, please contact the ICS mailing

    646. 

  646.              list. The OpenSSL engine documentation can be found here:

    647. 

  647.              http://openssl.org/docs/crypto/engine.html

    648. 

  648. 

    649. 

  649.              Additionally a new component TSslEngine is installed on the palette.

    650. 

  650.              Its purpose is to control (dynamic) engines.

    651. 

  651. 

    652. 

  652.              Typically control commands of an OpenSC dynamic pkcs11 engine

    653. 

  653.              (SmartCard) are :

    654. 

  654. 

    655. 

  655.              Cmds.Add('SO_PATH=d:\opensc\bin\engine_pkcs11.dll');

    656. 

  656.              Cmds.Add('ID=pkcs11');

    657. 

  657.              Cmds.Add('LIST_ADD=1');

    658. 

  658.              Cmds.Add('LOAD=');

    659. 

  659.              Cmds.Add('MODULE_PATH=d:\opensc\bin\opensc-pkcs11.dll');

    660. 

  660.              Cmds.Add('INIT='); <= Special ICS-control command to initialize the engine  

    661. 

  661. 

    662. 

  662.              Sample test code (Dod couldn't get it working :(

    663. 

  663. 

    664. 

  664.              It assumes that the X509 certificate has been exported from

    665. 

  665.              the SmartCard to PEM file that is available in property

    666. 

  666.              SslCertFile. It's also assumed that SslEngine1 is created

    667. 

  667.              dynamically at run-time in this sample.

    668. 

  668.              We are in new event TSslContext.OnBeforeInit:

    669. 

  669. 

    670. 

  670.              if not Assigned(SslEngine1) then

    671. 

  671.              begin

    672. 

  672.                 SslEngine1 := TSslEngine.Create(Self);

    673. 

  673.                 try

    674. 

  674.                   SslEngine1.NameID := 'dynamic';

    675. 

  675. 

    676. 

  676.                   // The SmartCard holds the private key.

    677. 

  677.                   // Next two lines advise SslContext to load the key

    678. 

  678.                   // from the engine instead from PEM file.

    679. 

  679.                   TSslContext(Sender).CtxEngine := SslEngine1;

    680. 

  680.                   SslEngine1.CtxCapabilities := [eccLoadPrivKey];

    681. 

  681. 

    682. 

  682.                   // The PIN code is expected in property SslPassPhrase

    683. 

  683.                   TSslContext(Sender).SslPassPhrase := 'ics';

    684. 

  684. 

    685. 

  685.                   // Tell the engine which key to use.

    686. 

  686.                   SslEngine1.KeyID := KeyIdEdit.Text;

    687. 

  687. 

    688. 

  688.                   // At first open the engine

    689. 

  689.                   if not SslEngine1.Open then

    690. 

  690.                       raise Exception.Create(FEngine.LastErrorMsg);

    691. 

  691. 

    692. 

  692.                   // Now send our vendor specific control commands

    693. 

  693.                   for I := 0 to Cmds.Count -1 do

    694. 

  694.                   begin

    695. 

  695.                     if not SslEngine1.Control(Cmds.Names[I],

    696. 

  696.                                               Cmds.ValueFromIndex[I]) then

    697. 

  697.                         raise Exception.Create(SslEngine1.LastErrorMsg);

    698. 

  698.                   end;

    699. 

  699. 

    700. 

  700.                   Display('Engine set up and loaded successfully');

    701. 

  701.                 except

    702. 

  702.                     FreeAndNil(SslEngine1);

    703. 

  703.                     raise;

    704. 

  704.                 end;

    705. 

  705.              end;

    706. 

  706. 

    707. 

  707. Jun 12, 2009 V7.24 Angus added WriteCount property, how many bytes sent since

    708. 

  708.                      connection opened

    709. 

  709.                    Only reset ReadCount when connection opened, not closed

    710. 

  710. Jul 16, 2009 V7.25 Arno fixed and changed SetCounterClass()

    711. 

  711. Jul 19, 2009 V7.26 Arno - SSL code ignored FPaused flag, the change is in

    712. 

  712.                    TCustomSslWSocket.TriggerEvent.

    713. 

  713. Sep 04, 2009 V7.27 Set option TCP_NODELAY in Dup as well as provide a public

    714. 

  714.                    method to set this option, similar as suggested by

    715. 

  715.                    Samuel Soldat.

    716. 

  716. Sep 08, 2009 V7.28 Arno - Minor Unicode bugfix in TX509Base.GetExtension().

    717. 

  717. Sep 09, 2009 V7.29 Arno - Added new public methods TX509Base.WriteToBio() and

    718. 

  718.                    TX509Base.ReadFromBio(). Method SafeToPemFile got an arg.

    719. 

  719.                    that adds human readable certificate text to the output.

    720. 

  720.                    InitializeSsl inlined. Removed a Delphi 1 conditional.

    721. 

  721. Sep 17, 2009 V7.30 Anton Sviridov optimized setting of SSL options.

    722. 

  722. Sep 17, 2009 V7.31 Arno fixed a Unicode bug in TX509Base.GetExtension and

    723. 

  723.                    a general bug in TX509Base.GetSha1Hash (AnsiString as

    724. 

  724.                    digest buffer should really be avoided)

    725. 

  725. Sep 18, 2009 V7.32 Arno changed visibility of TX509Base.WriteToBio() and

    726. 

  726.                    TX509Base.ReadFromBio() to protected.

    727. 

  727. Nov 01, 2009 V7.33 Arno fixed a memory overwrite bug in

    728. 

  728.                    TCustomSocksWSocket.DoRecv().

    729. 

  729. Nov 07, 2009 V7.34 OpenSSL V0.9.8L disables session renegotiation due to

    730. 

  730.                    TLS renegotiation vulnerability.

    731. 

  731. Dec 20, 2009 V7.35 Arno added support for SSL Server Name Indication (SNI).

    732. 

  732.                    SNI has to be turned on in OverbyteIcsSslDefs.inc, see define

    733. 

  733.                    "OPENSSL_NO_TLSEXT". Exchanged symbol "NO_ADV_MT" in the

    734. 

  734.                    SSL source by "NO_SSL_MT" (This and SNI was sponsored by

    735. 

  735.                    Fastream Technologies).

    736. 

  736.                    SNI Howto: In SSL server mode assign event OnSslServerName,

    737. 

  737.                    it triggers whenever a client sent a server name in the TLS

    738. 

  738.                    client helo. From the event handler read public property

    739. 

  739.                    SslServerName, lookup and pass a matching, valid and

    740. 

  740.                    initialized SslContext instance associated with the server name.

    741. 

  741.                    In SSL client mode, if property SslServerName was not empty

    742. 

  742.                    this server name is sent to the server in the TLS client helo.

    743. 

  743.                    Currently IE 7 and FireFox >= V2 support SNI, note that both

    744. 

  744.                    browers don't send both "localhost" and IP addresses as

    745. 

  745.                    server names, this is specified in RFC.

    746. 

  746. Dec 24, 2009 V7.36 SSL SNI - Do not switch context if not initialized.

    747. 

  747. Dec 26, 2009 V7.37 Arno fixed TCustomSyncWSocket.ReadLine for Unicode. It

    748. 

  748.                    now takes an AnsiString buffer. Since this method is highly

    749. 

  749.                    deprecated it's also marked as "deprecated". Do not use it

    750. 

  750.                    in new applications.

    751. 

  751. May 08, 2010 V7.38 Arno Garrels added support for OpenSSL 0.9.8n. Read comments

    752. 

  752.                    in OverbyteIcsLIBEAY.pas for details.

    753. 

  753. May 16, 2010 V7.39 Arno Garrels reenabled check for nil in WMAsyncGetHostByName.

    754. 

  754. Jun 10, 2010 V7.40 Arno Garrels added experimental timeout and throttle feature

    755. 

  755.                    to TWSocket. Currently both features have to be enabled

    756. 

  756.                    explicitly with conditional defines BUILTIN_TIMEOUT

    757. 

  757.                    and/or BUILTIN_THROTTLE (see OverbyteIcsDefs.inc )

    758. 

  758. Aug 02, 2010 V7.41 Arno removed an option to send plain UTF-16 strings with

    759. 

  759.                    SendStr() and SendLine() by passing 1200 (CP_UTF16) in the

    760. 

  760.                    codepage parameter. Changed SendLine() to return correct

    761. 

  761.                    number of bytes written.

    762. 

  762. Aug 08, 2010 V7.42 FPiette prevented socket close in TCustomWSocket.Destroy when

    763. 

  763.                    socket state is wsInvalidState (this happend when an

    764. 

  764.                    exception is raise early in the constructor).

    765. 

  765. Sep 05, 2010 V7.43 Arno fixed a bug in the experimental throttle and timeout

    766. 

  766.                    source which made it impossible to use both features at the

    767. 

  767.                    same time. Renamed conditionals EXPERIMENTAL_THROTTLE and

    768. 

  768.                    EXPERIMENTAL_TIMEOUT to BUILTIN_THROTTLE and BUILTIN_TIMEOUT.

    769. 

  769.                    It's now possible to either enable them in OverbyteIcsDefs.inc

    770. 

  770.                    or define them in project options.

    771. 

  771. Sep 08, 2010 V7.44 Arno reworked the experimental timeout and throttle code.

    772. 

  772.                    Method names of TCustomTimeoutWSocket **changed**, they all

    773. 

  773.                    got prefix "Timeout". Removed the crappy TCustomTimerWSocket

    774. 

  774.                    class, both throttle and timeout use their own TIcsThreadTimer

    775. 

  775.                    instance now.

    776. 

  776. Sep 08, 2010 V7.45 Fixed a typo in experimental throttle code.

    777. 

  777. Sep 11, 2010 V7.46 Arno added two more SSL debug log entries and a call to

    778. 

  778.                    RaiseLastOpenSslError in TCustomSslWSocket.InitSSLConnection.

    779. 

  779.                    Added function OpenSslErrMsg.

    780. 

  780. Sep 23, 2010 V7.47 Arno fixed a bug in the experimental throttle code and made

    781. 

  781.                    it more accurate. Thanks to Angus for testing and reporting.

    782. 

  782.                    Method Resume with SSL enabled did not always work.

    783. 

  783.                    

    784. 

  784. }

    785. 

  785. 

    786. 

  786. {

    787. 

  787. About multithreading and event-driven:

    788. 

  788.     TWSocket is a pure asynchronous component. It is non-blocking and

    789. 

  789.     event-driven. It means that when you request an operation such as connect,

    790. 

  790.     the component start the operation your requested and give control back

    791. 

  791.     immediately while performing the operation in the background automatically.

    792. 

  792.     When the operation is done, an event is triggered (such as

    793. 

  793.     OnSessionConnected if you called Connect).

    794. 

  794. 

    795. 

  795.     This asynchronous non-blocking behaviour is very high performance but a

    796. 

  796.     little bit difficult to start with. For example, you can't call Connect and

    797. 

  797.     immediately call SendStr the line below. If you try, you'll have an

    798. 

  798.     exception triggered saying you are not connected. Calling connect will start

    799. 

  799.     connection process but will return long before connection is established.

    800. 

  800.     Calling SendStr at the next line will not work because the socket is not

    801. 

  801.     connected yet. To make it works the right way, you have to put your SendStr

    802. 

  802.     in the OnSessionConnected event.

    803. 

  803. 

    804. 

  804.     The asynchronous operation allows you to do several TCP/IP I/O

    805. 

  805.     simultaneously. Just use as many component as you need. Each one will

    806. 

  806.     operate independently of the other without blocking each other ! So you

    807. 

  807.     basically don't need multi-threading with TWSocket, unless YOUR processing

    808. 

  808.     is lengthy and blocking.

    809. 

  809. 

    810. 

  810.     If you have to use multithreading, you have two possibilities:

    811. 

  811.     1) Create your TWSocket from your thread's Execute method

    812. 

  812.     2) Attach a TWSocket to a given thread using ThreadAttach.

    813. 

  813.     In both cases, you must set MultiThreaded property to TRUE.

    814. 

  814.     If you don't use one of those methods, you'll end up with a false

    815. 

  815.     multithreaded program: all events will be processed by the main tread !

    816. 

  816.     For both methods to work, you MUST have a message loop withing your thread.

    817. 

  817.     Delphi create a message loop automatically for the main thread (it's in

    818. 

  818.     the Forms unit), but does NOT create one in a thread ! For your convenience,

    819. 

  819.     TWSocket has his own MessageLoop procedure. You can use it from your thread.

    820. 

  820. 

    821. 

  821.     Sample program MtSrv uses first method while ThrdSrv uses second method.

    822. 

  822.     Sample program TcpSrv is much the same as ThrdSrv but doesn't use any

    823. 

  823.     thread. You'll see that it is able to server a lot of simultaneous clients

    824. 

  824.     as well and it is much simpler.

    825. 

  825. 

    826. 

  826. 

    827. 

  827.  * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    828. 

  828. unit OverbyteIcsWSocket;

    829. 

  829. 

    830. 

  830. {$B-}           { Enable partial boolean evaluation   }

    831. 

  831. {$T-}           { Untyped pointers                    }

    832. 

  832. {$X+}           { Enable extended syntax              }

    833. 

  833. {$H+}           { Use long strings                    }

    834. 

  834. {$J+}           { Allow typed constant to be modified }

    835. 

  835. {$ALIGN 8}

    836. 

  836. {$I OverbyteIcsDefs.inc}

    837. 

  837. {$IFDEF USE_SSL}

    838. 

  838.     {$I OverbyteIcsSslDefs.inc}

    839. 

  839. {$ENDIF}

    840. 

  840. {$IFDEF COMPILER14_UP}

    841. 

  841.   {$IFDEF NO_EXTENDED_RTTI}

    842. 

  842.     {$RTTI EXPLICIT METHODS([]) FIELDS([]) PROPERTIES([])}

    843. 

  843.   {$ENDIF}

    844. 

  844. {$ENDIF}

    845. 

  845. {$IFDEF COMPILER12_UP}

    846. 

  846.     { These are usefull for debugging !}

    847. 

  847.     {$WARN IMPLICIT_STRING_CAST       ON}

    848. 

  848.     {$WARN IMPLICIT_STRING_CAST_LOSS  ON}

    849. 

  849.     {$WARN EXPLICIT_STRING_CAST       OFF}

    850. 

  850.     {$WARN EXPLICIT_STRING_CAST_LOSS  OFF}

    851. 

  851. {$ENDIF}

    852. 

  852. {$IFDEF DELPHI6_UP}

    853. 

  853.     {$WARN SYMBOL_PLATFORM   OFF}

    854. 

  854.     {$WARN SYMBOL_LIBRARY    OFF}

    855. 

  855.     {$WARN SYMBOL_DEPRECATED OFF}

    856. 

  856. {$ENDIF}

    857. 

  857. {$IFDEF BCB3_UP}

    858. 

  858.     {$ObjExportAll On}

    859. 

  859. {$ENDIF}

    860. 

  860. 

    861. 

  861. {$IFDEF WIN32}

    862. 

  862.     {$DEFINE VCL}

    863. 

  863. {$ENDIF}

    864. 

  864. 

    865. 

  865. interface

    866. 

  866. 

    867. 

  867. uses

    868. 

  868. { You must define USE_SSL so that SSL code is included in the component.    }

    869. 

  869. { Either in OverbyteIcsDefs.inc or in the project/package options.          }

    870. 

  870. {$IFDEF USE_SSL}

    871. 

  871.   OverbyteIcsSSLEAY, OverbyteIcsLIBEAY, Contnrs, Masks, { Masks added AG 06/20/07 }  

    872. 

  872. {$ENDIF}

    873. 

  873. {$IFDEF CLR}

    874. 

  874.   System.ComponentModel,

    875. 

  875.   System.Text,

    876. 

  876.   System.Runtime.InteropServices,

    877. 

  877.   {$IFDEF VCL}

    878. 

  878.   Borland.Vcl.Classes,

    879. 

  879.   {$ENDIF}

    880. 

  880. {$ENDIF}

    881. 

  881. {$IFNDEF NO_DEBUG_LOG}

    882. 

  882.   OverbyteIcsLogger,

    883. 

  883. {$ENDIF}

    884. 

  884. {$IF DEFINED(BUILTIN_THROTTLE) or DEFINED(BUILTIN_TIMEOUT)}

    885. 

  885.   OverbyteIcsThreadTimer,

    886. 

  886. {$IFEND}

    887. 

  887.   OverbyteIcsUtils,

    888. 

  888.   OverbyteIcsTypes,      OverbyteIcsLibrary,

    889. 

  889.   OverbyteIcsWndControl, OverbyteIcsWSockBuf,

    890. 

  890.   OverbyteIcsWinsock;

    891. 

  891. 

    892. 

  892. const

    893. 

  893.   WSocketVersion            = 747;

    894. 

  894.   CopyRight    : String     = ' TWSocket (c) 1996-2010 Francois Piette V7.47 ';

    895. 

  895.   WSA_WSOCKET_TIMEOUT       = 12001;

    896. 

  896. {$IFNDEF BCB}

    897. 

  897.   { Manifest constants for Shutdown }

    898. 

  898.   SD_RECEIVE                = 0;

    899. 

  899.   SD_SEND                   = 1;  { Use this one for graceful close }

    900. 

  900.   SD_BOTH                   = 2;

    901. 

  901. {$ENDIF}

    902. 

  902. {$IFDEF WIN32}

    903. 

  903.   winsocket  = 'wsock32.dll';      { 32 bits TCP/IP system DLL }

    904. 

  904.   winsocket2 = 'ws2_32.dll';       { 32 bits TCP/IP system DLL version 2}

    905. 

  905. {$ELSE}

    906. 

  906.   winsocket = 'winsock.dll';      { 16 bits TCP/IP system DLL }

    907. 

  907. {$ENDIF}

    908. 

  908. 

    909. 

  909. type

    910. 

  910. 

    911. 

  911.   TWndMethod         = procedure(var Message: TMessage) of object;

    912. 

  912.   ESocketException   = class(Exception);

    913. 

  913.   TBgExceptionEvent  = procedure (Sender : TObject;

    914. 

  914.                                   E : Exception;

    915. 

  915.                                   var CanClose : Boolean) of object;

    916. 

  916. 

    917. 

  917.   TSocketState       = (wsInvalidState,

    918. 

  918.                         wsOpened,     wsBound,

    919. 

  919.                         wsConnecting, wsSocksConnected, wsConnected,

    920. 

  920.                         wsAccepting,  wsListening,

    921. 

  921.                         wsClosed);

    922. 

  922.   TSocketSendFlags   = (wsSendNormal, wsSendUrgent);

    923. 

  923.   TSocketLingerOnOff = (wsLingerOff, wsLingerOn, wsLingerNoSet);

    924. 

  924.   TSocketKeepAliveOnOff = (wsKeepAliveOff, wsKeepAliveOnCustom,

    925. 

  925.                            wsKeepAliveOnSystem);

    926. 

  926. {$IFDEF CLR}

    927. 

  927.   TSockAddr          = OverbyteIcsWinSock.TSockAddr;  

    928. 

  928. {$ENDIF}

    929. 

  929. {$IFDEF WIN32}

    930. 

  930.   TSockAddr          = OverbyteIcsWinsock.TSockAddr;

    931. 

  931.     ip_mreq = record

    932. 

  932.         imr_multiaddr : in_addr;

    933. 

  933.         imr_interface : in_addr;

    934. 

  934.     end;

    935. 

  935. {$ENDIF}

    936. 

  936. 

    937. 

  937.   TDataAvailable     = procedure (Sender: TObject; ErrCode: Word) of object;

    938. 

  938.   TDataSent          = procedure (Sender: TObject; ErrCode: Word) of object;

    939. 

  939.   TSendData          = procedure (Sender: TObject; BytesSent: Integer) of object;

    940. 

  940.   TSessionClosed     = procedure (Sender: TObject; ErrCode: Word) of object;

    941. 

  941.   TSessionAvailable  = procedure (Sender: TObject; ErrCode: Word) of object;

    942. 

  942.   TSessionConnected  = procedure (Sender: TObject; ErrCode: Word) of object;

    943. 

  943.   TDnsLookupDone     = procedure (Sender: TObject; ErrCode: Word) of object;

    944. 

  944.   TChangeState       = procedure (Sender: TObject;

    945. 

  945.                                  OldState, NewState : TSocketState) of object;

    946. 

  946.   TDebugDisplay      = procedure (Sender: TObject; var Msg : String) of object;

    947. 

  947.   TWSocketSyncNextProc = procedure of object;

    948. 

  948. {$IFDEF CLR}

    949. 

  949.   [Flags]

    950. 

  950.   TWSocketOptions      = (wsoNone          = 0,

    951. 

  951.                           wsoNoReceiveLoop = 1,

    952. 

  952.                           wsoTcpNoDelay    = 2,

    953. 

  953.                           wsoSIO_RCVALL    = 4);

    954. 

  954.   TWSocketOption       = TWSocketOptions;

    955. 

  955. {$ENDIF}

    956. 

  956. {$IFDEF WIN32}

    957. 

  957.   TWSocketOption       = (wsoNoReceiveLoop, wsoTcpNoDelay, wsoSIO_RCVALL);

    958. 

  958.   TWSocketOptions      = set of TWSocketOption;

    959. 

  959. {$ENDIF}

    960. 

  960. {$IFDEF DELPHI4_UP}

    961. 

  961.   { TSocket type definition has been removed starting from Delphi 4 }

    962. 

  962.   //TSocket = u_int;

    963. 

  963. {$ENDIF}

    964. 

  964.   TTcpKeepAlive = packed record

    965. 

  965.     OnOff             : u_long;

    966. 

  966.     KeepAliveTime     : u_long;

    967. 

  967.     KeepAliveInterval : u_long;

    968. 

  968.   end;

    969. 

  969. 

    970. 

  970. type  { <== Required to make D7 code explorer happy, AG 05/24/2007 }

    971. 

  971. 

    972. 

  972.   TWSocketCounter = class(TObject)

    973. 

  973.   private

    974. 

  974.     FConnectDT    : TDateTime;

    975. 

  975.     FConnectTick  : Cardinal;

    976. 

  976.     FLastRecvTick : Cardinal;

    977. 

  977.     FLastSendTick : Cardinal;

    978. 

  978.     function  GetLastAliveTick : Cardinal;

    979. 

  979.   public

    980. 

  980.     procedure SetConnected; virtual;

    981. 

  981.     property  ConnectTick   : Cardinal  read FConnectTick  write FConnectTick;

    982. 

  982.     property  ConnectDT     : TDateTime read FConnectDT    write FConnectDT;

    983. 

  983.     property  LastAliveTick : Cardinal  read GetLastAliveTick;

    984. 

  984.     property  LastRecvTick  : Cardinal  read FLastRecvTick write FLastRecvTick;

    985. 

  985.     property  LastSendTick  : Cardinal  read FLastSendTick write FLastSendTick;

    986. 

  986.   end;

    987. 

  987.   TWSocketCounterClass = class of TWSocketCounter;

    988. 

  988. 

    989. 

  989.   TCustomWSocket = class(TIcsWndControl)

    990. 

  990.   private

    991. 

  991.     FDnsResult          : String;

    992. 

  992.     FDnsResultList      : TStrings;

    993. 

  993.     FSendFlags          : Integer;

    994. 

  994.     FLastError          : Integer;

    995. 

  995.     //FWindowHandle       : HWND;

    996. 

  996.   {$IFDEF CLR}

    997. 

  997.     FDnsLookupBuffer    : TBytes;

    998. 

  998.     FName               : String;

    999. 

  999.   {$ENDIF}

    1000. 

  1000.   {$IFDEF WIN32}

    1001. 

  1001.     FDnsLookupBuffer    : array [0..MAXGETHOSTSTRUCT] of AnsiChar;

    1002. 

  1002.   {$ENDIF}

    1003. 

  1003.     FDnsLookupCheckMsg  : Boolean;

    1004. 

  1004.     FDnsLookupTempMsg   : TMessage;

    1005. 

  1005.     // FHandle             : HWND;

    1006. 

  1006.   {$IFDEF CLR}

    1007. 

  1007.     FDnsLookupGCH       : GCHandle;

    1008. 

  1008.     FDnsLookupIntPtr    : IntPtr;

    1009. 

  1009.   {$ENDIF}

    1010. 

  1010.   {$IFDEF VER80}

    1011. 

  1011.     FTrumpetCompability : Boolean;

    1012. 

  1012.   {$ENDIF}

    1013. 

  1013.     FCounter            : TWSocketCounter;

    1014. 

  1014.     FCounterClass       : TWsocketCounterClass;

    1015. 

  1015.   protected

    1016. 

  1016.     FHSocket            : TSocket;

    1017. 

  1017.     FASocket            : TSocket;               { Accepted socket }

    1018. 

  1018.     FMsg_WM_ASYNCSELECT            : UINT;

    1019. 

  1019.     FMsg_WM_ASYNCGETHOSTBYNAME     : UINT;

    1020. 

  1020.     FMsg_WM_ASYNCGETHOSTBYADDR     : UINT;

    1021. 

  1021.     FMsg_WM_CLOSE_DELAYED          : UINT;

    1022. 

  1022.     //FMsg_WM_WSOCKET_RELEASE      : UINT;

    1023. 

  1023.     FMsg_WM_TRIGGER_EXCEPTION      : UINT;

    1024. 

  1024.     FMsg_WM_TRIGGER_DATA_AVAILABLE : UINT;

    1025. 

  1025.     FAddrStr            : String;

    1026. 

  1026.     FAddrResolved       : Boolean;

    1027. 

  1027.     FAddrFormat         : Integer;

    1028. 

  1028.     FAddrAssigned       : Boolean;

    1029. 

  1029.     FProto              : Integer;

    1030. 

  1030.     FProtoAssigned      : Boolean;

    1031. 

  1031.     FProtoResolved      : Boolean;

    1032. 

  1032.     FLocalPortResolved  : Boolean;

    1033. 

  1033.     FProtoStr           : String;

    1034. 

  1034.     FPortStr            : String;

    1035. 

  1035.     FPortAssigned       : Boolean;

    1036. 

  1036.     FPortResolved       : Boolean;

    1037. 

  1037.     FPortNum            : Integer;

    1038. 

  1038.     FLocalPortStr       : String;

    1039. 

  1039.     FLocalPortNum       : Integer;

    1040. 

  1040.     FLocalAddr          : String;     { IP address for local interface to use }

    1041. 

  1041.     FType               : Integer;

    1042. 

  1042.     FBufHandler         : TIcsBufferHandler;

    1043. 

  1043.     FLingerOnOff        : TSocketLingerOnOff;

    1044. 

  1044.     FLingerTimeout      : Integer;              { In seconds, 0 = disabled }

    1045. 

  1045.     FKeepAliveOnOff     : TSocketKeepAliveOnOff;

    1046. 

  1046.     FKeepAliveTime      : Integer;              { In milliseconds }

    1047. 

  1047.     FKeepAliveInterval  : Integer;              { In milliseconds }

    1048. 

  1048.     FListenBacklog      : Integer;

    1049. 

  1049.     ReadLineCount       : Integer;

    1050. 

  1050.     bAllSent            : Boolean;

    1051. 

  1051.     FReadCount          : Int64;   { V5.26 }

    1052. 

  1052.     FWriteCount         : Int64;   { V7.24 }

    1053. 

  1053. 

    1054. 

  1054.     FPaused             : Boolean;

    1055. 

  1055.     FCloseInvoked       : Boolean;

    1056. 

  1056.     FBufferedByteCount  : LongInt;   { V5.20 how man xmit bytes unsent        }

    1057. 

  1057.     FFlushTimeout       : Integer;   { This property is not used anymore      }

    1058. 

  1058.     FMultiThreaded      : Boolean;

    1059. 

  1059.     FDnsLookupHandle    : THandle;

    1060. 

  1060.     { More info about multicast can be found at:                              }

    1061. 

  1061.     {    http://ntrg.cs.tcd.ie/undergrad/4ba2/multicast/antony/               }

    1062. 

  1062.     {    http://www.tldp.org/HOWTO/Multicast-HOWTO-6.html                     }

    1063. 

  1063.     FMultiCast          : Boolean;

    1064. 

  1064.     { Multicast addresses consists of a range of addresses from 224.0.0.0 to  }

    1065. 

  1065.     { 239.255.255.255. However, the multicast addresses from 224.0.0.0 to     }

    1066. 

  1066.     { 224.0.0.255 are reserved for multicast routing information; Application }

    1067. 

  1067.     { programs should use multicast addresses outside this range.             }

    1068. 

  1068.     FMultiCastAddrStr   : String;

    1069. 

  1069.     FMultiCastIpTTL     : Integer;

    1070. 

  1070.     FReuseAddr          : Boolean;

    1071. 

  1071.     FComponentOptions   : TWSocketOptions;

    1072. 

  1072.     FState              : TSocketState;

    1073. 

  1073.     FRcvdFlag           : Boolean;

    1074. 

  1074.     FSelectEvent        : LongInt;

    1075. 

  1075.     FSelectMessage      : WORD;

    1076. 

  1076. {$IFDEF CLR}

    1077. 

  1077.     FRecvStrBuf         : TBytes;

    1078. 

  1078. {$ENDIF}

    1079. 

  1079.     FOnSessionAvailable : TSessionAvailable;

    1080. 

  1080.     FOnSessionConnected : TSessionConnected;

    1081. 

  1081.     FOnSessionClosed    : TSessionClosed;

    1082. 

  1082.     FOnChangeState      : TChangeState;

    1083. 

  1083.     FOnDataAvailable    : TDataAvailable;

    1084. 

  1084.     FOnDataSent         : TDataSent;

    1085. 

  1085.     FOnSendData         : TSendData;

    1086. 

  1086.     { FOnLineTooLong      : TNotifyEvent; }

    1087. 

  1087.     FOnDnsLookupDone    : TDnsLookupDone;

    1088. 

  1088.     FOnError            : TNotifyEvent;

    1089. 

  1089.     FOnBgException      : TBgExceptionEvent;

    1090. 

  1090.     FOnDebugDisplay     : TDebugDisplay;       { 18/06/05 }

    1091. 

  1091.     FOnMessagePump      : TNotifyEvent;

    1092. 

  1092.     //FThreadId           : THandle;

    1093. 

  1093.     FSocketSndBufSize   : Integer;  { Winsock internal socket send buffer size }

    1094. 

  1094.     FSocketRcvBufSize   : Integer;  { Winsock internal socket Recv buffer size }

    1095. 

  1095. {$IFNDEF NO_DEBUG_LOG}

    1096. 

  1096.     FIcsLogger          : TIcsLogger;                                           { V5.21 }

    1097. 

  1097.     procedure   SetIcsLogger(const Value : TIcsLogger); virtual;                { V5.21 }

    1098. 

  1098.     procedure   DebugLog(LogOption : TLogOption; const Msg : String); virtual;  { V5.21 }

    1099. 

  1099.     function    CheckLogOptions(const LogOption: TLogOption): Boolean; virtual; { V5.21 }

    1100. 

  1100. {$ENDIF}

    1101. 

  1101.     procedure   WndProc(var MsgRec: TMessage); override;

    1102. 

  1102.     function    MsgHandlersCount: Integer; override;

    1103. 

  1103.     procedure   AllocateMsgHandlers; override;

    1104. 

  1104.     procedure   FreeMsgHandlers; override;

    1105. 

  1105.     procedure   AllocateSocketHWnd; virtual;

    1106. 

  1106.     procedure   DeallocateSocketHWnd; virtual;

    1107. 

  1107.     procedure   SocketError(sockfunc: String);

    1108. 

  1108.     procedure   WMASyncSelect(var msg: TMessage);

    1109. 

  1109.     procedure   WMAsyncGetHostByName(var msg: TMessage);

    1110. 

  1110.     procedure   WMAsyncGetHostByAddr(var msg: TMessage);

    1111. 

  1111.     procedure   WMCloseDelayed(var msg: TMessage);

    1112. 

  1112.     //procedure WMRelease(var msg: TMessage);

    1113. 

  1113.     procedure   ChangeState(NewState : TSocketState);

    1114. 

  1114.     procedure   TryToSend; virtual;

    1115. 

  1115.     procedure   ASyncReceive(Error : Word; MySocketOptions : TWSocketOptions);

    1116. 

  1116.     procedure   AssignDefaultValue; virtual;

    1117. 

  1117.     procedure   InternalClose(bShut : Boolean; Error : Word); virtual;

    1118. 

  1118.     procedure   InternalAbort(ErrCode : Word); virtual;

    1119. 

  1119. {$IFDEF WIN32}

    1120. 

  1120.     procedure   Notification(AComponent: TComponent; operation: TOperation); override;

    1121. 

  1121. {$ENDIF}

    1122. 

  1122.     procedure   SetSendFlags(newValue : TSocketSendFlags);

    1123. 

  1123.     function    GetSendFlags : TSocketSendFlags;

    1124. 

  1124.     procedure   SetAddr(InAddr : String);

    1125. 

  1125.     procedure   SetCounterClass(const Value: TWSocketCounterClass);

    1126. 

  1126.     procedure   SetRemotePort(sPort : String); virtual;

    1127. 

  1127.     function    GetRemotePort : String;

    1128. 

  1128.     procedure   SetLocalAddr(sLocalAddr : String);

    1129. 

  1129.     procedure   SetLocalPort(const sLocalPort : String);

    1130. 

  1130.     procedure   SetProto(sProto : String); virtual;

    1131. 

  1131.     function    GetRcvdCount : LongInt; virtual;

    1132. 

  1132.     procedure   SetBufSize(Value : Integer); virtual;

    1133. 

  1133.     function    GetBufSize: Integer; virtual;

    1134. 

  1134.     procedure   SetSocketRcvBufSize(BufSize : Integer); virtual;

    1135. 

  1135.     procedure   SetSocketSndBufSize(BufSize : Integer); virtual;

    1136. 

  1136.     procedure   BindSocket; virtual;

    1137. 

  1137.     procedure   SendText(const Str : RawByteString); {$IFDEF COMPILER12_UP} overload;

    1138. 

  1138.     procedure   SendText(const Str : UnicodeString); overload;

    1139. 

  1139.     procedure   SendText(const Str : UnicodeString; ACodePage : LongWord); overload;

    1140. 

  1140.     {$ENDIF}

    1141. 

  1141.     function    RealSend(var Data : TWSocketData; Len : Integer) : Integer; virtual;

    1142. 

  1142. //  procedure   RaiseExceptionFmt(const Fmt : String; args : array of const); virtual;

    1143. 

  1143.     procedure   RaiseException(const Msg : String); virtual;

    1144. 

  1144.     procedure   HandleBackGroundException(E: Exception); override;

    1145. 

  1145.     function    GetReqVerLow: BYTE;

    1146. 

  1146.     procedure   SetReqVerLow(const Value: BYTE);

    1147. 

  1147.     function    GetReqVerHigh: BYTE;

    1148. 

  1148.     procedure   SetReqVerHigh(const Value: BYTE);

    1149. 

  1149.     procedure   TriggerDebugDisplay(Msg : String); { 18/06/05 }

    1150. 

  1150.     procedure   TriggerSendData(BytesSent : Integer);

    1151. 

  1151.     function    TriggerDataAvailable(Error : Word) : Boolean; virtual;

    1152. 

  1152.     procedure   TriggerSessionAvailable(Error : Word); virtual;

    1153. 

  1153.     procedure   TriggerSessionConnectedSpecial(Error : Word); virtual;

    1154. 

  1154.     procedure   TriggerSessionConnected(Error : Word); virtual;

    1155. 

  1155.     procedure   TriggerSessionClosed(Error : Word); virtual;

    1156. 

  1156.     procedure   TriggerDataSent(Error : Word); virtual;

    1157. 

  1157.     procedure   TriggerChangeState(OldState, NewState : TSocketState); virtual;

    1158. 

  1158.     procedure   TriggerDNSLookupDone(Error : Word); virtual;

    1159. 

  1159.     procedure   TriggerError; virtual;

    1160. 

  1160.     function    DoRecv(var Buffer : TWSocketData;

    1161. 

  1161.                        BufferSize : Integer;

    1162. 

  1162.                        Flags      : Integer) : Integer; virtual;

    1163. 

  1163.     function    DoRecvFrom(FHSocket    : TSocket;

    1164. 

  1164.                            var Buffer  : TWSocketData;

    1165. 

  1165.                            BufferSize  : Integer;

    1166. 

  1166.                            Flags       : Integer;

    1167. 

  1167.                            var From    : TSockAddr;

    1168. 

  1168.                            var FromLen : Integer) : Integer; virtual;

    1169. 

  1169.     procedure Do_FD_CONNECT(var msg: TMessage); virtual;

    1170. 

  1170.     procedure Do_FD_READ(var msg: TMessage); virtual;

    1171. 

  1171.     procedure Do_FD_WRITE(var msg: TMessage); virtual;

    1172. 

  1172.     procedure Do_FD_ACCEPT(var msg: TMessage); virtual;

    1173. 

  1173.     procedure Do_FD_CLOSE(var msg: TMessage); virtual;

    1174. 

  1174.     procedure DupConnected; virtual;

    1175. 

  1175.   public

    1176. 

  1176.     sin         : TSockAddrIn;

    1177. 

  1177. {$IFDEF CLR}

    1178. 

  1178.     constructor Create{$IFDEF VCL}(AOwner : TComponent){$ENDIF}; override;

    1179. 

  1179. {$ENDIF}

    1180. 

  1180. {$IFDEF WIN32}

    1181. 

  1181.     constructor Create(AOwner: TComponent); override;

    1182. 

  1182. {$ENDIF}

    1183. 

  1183.     destructor  Destroy; override;

    1184. 

  1184.     procedure   Connect; virtual;

    1185. 

  1185.     procedure   Close; virtual;

    1186. 

  1186.     procedure   CloseDelayed; virtual;

    1187. 

  1187.     //procedure Release; override;    { Release is handled in TIcsWndControl }

    1188. 

  1188.     procedure   Abort; virtual;

    1189. 

  1189.     procedure   Flush; virtual;

    1190. 

  1190.     procedure   WaitForClose; virtual;

    1191. 

  1191.     procedure   Listen; virtual;

    1192. 

  1192.     function    Accept: TSocket; virtual;

    1193. 

  1193.     function    Receive(Buffer : TWSocketData; BufferSize: Integer) : Integer;  {overload; }virtual;

    1194. 

  1194. //{$IFDEF WIN32}

    1195. 

  1195. //    function    Receive(Buffer : TBytes; BufferSize: Integer) : Integer;  overload; virtual;

    1196. 

  1196. //{$ENDIF}

    1197. 

  1197.     function    ReceiveStr : String; virtual;

    1198. 

  1198.     function    ReceiveStrA : AnsiString; virtual;

    1199. 

  1199. {$IFDEF COMPILER12_UP}

    1200. 

  1200.     function    ReceiveStrW(ACodePage: LongWord) : UnicodeString; overload; virtual;

    1201. 

  1201.     function    ReceiveStrW : UnicodeString; overload; virtual;

    1202. 

  1202. {$ENDIF}

    1203. 

  1203.     function    ReceiveFrom(Buffer      : TWSocketData;

    1204. 

  1204.                             BufferSize  : Integer;

    1205. 

  1205.                             var From    : TSockAddr;

    1206. 

  1206.                             var FromLen : Integer) : Integer; virtual;

    1207. 

  1207.     function    PeekData(Buffer : TWSocketData; BufferSize: Integer) : Integer;

    1208. 

  1208.     function    Send({$IFDEF CLR} const {$ENDIF} Data : TWSocketData; Len : Integer) : Integer; overload; virtual;

    1209. 

  1209.     function    Send(DataByte : Byte) : Integer; overload; virtual;

    1210. 

  1210.     function    SendTo(Dest       : TSockAddr;

    1211. 

  1211.                        DestLen    : Integer;

    1212. 

  1212.                        {$IFDEF CLR} const {$ENDIF} Data : TWSocketData;

    1213. 

  1213.                        Len        : Integer) : Integer; virtual;

    1214. 

  1214.     function    SendStr(const Str : RawByteString) : Integer; {$IFDEF COMPILER12_UP} overload; {$ENDIF} virtual;

    1215. 

  1215. {$IFDEF COMPILER12_UP}

    1216. 

  1216.     function    SendStr(const Str : UnicodeString; ACodePage: LongWord) : Integer; overload; virtual;

    1217. 

  1217.     function    SendStr(const Str : UnicodeString) : Integer; overload; virtual;

    1218. 

  1218. {$ENDIF}

    1219. 

  1219.     procedure   DnsLookup(const AHostName : String); virtual;

    1220. 

  1220.     procedure   ReverseDnsLookup(const HostAddr: String); virtual;

    1221. 

  1221.     procedure   ReverseDnsLookupSync(const HostAddr: String); virtual;  {AG 03/03/06}

    1222. 

  1222.     procedure   CancelDnsLookup; virtual;

    1223. 

  1223.     function    GetPeerAddr: String; virtual;

    1224. 

  1224.     function    GetPeerPort: String; virtual;

    1225. 

  1225.     function    GetPeerName(var Name : TSockAddrIn; NameLen : Integer) : Integer; virtual;

    1226. 

  1226.     function    GetXPort: String; virtual;

    1227. 

  1227.     function    GetXAddr: String; virtual;

    1228. 

  1228.     function    TimerIsSet(var tvp : TTimeVal) : Boolean; virtual;

    1229. 

  1229.     procedure   TimerClear(var tvp : TTimeVal); virtual;

    1230. 

  1230.     function    TimerCmp(var tvp : TTimeVal; var uvp : TTimeVal; IsEqual : Boolean) : Boolean; virtual;

    1231. 

  1231.     function    GetSockName(var saddr : TSockAddrIn; var saddrlen : Integer) : Integer; virtual;

    1232. 

  1232.     procedure   SetLingerOption;

    1233. 

  1233.     procedure   SetKeepAliveOption;

    1234. 

  1234.     function    SetTcpNoDelayOption: Boolean; { V7.27 }

    1235. 

  1235.     procedure   Dup(NewHSocket : TSocket); virtual;

    1236. 

  1236.     procedure   Shutdown(How : Integer); virtual;

    1237. 

  1237.     procedure   Pause; virtual;

    1238. 

  1238.     procedure   Resume; virtual;

    1239. 

  1239.     procedure   PutDataInSendBuffer(Data : TWSocketData; Len : Integer); virtual;

    1240. 

  1240.     function    PutStringInSendBuffer(const Str : RawByteString): Integer; {$IFDEF COMPILER12_UP} overload; {$ENDIF}

    1241. 

  1241. {$IFDEF COMPILER12_UP}

    1242. 

  1242.     function    PutStringInSendBuffer(const Str : UnicodeString; ACodePage: LongWord): Integer; overload;

    1243. 

  1243.     function    PutStringInSendBuffer(const Str : UnicodeString): Integer; overload;

    1244. 

  1244. {$ENDIF}

    1245. 

  1245.     procedure   DeleteBufferedData;

    1246. 

  1246. {$IFDEF COMPILER2_UP}

    1247. 

  1247.     procedure   ThreadAttach; override;

    1248. 

  1248.     procedure   ThreadDetach; override;

    1249. 

  1249. {$ENDIF}

    1250. 

  1250.     procedure   CreateCounter; virtual;

    1251. 

  1251.     procedure   DestroyCounter;

    1252. 

  1252. {$IFDEF NOFORMS}

    1253. 

  1253.     property    Terminated         : Boolean        read  FTerminated

    1254. 

  1254.                                                     write FTerminated;

    1255. 

  1255.     property    OnMessagePump      : TNotifyEvent   read  FOnMessagePump

    1256. 

  1256.                                                     write FOnMessagePump;

    1257. 

  1257. {$ENDIF}

    1258. 

  1258.     property    BufferedByteCount  : LongInt        read FBufferedByteCount;  { V5.20 }

    1259. 

  1259.   protected

    1260. 

  1260.   {$IFDEF CLR}

    1261. 

  1261.     property Name : String                          read  FName

    1262. 

  1262.                                                     write FName;

    1263. 

  1263.   {$ENDIF}

    1264. 

  1264. {$IFNDEF NO_DEBUG_LOG}

    1265. 

  1265.     property IcsLogger : TIcsLogger                 read  FIcsLogger          { V5.21 }

    1266. 

  1266.                                                     write SetIcsLogger;       { V5.21 }

    1267. 

  1267. {$ENDIF}

    1268. 

  1268.     property PortNum : Integer                      read  FPortNum;

    1269. 

  1269.     property FWindowHandle : HWND                   read  FHandle;

    1270. 

  1270.     property HSocket : TSocket                      read  FHSocket

    1271. 

  1271.                                                     write Dup;

    1272. 

  1272.     property Addr : String                          read  FAddrStr

    1273. 

  1273.                                                     write SetAddr;

    1274. 

  1274.     property Port : String                          read  GetRemotePort

    1275. 

  1275.                                                     write SetRemotePort;

    1276. 

  1276.     property LocalPort : String                     read  FLocalPortStr

    1277. 

  1277.                                                     write SetLocalPort;

    1278. 

  1278.     property LocalAddr : String                     read  FLocalAddr

    1279. 

  1279.                                                     write SetLocalAddr;

    1280. 

  1280.     property Proto : String                         read  FProtoStr

    1281. 

  1281.                                                     write SetProto;

    1282. 

  1282.     property MultiThreaded   : Boolean              read  FMultiThreaded

    1283. 

  1283.                                                     write FMultiThreaded;

    1284. 

  1284.     property MultiCast       : Boolean              read  FMultiCast

    1285. 

  1285.                                                     write FMultiCast;

    1286. 

  1286.     property MultiCastAddrStr: String               read  FMultiCastAddrStr

    1287. 

  1287.                                                     write FMultiCastAddrStr;

    1288. 

  1288.     property MultiCastIpTTL  : Integer              read  FMultiCastIpTTL

    1289. 

  1289.                                                     write FMultiCastIpTTL;

    1290. 

  1290.     property ReuseAddr       : Boolean              read  FReuseAddr

    1291. 

  1291.                                                     write FReuseAddr;

    1292. 

  1292.     property PeerAddr : String                      read  GetPeerAddr;

    1293. 

  1293.     property PeerPort : String                      read  GetPeerPort;

    1294. 

  1294.     property DnsResult : String                     read  FDnsResult;

    1295. 

  1295.     property DnsResultList : TStrings               read  FDnsResultList;

    1296. 

  1296.     property State : TSocketState                   read  FState;

    1297. 

  1297.     property AllSent   : Boolean                    read  bAllSent;

    1298. 

  1298.     property ReadCount : Int64                      read  FReadCount;    { V5.26 }

    1299. 

  1299.     property WriteCount : Int64                     read  FWriteCount;   { V7.24 }

    1300. 

  1300.     property RcvdCount : LongInt                    read  GetRcvdCount;

    1301. 

  1301.     property LastError : Integer                    read  FLastError

    1302. 

  1302.                                                     write FLastError;  { V5.20 }

    1303. 

  1303.     property ComponentOptions : TWSocketOptions     read  FComponentOptions

    1304. 

  1304.                                                     write FComponentOptions;

    1305. 

  1305.     property BufSize          : Integer             read  GetBufSize

    1306. 

  1306.                                                     write SetBufSize;

    1307. 

  1307.     property SocketRcvBufSize : Integer             read  FSocketRcvBufSize

    1308. 

  1308.                                                     write SetSocketRcvBufSize;

    1309. 

  1309.     property SocketSndBufSize : Integer             read  FSocketSndBufSize

    1310. 

  1310.                                                     write SetSocketSndBufSize;

    1311. 

  1311.     property ListenBacklog    : Integer             read  FListenBacklog

    1312. 

  1312.                                                     write FListenBacklog;

    1313. 

  1313.     property ReqVerLow       : BYTE                 read  GetReqVerLow

    1314. 

  1314.                                                     write SetReqVerLow;

    1315. 

  1315.     property ReqVerHigh      : BYTE                 read  GetReqVerHigh

    1316. 

  1316.                                                     write SetReqVerHigh;

    1317. 

  1317.     property OnDataAvailable : TDataAvailable       read  FOnDataAvailable

    1318. 

  1318.                                                     write FOnDataAvailable;

    1319. 

  1319.     property OnDataSent      : TDataSent            read  FOnDataSent

    1320. 

  1320.                                                     write FOnDataSent;

    1321. 

  1321.     property OnSendData      : TSendData            read  FOnSendData

    1322. 

  1322.                                                     write FOnSendData;

    1323. 

  1323.     property OnSessionClosed : TSessionClosed       read  FOnSessionClosed

    1324. 

  1324.                                                     write FOnSessionClosed;

    1325. 

  1325.     property OnSessionAvailable : TSessionAvailable read  FOnSessionAvailable

    1326. 

  1326.                                                     write FOnSessionAvailable;

    1327. 

  1327.     property OnSessionConnected : TSessionConnected read  FOnSessionConnected

    1328. 

  1328.                                                     write FOnSessionConnected;

    1329. 

  1329.     property OnChangeState      : TChangeState      read  FOnChangeState

    1330. 

  1330.                                                     write FOnChangeState;

    1331. 

  1331.   { property OnLineTooLong      : TNotifyEvent      read  FOnLineTooLong

    1332. 

  1332.                                                     write FOnLineTooLong; }

    1333. 

  1333.     property OnDnsLookupDone    : TDnsLookupDone    read  FOnDnsLookupDone

    1334. 

  1334.                                                     write FOnDnsLookupDone;

    1335. 

  1335.     property OnError            : TNotifyEvent      read  FOnError

    1336. 

  1336.                                                     write FOnError;

    1337. 

  1337.     property OnBgException      : TBgExceptionEvent read  FOnBgException

    1338. 

  1338.                                                     write FOnBgException;

    1339. 

  1339.     { FlushTimeout property is not used anymore }

    1340. 

  1340.     property FlushTimeout : Integer                 read  FFlushTimeOut

    1341. 

  1341.                                                     write FFlushTimeout;

    1342. 

  1342.     property SendFlags : TSocketSendFlags           read  GetSendFlags

    1343. 

  1343.                                                     write SetSendFlags;

    1344. 

  1344.     property Text: String                           read  ReceiveStr

    1345. 

  1345.                                                     write SendText;

    1346. 

  1346.     property LingerOnOff   : TSocketLingerOnOff     read  FLingerOnOff

    1347. 

  1347.                                                     write FLingerOnOff;

    1348. 

  1348.     property LingerTimeout : Integer                read  FLingerTimeout

    1349. 

  1349.                                                     write FLingerTimeout;

    1350. 

  1350.     property KeepAliveOnOff: TSocketKeepAliveOnOff  read  FKeepAliveOnOff

    1351. 

  1351.                                                     write FKeepAliveOnOff;

    1352. 

  1352.     property KeepAliveTime : Integer                read  FKeepAliveTime

    1353. 

  1353.                                                     write FKeepAliveTime;

    1354. 

  1354.     property KeepAliveInterval : Integer            read  FKeepAliveInterval

    1355. 

  1355.                                                     write FKeepAliveInterval;

    1356. 

  1356. {$IFDEF DELPHI1}

    1357. 

  1357.     property TrumpetCompability : Boolean           read  FTrumpetCompability

    1358. 

  1358.                                                     write FTrumpetCompability;

    1359. 

  1359. {$ENDIF}

    1360. 

  1360.     property OnDebugDisplay : TDebugDisplay         read  FOnDebugDisplay

    1361. 

  1361.                                                     write FOnDebugDisplay;

    1362. 

  1362.     property Counter      : TWSocketCounter         read  FCounter;

    1363. 

  1363.     property CounterClass : TWsocketCounterClass    read  FCounterClass

    1364. 

  1364.                                                     write SetCounterClass;

    1365. 

  1365.   end;

    1366. 

  1366. 

    1367. 

  1367.   TSocksState          = (socksData, socksNegociateMethods, socksAuthenticate, socksConnect);

    1368. 

  1368.   TSocksAuthentication = (socksNoAuthentication, socksAuthenticateUsercode);

    1369. 

  1369.   TSocksAuthState      = (socksAuthStart, socksAuthSuccess, socksAuthFailure, socksAuthNotRequired);

    1370. 

  1370.   TSocksAuthStateEvent = procedure(Sender : TObject; AuthState : TSocksAuthState) of object;

    1371. 

  1371.   TSocksErrorEvent     = procedure(Sender : TObject; Error : Integer; Msg : String) of Object;

    1372. 

  1372. 

    1373. 

  1373.   TCustomSocksWSocket = class(TCustomWSocket)

    1374. 

  1374.   protected

    1375. 

  1375.       FSocksState          : TSocksState;

    1376. 

  1376.       FSocksServer         : String;

    1377. 

  1377.       FSocksLevel          : String;

    1378. 

  1378.       FSocksPort           : String;

    1379. 

  1379.       FSocksPortAssigned   : Boolean;

    1380. 

  1380.       FSocksServerAssigned : Boolean;

    1381. 

  1381.       FSocksUsercode       : String;

    1382. 

  1382.       FSocksPassword       : String;

    1383. 

  1383.       FSocksAuthentication : TSocksAuthentication;

    1384. 

  1384.       FSocksAuthNumber     : AnsiChar;

    1385. 

  1385.       FBoundAddr           : AnsiString;

    1386. 

  1386.       FBoundPort           : AnsiString;

    1387. 

  1387.   {$IFDEF CLR}

    1388. 

  1388.       FRcvBuf              : TBytes;

    1389. 

  1389.   {$ENDIF}

    1390. 

  1390.   {$IFDEF WIN32}

    1391. 

  1391.       FRcvBuf              : array [0..127] of Byte;

    1392. 

  1392.   {$ENDIF}

    1393. 

  1393.       FRcvCnt              : Integer;

    1394. 

  1394.       FSocksRcvdCnt        : Integer;

    1395. 

  1395.       FSocksRcvdPtr        : Integer;

    1396. 

  1396.       FOnSocksError        : TSocksErrorEvent;

    1397. 

  1397.       FOnSocksConnected    : TSessionConnected;

    1398. 

  1398.       FOnSocksAuthState    : TSocksAuthStateEvent;

    1399. 

  1399.       procedure   AssignDefaultValue; override;

    1400. 

  1400.       procedure   TriggerSessionConnectedSpecial(Error : Word); override;

    1401. 

  1401.       procedure   TriggerSocksConnected(Error : Word); virtual;

    1402. 

  1402.       procedure   TriggerSessionClosed(Error : Word); override;

    1403. 

  1403.       function    TriggerDataAvailable(Error : Word) : Boolean; override;

    1404. 

  1404.       function    GetSocksPort: String;

    1405. 

  1405.       procedure   SetSocksPort(sPort : String); virtual;

    1406. 

  1406.       function    GetSocksServer: String;

    1407. 

  1407.       procedure   SetSocksServer(sServer : String); virtual;

    1408. 

  1408.       procedure   TriggerSocksError(Error : Integer; Msg : String); virtual;

    1409. 

  1409.       procedure   TriggerSocksAuthState(AuthState : TSocksAuthState);

    1410. 

  1410.       function    GetRcvdCount : LongInt; override;

    1411. 

  1411.       procedure   SetSocksLevel(newValue : String);

    1412. 

  1412.       function    DoRecv(var Buffer : TWSocketData;

    1413. 

  1413.                          BufferSize : Integer;

    1414. 

  1414.                          Flags      : Integer) : Integer; override;

    1415. 

  1415.       procedure   SocksDoConnect;

    1416. 

  1416.       procedure   SocksDoAuthenticate;

    1417. 

  1417.       procedure   DataAvailableError(ErrCode : Integer; Msg : String);

    1418. 

  1418.   public

    1419. 

  1419.       constructor Create{$IFDEF VCL}(AOwner : TComponent){$ENDIF}; override;

    1420. 

  1420.       procedure   Connect; override;

    1421. 

  1421.       procedure   Listen; override;

    1422. 

  1422.   protected

    1423. 

  1423.       property SocksServer   : String               read  GetSocksServer

    1424. 

  1424.                                                     write SetSocksServer;

    1425. 

  1425.       property SocksLevel    : String               read  FSocksLevel

    1426. 

  1426.                                                     write SetSocksLevel;

    1427. 

  1427.       property SocksPort     : String               read  FSocksPort

    1428. 

  1428.                                                     write SetSocksPort;

    1429. 

  1429.       property SocksUsercode : String               read  FSocksUsercode

    1430. 

  1430.                                                     write FSocksUsercode;

    1431. 

  1431.       property SocksPassword : String               read  FSocksPassword

    1432. 

  1432.                                                     write FSocksPassword;

    1433. 

  1433.       property SocksAuthentication : TSocksAuthentication

    1434. 

  1434.                                                     read  FSocksAuthentication

    1435. 

  1435.                                                     write FSocksAuthentication;

    1436. 

  1436.       property OnSocksError  : TSocksErrorEvent     read  FOnSocksError

    1437. 

  1437.                                                     write FOnSocksError;

    1438. 

  1438.       property OnSocksConnected : TSessionConnected read  FOnSocksConnected

    1439. 

  1439.                                                     write FOnSocksConnected;

    1440. 

  1440.       property OnSocksAuthState : TSocksAuthStateEvent

    1441. 

  1441.                                                     read  FOnSocksAuthState

    1442. 

  1442.                                                     write FOnSocksAuthState;

    1443. 

  1443.   end;

    1444. 

  1444. 

    1445. 

  1445. { You must define USE_SSL so that SSL code is included in the component.    }

    1446. 

  1446. { Either in OverbyteIcsDefs.inc or in the project/package options.          }

    1447. 

  1447. {$IFDEF USE_SSL}

    1448. 

  1448. {*_* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

    1449. 

  1449. 

    1450. 

  1450. Author:       François PIETTE

    1451. 

  1451. Description:  A component adding SSL support to TWSocket.

    1452. 

  1452.               This unit contains the interface for the component.

    1453. 

  1453.               It is included in WSocket.pas unit when USE_SSL is defined.

    1454. 

  1454.               The implementation part is in WSocketImplSsl.inc.

    1455. 

  1455.               Make use of OpenSSL (http://www.openssl.org).

    1456. 

  1456.               Make use of freeware TWSocket component from ICS.

    1457. 

  1457.               This version has been developped with the excellent collaboration

    1458. 

  1458.               and expertize from Arno Garrels <arno.garrels@gmx.de> and

    1459. 

  1459.               Benjamin Stadin <stadin@gmx.de>. They worked very hard to make

    1460. 

  1460.               this code working.

    1461. 

  1461. Creation:     Jan 11, 2003

    1462. 

  1462. Version:      1.00.9 

    1463. 

  1463. 

    1464. 

  1464. Reference guide:

    1465. 

  1465.     SslCertFile     Filename of the certificate sent to the remote site for

    1466. 

  1466.                     authetification, in PEM format.

    1467. 

  1467.     SslPassPhrase   Password phrase used to protect SslCertFile.

    1468. 

  1468.     SslPrivKeyFile  Private key used to encrypt data. Must correspond to the

    1469. 

  1469.                     public key stored in the certificate identified by

    1470. 

  1470.                     SslCertFile.

    1471. 

  1471.     SslCAFile       Filename of CA certificates in PEM format. The file can

    1472. 

  1472.                     contain several CA certificates identified by

    1473. 

  1473.                     -----BEGIN CERTIFICATE-----

    1474. 

  1474.                     ... (CA certificate in base64 encoding) ...

    1475. 

  1475.                     -----END CERTIFICATE-----

    1476. 

  1476.                     sequences. Before, between, and after the certificates text

    1477. 

  1477.                     is allowed which can be used e.g. for descriptions of the

    1478. 

  1478.                     certificates.

    1479. 

  1479.                     CAFile can be an empty string if CAPath is used.

    1480. 

  1480.     SslCAPath       Directory containing CA certificates in PEM format. The

    1481. 

  1481.                     files each contain one CA certificate. The files are looked

    1482. 

  1482.                     up by the CA subject name hash value, which must hence be

    1483. 

  1483.                     available.

    1484. 

  1484.                     If more than one CA certificate with the same name hash

    1485. 

  1485.                     value exist, the extension must be different (e.g.

    1486. 

  1486.                     9d66eef0.0, 9d66eef0.1 etc). The search is performed in

    1487. 

  1487.                     the ordering of the extension number, regardless of other

    1488. 

  1488.                     properties of the certificates.

    1489. 

  1489.                     To create the hash value for filenames, use the command

    1490. 

  1490.                     line: openssl x509 -hash -noout -in YourCert.pem

    1491. 

  1491.                     The output is a 8 digit hex number you _must_ use as file

    1492. 

  1492.                     name for a given certificate in CAPath directory. Can be

    1493. 

  1493.                     any extension, using a numeric extension is handy.

    1494. 

  1494. 

    1495. 

  1495. History:

    1496. 

  1496. Jan 19, 2003 V1.00.2 First pre-relase version. Works with TWSocket version 5.00.

    1497. 

  1497.              Lot of things remains to do. Currently support basic connections

    1498. 

  1498.              (Socks doesn't work, line mode doesn't work).

    1499. 

  1499. Mar 04, 2003 V1.00.3 Socks and LineMode support

    1500. 

  1500. Apr 14, 2003 V1.00.4 Fixed bugs related to premature session close

    1501. 

  1501. Apr 04, 2004 V1.00.5 Verified with new WSocket version

    1502. 

  1502. Aug 31, 2005 V1.00.8 Use the code from Arno Garrels <arno.garrels@gmx.de> and

    1503. 

  1503.               Benjamin Stadin <stadin@gmx.de>. They worked very hard to make

    1504. 

  1504.               this code working.

    1505. 

  1505. Dec 07, 2005 V1.00.9 A. Garrels fixed an issue with BIO I/O functions.

    1506. 

  1506.              Support of OSSL v0.9.8a added. Changed load order of OpenSSL

    1507. 

  1507.              libraries. A received SSL shutdown notification in Do_FD_READ was

    1508. 

  1508.              not detected, fixed. OpenSSL releases from 0.9.7g up to 0.9.8a

    1509. 

  1509.              should be supported. New OpenSSL version check, an exception is

    1510. 

  1510.              raised if version is not in the range of supported versions. In

    1511. 

  1511.              order to disable the version check uncomment define

    1512. 

  1512.              NO_OSSL_VERSION_CHECK in IcsLIBEAY.pas and rebuild all. Two new

    1513. 

  1513.              methods of TSslContext to ease verification of client certificates.

    1514. 

  1514.              They create/modify the list of acceptable CAs sent to the client

    1515. 

  1515.              when a server requests a client certificate, AddClientCAFromFile

    1516. 

  1516.              and SetClientCAListFromFile, see comments on top of the functions.

    1517. 

  1517.              SslOptions modified. SSLv3 renegotiaton added, there are two

    1518. 

  1518.              new functions SslStartRenegotiation and SslRenegotiatePending,

    1519. 

  1519.              see comments on top of the functions. When renegotiation is

    1520. 

  1520.              requested in server mode a new SslOption should be set also it's

    1521. 

  1521.              sslOpt_NO_SESSION_RESUMPTION_ON_RENEGOTIATION.

    1522. 

  1522. Dec 19, 2005 Angus new wsocket logging

    1523. 

  1523. Jan 18, 2006 Arno Garrels: A lot of bugs fixed probably alot of new added ;-)

    1524. 

  1524.              bidirectional shutdown added.

    1525. 

  1525. Jan 26, 2006 Type of TSslSessionIdContext changed to AnsiString due to problems

    1526. 

  1526.              with BCB.

    1527. 

  1527. Mar 02, 2006 Removed function SslStateToStr which was wrong and not used.

    1528. 

  1528.              Arno Garrels fixed TCustomSslWSocket.Do_FD_CLOSE

    1529. 

  1529. Mar 06, 2006 A. Garrels: Removed the so called fix from Mar 02 in Do_FD_CLOSE

    1530. 

  1530.              because it it wasn't a real fix. Instead several changes at

    1531. 

  1531.              several places were required to fix the shutdown problems. Fixed

    1532. 

  1532.              error "Undeclared identifier RaiseLastOpenSslError" when

    1533. 

  1533.              NO_DEBUG_LOG was defined. Added properties ValidNotBefore and

    1534. 

  1534.              ValidNotAfter to TX509Base.

    1535. 

  1535.              Multi-threading: OpenSSL library is thread safe as long as the

    1536. 

  1536.              application provides an appropriate locking callback. Implemented

    1537. 

  1537.              such callbacks as two components see unit IcsSslThrdLock.

    1538. 

  1538.              Changed InitContext to always set session cache options, because

    1539. 

  1539.              the default OpenSSL setting is to use the internal cache.

    1540. 

  1540. Jun 20, 2007 Changes by Arno Garrels: Fixed TX509Base.PostConnectionCheck to

    1541. 

  1541.              handle wildcard certificates. Property TX509Base.SubjectCName may

    1542. 

  1542.              now include a list of strings separated by CRLF (many certificates

    1543. 

  1543.              use multiple common name fields). Common name fields encoded 

    1544. 

  1544.              Unicode or UTF-8 are now converted to ansi string. New properties

    1545. 

  1545.              TX509Base.FirstVerifyResult and TX509Base.FirstVerifyErrMsg

    1546. 

  1546.              hold the first verify result, because a certificate may pass

    1547. 

  1547.              verification process several times which overwrites value of

    1548. 

  1548.              VerifyResult.

    1549. 

  1549. Nov 08, 2007 A. Garrels added property PublicKey to TX509Base.

    1550. 

  1550. 

    1551. 

  1551.  * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    1552. 

  1552. {$IFDEF VER80}

    1553. 

  1553.     Bomb('This unit require a 32 bit compiler !');

    1554. 

  1554. {$ENDIF}

    1555. 

  1555. {$B-}                                 { Enable partial boolean evaluation   }

    1556. 

  1556. {$T-}                                 { Untyped pointers                    }

    1557. 

  1557. {$X+}                                 { Enable extended syntax              }

    1558. 

  1558. {$H+}                                 { Use long strings                    }

    1559. 

  1559. {$J+}                                 { Allow typed constant to be modified }

    1560. 

  1560. {$IFDEF DEBUG_DUMP}

    1561. 

  1561.     {$DEFINE DEBUG_OUTPUT}

    1562. 

  1562. {$ENDIF}

    1563. 

  1563. const

    1564. 

  1564.      SslWSocketVersion            = 100;

    1565. 

  1565.      SslWSocketDate               = 'Jan 18, 2006';

    1566. 

  1566.      SslWSocketCopyRight : String = ' TSslWSocket (c) 2003-2010 Francois Piette V1.00.5e ';

    1567. 

  1567. 

    1568. 

  1568. const

    1569. 

  1569.      

    1570. 

  1570.      //SSL_POST_CONNECTION_CHECK_FAILED = 12101;

    1571. 

  1571.      sslProtocolError                 = 20100;

    1572. 

  1572.      SSL_BUFFER_SIZE                  = 4096;

    1573. 

  1573.      msgSslCtxNotInit                 = 'SSL context not initialized';

    1574. 

  1574. 

    1575. 

  1575. {$IFNDEF NO_SSL_MT}

    1576. 

  1576. var

    1577. 

  1577.      LockPwdCB          : TRtlCriticalSection;

    1578. 

  1578.      LockVerifyCB       : TRtlCriticalSection;

    1579. 

  1579.      LockInfoCB         : TRtlCriticalSection;

    1580. 

  1580.      LockRemSessCB      : TRtlCriticalSection;

    1581. 

  1581.      LockNewSessCB      : TRtlCriticalSection;

    1582. 

  1582.      LockGetSessCB      : TRtlCriticalSection;

    1583. 

  1583.      LockClientCertCB   : TRtlCriticalSection;

    1584. 

  1584.    {$IFNDEF OPENSSL_NO_TLSEXT}

    1585. 

  1585.      LockServerNameCB   : TRtlCriticalSection;

    1586. 

  1586.    {$ENDIF}

    1587. 

  1587. {$ENDIF}

    1588. 

  1588.      procedure UnloadSsl;

    1589. 

  1589.      procedure LoadSsl;

    1590. 

  1590. 

    1591. 

  1591. type

    1592. 

  1592. //    TSslDebugLevel = (ssldbgNone, ssldbgError, ssldbgInfo, ssldbgDump); angus

    1593. 

  1593. 

    1594. 

  1594.     EOpenSslError = class(Exception);

    1595. 

  1595.     TSslBaseComponent = class(TComponent)

    1596. 

  1596.     protected

    1597. 

  1597.         FSslInitialized : Boolean;

    1598. 

  1598.         FLastSslError   : Integer;

    1599. 

  1599. 

    1600. 

  1600.     {$IFNDEF NO_DEBUG_LOG}                                             { V5.21 }

    1601. 

  1601.         FIcsLogger  : TIcsLogger;

    1602. 

  1602.         procedure   SetIcsLogger(const Value : TIcsLogger); virtual;   { V5.21 }

    1603. 

  1603.         procedure   Notification(AComponent  : TComponent;             { V5.21 }

    1604. 

  1604.                                  Operation   : TOperation); override;

    1605. 

  1605.         procedure   DebugLog(LogOption : TLogOption;                   { V5.21 }

    1606. 

  1606.                              const Msg : string); virtual;

    1607. 

  1607.         function    CheckLogOptions(const LogOption: TLogOption): Boolean; virtual; { V5.21 }

    1608. 

  1608.     {$ENDIF}

    1609. 

  1609.         procedure   RaiseLastOpenSslError(EClass          : ExceptClass;

    1610. 

  1610.                                           Dump            : Boolean = FALSE;

    1611. 

  1611.                                           const CustomMsg : String  = ''); virtual;

    1612. 

  1612.         procedure   InitializeSsl; {$IFDEF USE_INLINE} inline; {$ENDIF}

    1613. 

  1613.         procedure   FinalizeSsl;

    1614. 

  1614.     public

    1615. 

  1615.         constructor Create(AOwner: TComponent); override;

    1616. 

  1616.         destructor  Destroy; override;

    1617. 

  1617.         property    LastSslError : Integer read FLastSslError;

    1618. 

  1618. {$IFNDEF NO_DEBUG_LOG}

    1619. 

  1619.     published

    1620. 

  1620.         property    IcsLogger : TIcsLogger                read  FIcsLogger    { V5.21 }

    1621. 

  1621.                                                           write SetIcsLogger;

    1622. 

  1622. {$ENDIF}

    1623. 

  1623.     end;

    1624. 

  1624.     (*

    1625. 

  1625.     TX509Stack = class(TObject) // Not yet used, but will be soon!

    1626. 

  1626.     private

    1627. 

  1627.         FStack : PSTACK;

    1628. 

  1628.         FCount : Integer;

    1629. 

  1629.     protected

    1630. 

  1630.         function    GetCert(Index : Integer): PX509;

    1631. 

  1631.         procedure   SetCert(Index : Integer; const Value : PX509);

    1632. 

  1632.         procedure   SetStack(const Value : PStack);

    1633. 

  1633.         function    InternalInsert(Cert : PX509; Index : Integer): Integer;

    1634. 

  1634.     public

    1635. 

  1635.         constructor Create;

    1636. 

  1636.         destructor  Destroy; override;

    1637. 

  1637.         function    Add(Cert : PX509): Integer;

    1638. 

  1638.         procedure   Clear;

    1639. 

  1639.         procedure   Insert(Cert : PX509; Index : Integer);

    1640. 

  1640.         function    IndexOf(Cert : PX509): Integer;

    1641. 

  1641.         procedure   Delete(Index : Integer);

    1642. 

  1642.         property    Count                   : Integer           read  FCount;

    1643. 

  1643.         property    Certs[index : Integer]  : PX509             read  GetCert

    1644. 

  1644.                                                                 write SetCert; default;

    1645. 

  1645.         property    Stack: PSTACK                               read  FStack

    1646. 

  1646.                                                                 write SetStack;

    1647. 

  1647.     end;

    1648. 

  1648.     *)

    1649. 

  1649. {$IFNDEF COMPILER6_UP}

    1650. 

  1650. const                                                             {AG 02/06/06}

    1651. 

  1651.     MinDateTime: TDateTime = -657434.0;      { 01/01/0100 12:00:00.000 AM }

    1652. 

  1652.     MaxDateTime: TDateTime =  2958465.99999; { 12/31/9999 11:59:59.999 PM }

    1653. 

  1653. {$ENDIF}

    1654. 

  1654. type

    1655. 

  1655.     EX509Exception = class(Exception);

    1656. 

  1656. 

    1657. 

  1657.     TExtension = record

    1658. 

  1658.         Critical  : Boolean;

    1659. 

  1659.         ShortName : String;

    1660. 

  1660.         Value     : String; // may be also one or multiple Name=value pairs,

    1661. 

  1661.     end;                    // separated by a CRLF

    1662. 

  1662.     PExtension = ^TExtension;

    1663. 

  1663. 

    1664. 

  1664.     TBioOpenMethode = (bomRead, bomWrite);

    1665. 

  1665.     TX509Base = class(TSslBaseComponent)

    1666. 

  1666.     private

    1667. 

  1667.         FX509               : Pointer;

    1668. 

  1668.         FPrivateKey         : Pointer;

    1669. 

  1669.     protected

    1670. 

  1670.         FVerifyResult       : Integer;  // current verify result

    1671. 

  1671.         FSha1Hash           : AnsiString;

    1672. 

  1672.         FVerifyDepth        : Integer;

    1673. 

  1673.         FCustomVerifyResult : Integer;

    1674. 

  1674.         FFirstVerifyResult  : Integer;                      {05/21/2007 AG}

    1675. 

  1675.         procedure   FreeAndNilX509;

    1676. 

  1676.         procedure   SetX509(X509: Pointer);

    1677. 

  1677.         procedure   SetPrivateKey(PKey: Pointer);

    1678. 

  1678.         function    GetPublicKey: Pointer;

    1679. 

  1679.         function    GetVerifyErrorMsg: String;

    1680. 

  1680.         function    GetFirstVerifyErrorMsg: String;         {05/21/2007 AG}

    1681. 

  1681.         function    GetIssuerOneLine: String;

    1682. 

  1682.         function    GetSubjectOneLine: String;

    1683. 

  1683.         function    GetSerialNum: Integer; virtual;

    1684. 

  1684.         function    GetSubjectCName: String;

    1685. 

  1685.         function    GetSubjectAltName: TExtension; virtual;

    1686. 

  1686.         function    GetExtension(Index: Integer): TExtension; virtual;

    1687. 

  1687.         function    GetExtensionCount: Integer;

    1688. 

  1688.         function    GetValidNotBefore: TDateTime;              {AG 02/06/06}

    1689. 

  1689.         function    GetValidNotAfter: TDateTime;               {AG 02/06/06}

    1690. 

  1690.         function    GetHasExpired: Boolean;                    {AG 02/06/06}

    1691. 

  1691.         procedure   AssignDefaults; virtual;

    1692. 

  1692.         function    UnknownExtDataToStr(Ext: PX509_Extension) : String;

    1693. 

  1693.         function    GetSha1Hash: AnsiString;

    1694. 

  1694.         function    OpenFileBio(const FileName  : String;

    1695. 

  1695.                                 Methode         : TBioOpenMethode): PBIO;

    1696. 

  1696.         procedure   ReadFromBio(ABio: PBIO; IncludePrivateKey: Boolean = FALSE;

    1697. 

  1697.                                 const Password: String = ''); virtual;

    1698. 

  1698.         procedure   WriteToBio(ABio: PBIO; IncludePrivateKey: Boolean = FALSE;

    1699. 

  1699.                                AddRawText: Boolean = FALSE); virtual;

    1700. 

  1700.     public

    1701. 

  1701.         constructor Create(AOwner: TComponent; X509: Pointer = nil); reintroduce;

    1702. 

  1702.         destructor  Destroy; override;

    1703. 

  1703.         function    ExtByName(const ShortName: String): Integer;

    1704. 

  1704.         function    PostConnectionCheck(HostOrIp: String): Boolean; virtual;

    1705. 

  1705.         function    GetRawText: String;                        {05/21/2007 AG}

    1706. 

  1706.         procedure   LoadFromPemFile(const FileName: String;

    1707. 

  1707.                                     IncludePrivateKey: Boolean = False;

    1708. 

  1708.                                     const Password: String = '');

    1709. 

  1709.         procedure   SaveToPemFile(const FileName: String;

    1710. 

  1710.                                   IncludePrivateKey: Boolean = FALSE;

    1711. 

  1711.                                   AddRawText: Boolean = FALSE);

    1712. 

  1712.         procedure   PrivateKeyLoadFromPemFile(const FileName: String;

    1713. 

  1713.                                               const Password: String = '');

    1714. 

  1714.         procedure   PrivateKeySaveToPemFile(const FileName: String);

    1715. 

  1715.         property    IssuerOneLine       : String        read  GetIssuerOneLine;

    1716. 

  1716.         property    SubjectOneLine      : String        read  GetSubjectOneLine;

    1717. 

  1717.         property    SerialNum           : Integer       read  GetSerialNum;

    1718. 

  1718.         property    VerifyResult        : Integer       read  FVerifyResult

    1719. 

  1719.                                                         write FVerifyResult;

    1720. 

  1720.         property    VerifyErrMsg        : String        read  GetVerifyErrorMsg;

    1721. 

  1721.         property    VerifyDepth         : Integer       read  FVerifyDepth

    1722. 

  1722.                                                         write FVerifyDepth;

    1723. 

  1723.         property    CustomVerifyResult  : Integer       read  FCustomVerifyResult

    1724. 

  1724.                                                         write FCustomVerifyResult;

    1725. 

  1725.         property    FirstVerifyResult   : Integer       read  FFirstVerifyResult {05/21/2007 AG}

    1726. 

  1726.                                                         write FFirstVerifyResult;

    1727. 

  1727.         property    FirstVerifyErrMsg   : String        read  GetFirstVerifyErrorMsg; {05/21/2007 AG}

    1728. 

  1728.         property    X509                : Pointer       read  FX509

    1729. 

  1729.                                                         write SetX509;

    1730. 

  1730.         property    PrivateKey          : Pointer       read  FPrivateKey

    1731. 

  1731.                                                         write SetPrivateKey;

    1732. 

  1732.         property    PublicKey           : Pointer       read  GetPublicKey;      {AG 11/08/07}

    1733. 

  1733.         property    SubjectCName        : String        read  GetSubjectCName;

    1734. 

  1734.         property    SubjectAltName      : TExtension    read  GetSubjectAltName;

    1735. 

  1735.         property    ExtensionCount      : Integer       read  GetExtensionCount;

    1736. 

  1736.         property    Extensions[index: Integer] : TExtension read GetExtension;

    1737. 

  1737.         property    Sha1Hash            : AnsiString    read  FSha1Hash;

    1738. 

  1738.         property    ValidNotBefore      : TDateTime     read  GetValidNotBefore; {AG 02/06/06}

    1739. 

  1739.         property    ValidNotAfter       : TDateTime     read  GetValidNotAfter;  {AG 02/06/06}

    1740. 

  1740.         property    HasExpired          : Boolean       read  GetHasexpired;     {AG 02/06/06}

    1741. 

  1741.     end;

    1742. 

  1742. 

    1743. 

  1743.     TX509Class = class of TX509Base;

    1744. 

  1744. 

    1745. 

  1745.     TCustomSslWSocket = class; //forward

    1746. 

  1746. 

    1747. 

  1747.     TX509List  = class(TObject)

    1748. 

  1748.     { Written by Arno Garrels, for ICS    }

    1749. 

  1749.     { Contact: email arno.garrels@gmx.de  }

    1750. 

  1750.     private

    1751. 

  1751.         FList               : TComponentList;

    1752. 

  1752.         FX509Class          : TX509Class;

    1753. 

  1753.         FOwner              : TComponent;

    1754. 

  1754.         FLastVerifyResult   : Integer;

    1755. 

  1755.     protected

    1756. 

  1756.         function    GetCount: Integer;

    1757. 

  1757.         function    GetX509Base(Index: Integer): TX509Base;

    1758. 

  1758.         procedure   SetX509Base(Index: Integer; Value: TX509Base);

    1759. 

  1759.         function    GetByPX509(const X509: PX509) : TX509Base;

    1760. 

  1760.     public

    1761. 

  1761.         constructor Create(AOwner: TComponent); reintroduce;

    1762. 

  1762.         destructor  Destroy; override;

    1763. 

  1763.         procedure   Clear;

    1764. 

  1764.         function    Add(X509 : PX509 = nil) : TX509Base;

    1765. 

  1765.         procedure   Delete(const Index: Integer);

    1766. 

  1766.         function    IndexOf(const X509Base : TX509Base): Integer;

    1767. 

  1767.         function    GetByHash(const Sha1Hash : AnsiString): TX509Base;

    1768. 

  1768.         property    Count                       : Integer       read  GetCount;

    1769. 

  1769.         property    Items[index: Integer]       : TX509Base     read  GetX509Base

    1770. 

  1770.                                                                 write SetX509Base; default;

    1771. 

  1771.         property    X509Class                   : TX509Class    read  FX509Class

    1772. 

  1772.                                                                 write FX509Class;

    1773. 

  1773.         property    LastVerifyResult            : Integer       read  FLastVerifyResult;

    1774. 

  1774.     end;

    1775. 

  1775. 

    1776. 

  1776.     TSslContextRemoveSession = procedure(Sender: TObject;

    1777. 

  1777.                                          SslSession : Pointer) of object;

    1778. 

  1778.     // SSL Version selection

    1779. 

  1779.     TSslVersionMethod = (sslV2,

    1780. 

  1780.                          sslV2_CLIENT,

    1781. 

  1781.                          sslV2_SERVER,

    1782. 

  1782.                          sslV3,

    1783. 

  1783.                          sslV3_CLIENT,

    1784. 

  1784.                          sslV3_SERVER,

    1785. 

  1785.                          sslTLS_V1,

    1786. 

  1786.                          sslTLS_V1_CLIENT,

    1787. 

  1787.                          sslTLS_V1_SERVER,

    1788. 

  1788.                          sslV23,

    1789. 

  1789.                          sslV23_CLIENT,

    1790. 

  1790.                          sslV23_SERVER);

    1791. 

  1791. 

    1792. 

  1792.     TSslVerifyPeerMode = (SslVerifyMode_NONE,

    1793. 

  1793.                           SslVerifyMode_PEER,

    1794. 

  1794.                           SslVerifyMode_FAIL_IF_NO_PEER_CERT,

    1795. 

  1795.                           SslVerifyMode_CLIENT_ONCE);

    1796. 

  1796.     TSslVerifyPeerModes = set of TSslVerifyPeerMode;

    1797. 

  1797. 

    1798. 

  1798.     TSslOption  = (sslOpt_CIPHER_SERVER_PREFERENCE,

    1799. 

  1799.                    sslOpt_MICROSOFT_SESS_ID_BUG,

    1800. 

  1800.                    sslOpt_NETSCAPE_CHALLENGE_BUG,

    1801. 

  1801.                    sslOpt_NETSCAPE_REUSE_CIPHER_CHANGE_BUG,

    1802. 

  1802.                    sslOpt_SSLREF2_REUSE_CERT_TYPE_BUG,

    1803. 

  1803.                    sslOpt_MICROSOFT_BIG_SSLV3_BUFFER,

    1804. 

  1804.                    sslOpt_MSIE_SSLV2_RSA_PADDING,

    1805. 

  1805.                    sslOpt_SSLEAY_080_CLIENT_DH_BUG,

    1806. 

  1806.                    sslOpt_TLS_D5_BUG,

    1807. 

  1807.                    sslOpt_TLS_BLOCK_PADDING_BUG,

    1808. 

  1808.                    sslOpt_TLS_ROLLBACK_BUG,

    1809. 

  1809.                    sslOpt_DONT_INSERT_EMPTY_FRAGMENTS,

    1810. 

  1810.                    sslOpt_SINGLE_DH_USE,

    1811. 

  1811.                    sslOpt_EPHEMERAL_RSA,

    1812. 

  1812.                    sslOpt_NO_SSLv2,

    1813. 

  1813.                    sslOpt_NO_SSLv3,

    1814. 

  1814.                    sslOpt_NO_TLSv1,

    1815. 

  1815.                    sslOpt_PKCS1_CHECK_1,

    1816. 

  1816.                    sslOpt_PKCS1_CHECK_2,

    1817. 

  1817.                    sslOpt_NETSCAPE_CA_DN_BUG,

    1818. 

  1818.                    //sslOP_NO_TICKET,

    1819. 

  1819.                    sslOpt_NO_SESSION_RESUMPTION_ON_RENEGOTIATION, // 12/09/05

    1820. 

  1820.                    sslOpt_NETSCAPE_DEMO_CIPHER_CHANGE_BUG,

    1821. 

  1821.                    sslOpt_ALLOW_UNSAFE_LEGACY_RENEGOTIATION);  // Since OSSL 0.9.8n

    1822. 

  1822.     TSslOptions = set of TSslOption;

    1823. 

  1823. 

    1824. 

  1824.     TSslSessCacheMode = (//sslSESS_CACHE_OFF,

    1825. 

  1825.                          sslSESS_CACHE_CLIENT,

    1826. 

  1826.                          sslSESS_CACHE_SERVER,

    1827. 

  1827.                          //sslSESS_CACHE_BOTH,

    1828. 

  1828.                          sslSESS_CACHE_NO_AUTO_CLEAR,

    1829. 

  1829.                          sslSESS_CACHE_NO_INTERNAL_LOOKUP,

    1830. 

  1830.                          sslSESS_CACHE_NO_INTERNAL_STORE{,

    1831. 

  1831.                          sslSESS_CACHE_NO_INTERNAL});

    1832. 

  1832.     TSslSessCacheModes = set of TSslSessCacheMode;

    1833. 

  1833. 

    1834. 

  1834.     TSslSessionIdContext = String;//[SSL_MAX_SSL_SESSION_ID_LENGTH];

    1835. 

  1835. 

    1836. 

  1836.     {

    1837. 

  1837.     TSslX509Trust = (ssl_X509_TRUST_NOT_DEFINED, // Custom value

    1838. 

  1838.                      ssl_X509_TRUST_COMPAT,

    1839. 

  1839.                      ssl_X509_TRUST_SSL_CLIENT,

    1840. 

  1840.                      ssl_X509_TRUST_SSL_SERVER,

    1841. 

  1841.                      ssl_X509_TRUST_EMAIL,

    1842. 

  1842.                      ssl_X509_TRUST_OBJECT_SIGN,

    1843. 

  1843.                      ssl_X509_TRUST_OCSP_SIGN,

    1844. 

  1844.                      ssl_X509_TRUST_OCSP_REQUEST); }

    1845. 

  1845. 

    1846. 

  1846. {$IFNDEF OPENSSL_NO_ENGINE}

    1847. 

  1847.     ESslEngineError = class(Exception);

    1848. 

  1848.     TSslEngineState = (esClosed, esOpen, esInit);

    1849. 

  1849.     TSslEngineCtxCapabilities = set of (eccLoadPrivKey, eccLoadPubKey{, eccLoadClientCert});

    1850. 

  1850.     TSslEngine = class(TSslBaseComponent)

    1851. 

  1851.     private

    1852. 

  1852.         FEngine           : PEngine;

    1853. 

  1853.         FNameID           : String;

    1854. 

  1854.         FState            : TSslEngineState;

    1855. 

  1855.         FCtxCapabilities  : TSslEngineCtxCapabilities;

    1856. 

  1856.         FLastErrorMsg     : String;

    1857. 

  1857.         FKeyID            : String;

    1858. 

  1858.         procedure SetNameID(const Value: String);

    1859. 

  1859.     public

    1860. 

  1860.         destructor Destroy; override;

    1861. 

  1861.         function  Open: Boolean;

    1862. 

  1862.         function  Control(const Cmd, Arg: String): Boolean;

    1863. 

  1863.         procedure Close;

    1864. 

  1864.         function  Init: Boolean;

    1865. 

  1865.         property  E : PEngine read FEngine;

    1866. 

  1866.         property  State : TSslEngineState read FState;

    1867. 

  1867.         property  LastErrorMsg : String read FLastErrorMsg write FLastErrorMsg;

    1868. 

  1868.     published

    1869. 

  1869.         property  KeyID : String read FKeyID write FKeyID;

    1870. 

  1870.         property  NameID : String read FNameID write SetNameID;

    1871. 

  1871.         property  CtxCapabilities : TSslEngineCtxCapabilities read FCtxCapabilities write FCtxCapabilities;

    1872. 

  1872.     end;

    1873. 

  1873. {$ENDIF}

    1874. 

  1874. 

    1875. 

  1875.     ESslContextException = class(Exception);

    1876. 

  1876. 

    1877. 

  1877.     TInfoExtractMode = (emCert, {emKey,} emCRL);

    1878. 

  1878.     // TSslCertKeyFormat = (ckfPem {$IFNDEF OPENSSL_NO_ENGINE}, ckfEngine {$ENDIF}); {ckfPkcs12,}

    1879. 

  1879.     TSslContext = class(TSslBaseComponent)

    1880. 

  1880.     protected

    1881. 

  1881.         FSslCtx                     : PSSL_CTX;

    1882. 

  1882.         FSslVersionMethod           : TSslVersionMethod;

    1883. 

  1883.         FSslCertFile                : String;

    1884. 

  1884.         FSslPassPhrase              : String;

    1885. 

  1885.         FSslPrivKeyFile             : String;

    1886. 

  1886.         FSslCAFile                  : String;

    1887. 

  1887.         FSslCAPath                  : String;

    1888. 

  1888.         FSslCRLFile                 : String;

    1889. 

  1889.         FSslCRLPath                 : String;

    1890. 

  1890.         //FSslIntermCAFile            : String;

    1891. 

  1891.         //FSslIntermCAPath            : String;

    1892. 

  1892.         FSslVerifyPeer              : Boolean;

    1893. 

  1893.         FSslVerifyDepth             : Integer;

    1894. 

  1894.         FSslOptionsValue            : Longint;

    1895. 

  1895.         FSslCipherList              : String;

    1896. 

  1896.         FSslSessCacheModeValue      : Longint;

    1897. 

  1897.         FSslSessionCacheSize        : Longint;

    1898. 

  1898.         FSslSessionTimeout          : Longword;

    1899. 

  1899.         FSslDefaultSessionIDContext : TSslSessionIdContext;

    1900. 

  1900.         FOnRemoveSession            : TSslContextRemoveSession;

    1901. 

  1901.         FSslVerifyPeerModes         : TSslVerifyPeerModes;

    1902. 

  1902.         FSslVerifyPeerModesValue    : Integer;

    1903. 

  1903.         //FSslX509Trust               : TSslX509Trust;

    1904. 

  1904.         FOnBeforeInit               : TNotifyEvent;

    1905. 

  1905.         //FSslKeyFormat             : TSslCertKeyFormat;

    1906. 

  1906.     {$IFNDEF OPENSSL_NO_ENGINE}

    1907. 

  1907.         FAutoEnableBuiltinEngines   : Boolean;

    1908. 

  1908.         FCtxEngine                  : TSslEngine;

    1909. 

  1909.     {$ENDIF}

    1910. 

  1910. {$IFNDEF NO_SSL_MT}

    1911. 

  1911.         FLock                       : TRtlCriticalSection;

    1912. 

  1912.         procedure Lock;

    1913. 

  1913.         procedure Unlock;

    1914. 

  1914. {$ENDIF}

    1915. 

  1915.         function  InitializeCtx : PSSL_CTX;

    1916. 

  1916.         procedure SetSslCertFile(const Value : String);

    1917. 

  1917.         procedure SetSslPassPhrase(const Value : String);

    1918. 

  1918.         procedure SetSslPrivKeyFile(const Value : String);

    1919. 

  1919.         procedure SetSslCAFile(const Value : String);

    1920. 

  1920.         procedure SetSslCAPath(const Value : String);

    1921. 

  1921.         procedure SetSslCRLFile(const Value : String);

    1922. 

  1922.         procedure SetSslCRLPath(const Value : String);

    1923. 

  1923.         procedure SetSslSessionCacheSize(Value : Longint);

    1924. 

  1924.         procedure SetSslOptions(Value : TSslOptions);

    1925. 

  1925.         function  GetSslOptions : TSslOptions;

    1926. 

  1926.         procedure SetSslSessCacheModes(Value : TSslSessCacheModes);

    1927. 

  1927.         function  GetSslSessCacheModes : TSslSessCacheModes;

    1928. 

  1928.         procedure SetSslCipherList(const Value : String);

    1929. 

  1929.         procedure SetSslVerifyPeerModes(const Value : TSslVerifyPeerModes);

    1930. 

  1930.         procedure SetSslVerifyPeer(const Value: Boolean);

    1931. 

  1931.         procedure SetSslDefaultSessionIDContext(Value: TSslSessionIdContext);

    1932. 

  1932.         procedure SetSslSessionTimeout(Value : Longword);

    1933. 

  1933.         procedure SetSslVersionMethod(Value : TSslVersionMethod);

    1934. 

  1934.         function  OpenFileBio(const FileName : String;

    1935. 

  1935.             Methode : TBioOpenMethode): PBIO;

    1936. 

  1936.         function  LoadStackFromInfoFile(const FileName : String;

    1937. 

  1937.             Mode : TInfoExtractMode): PStack;

    1938. 

  1938.         procedure LoadVerifyLocations(const CAFile, CAPath: String);

    1939. 

  1939.         procedure LoadCertFromChainFile(const FileName : String);

    1940. 

  1940.         procedure LoadPKeyFromFile(const FileName : String);

    1941. 

  1941.         //procedure DebugLogInfo(const Msg: string);        { V5.21 }

    1942. 

  1942.         //procedure SetSslX509Trust(const Value: TSslX509Trust);

    1943. 

  1943.         function  GetIsCtxInitialized : Boolean;

    1944. 

  1944.     {$IFNDEF OPENSSL_NO_ENGINE}

    1945. 

  1945.         procedure Notification(AComponent: TComponent; Operation: TOperation); override;

    1946. 

  1946.         procedure SetCtxEngine(const Value: TSslEngine);

    1947. 

  1947.     {$ENDIF}

    1948. 

  1948.     public

    1949. 

  1949.         constructor Create(AOwner: TComponent); override;

    1950. 

  1950.         destructor  Destroy; override;

    1951. 

  1951.         procedure   InitContext;

    1952. 

  1952.         procedure   DeInitContext;

    1953. 

  1953.         function    TrustCert(Cert : TX509Base): Boolean;

    1954. 

  1954.         procedure   LoadCrlFromFile(const Filename: String);

    1955. 

  1955.         procedure   LoadCrlFromPath(const Path: String);

    1956. 

  1956.     {$IFNDEF OPENSSL_NO_ENGINE}

    1957. 

  1957.         procedure   LoadPKeyFromEngine(CtxEngine: TSslEngine);

    1958. 

  1958.         //function    SetupEngine(Engine: String; Commands: TStrings): PENGINE;

    1959. 

  1959.     {$ENDIF}

    1960. 

  1960.         procedure   AddClientCAFromFile(const FileName: String);

    1961. 

  1961.         procedure   SetClientCAListFromFile(const FileName: String);

    1962. 

  1962.         property    IsCtxInitialized : Boolean read GetIsCtxInitialized;

    1963. 

  1963.     published

    1964. 

  1964.         property  SslCertFile       : String            read  FSslCertFile

    1965. 

  1965.                                                         write SetSslCertFile;

    1966. 

  1966.         property  SslPassPhrase     : String            read  FSslPassPhrase

    1967. 

  1967.                                                         write SetSslPassPhrase;

    1968. 

  1968.         property  SslPrivKeyFile    : String            read  FSslPrivKeyFile

    1969. 

  1969.                                                         write SetSslPrivKeyFile;

    1970. 

  1970.         property  SslCAFile         : String            read  FSslCAFile

    1971. 

  1971.                                                         write SetSslCAFile;

    1972. 

  1972.         property  SslCAPath         : String            read  FSslCAPath

    1973. 

  1973.                                                         write SetSslCAPath;

    1974. 

  1974.         property  SslCRLFile        : String            read  FSslCRLFile

    1975. 

  1975.                                                         write SetSslCRLFile;

    1976. 

  1976.         property  SslCRLPath        : String            read  FSslCRLPath

    1977. 

  1977.                                                         write SetSslCRLPath;

    1978. 

  1978.         {property  SslIntermCAFile   : String            read  FSslIntermCAFile

    1979. 

  1979.                                                         write FSslIntermCAFile;

    1980. 

  1980.         property  SslIntermCAPath    : String           read  FSslIntermCAPath

    1981. 

  1981.                                                         write FSslIntermCAPath;}

    1982. 

  1982.         property  SslVerifyPeer     : Boolean           read  FSslVerifyPeer

    1983. 

  1983.                                                         write SetSslVerifyPeer;

    1984. 

  1984.         property  SslVerifyDepth    : Integer           read  FSslVerifyDepth

    1985. 

  1985.                                                         write FSslVerifyDepth;

    1986. 

  1986.         property  SslOptions        : TSslOptions       read  GetSslOptions

    1987. 

  1987.                                                         write SetSslOptions;

    1988. 

  1988.         property  SslVerifyPeerModes : TSslVerifyPeerModes

    1989. 

  1989.                                                     read  FSslVerifyPeerModes

    1990. 

  1990.                                                     write SetSslVerifyPeerModes;

    1991. 

  1991.         property  SslSessionCacheModes : TSslSessCacheModes

    1992. 

  1992.                                                     read  GetSslSessCacheModes

    1993. 

  1993.                                                     write SetSslSessCacheModes;

    1994. 

  1994.         property  SslCipherList     : String        read  FSslCipherList

    1995. 

  1995.                                                     write SetSslCipherList;

    1996. 

  1996.         property  SslVersionMethod  : TSslVersionMethod

    1997. 

  1997.                                                     read  FSslVersionMethod

    1998. 

  1998.                                                     write SetSslVersionMethod;

    1999. 

  1999.         property  SslSessionTimeout : Longword      read  FSslSessionTimeout

    2000. 

  2000.                                                     write SetSslSessionTimeout;

    2001. 

  2001.         property  SslSessionCacheSize : Integer

    2002. 

  2002.                                                     read  FSslSessionCacheSize

    2003. 

  2003.                                                     write SetSslSessionCacheSize;

    2004. 

  2004.         property  SslDefaultSessionIDContext : TSslSessionIdContext

    2005. 

  2005.                                                 read  FSslDefaultSessionIDContext

    2006. 

  2006.                                                 write SetSslDefaultSessionIDContext;

    2007. 

  2007.         {property  SslX509Trust      : TSslX509Trust         read  FSslX509Trust

    2008. 

  2008.                                                             write SetSslX509Trust;}

    2009. 

  2009.         property  OnRemoveSession   : TSslContextRemoveSession

    2010. 

  2010.                                                     read  FOnRemoveSession

    2011. 

  2011.                                                     write FOnRemoveSession;

    2012. 

  2012.         property  OnBeforeInit  : TNotifyEvent      read  FOnBeforeInit

    2013. 

  2013.                                                     write FOnBeforeInit;

    2014. 

  2014.         {property  SslKeyFormat : TSslCertKeyFormat

    2015. 

  2015.                                                      read  FSslKeyFormat

    2016. 

  2016.                                                      write FSslKeyFormat;}

    2017. 

  2017.     {$IFNDEF OPENSSL_NO_ENGINE}

    2018. 

  2018.         property  AutoEnableBuiltinEngines : Boolean read  FAutoEnableBuiltinEngines

    2019. 

  2019.                                                      write FAutoEnableBuiltinEngines;

    2020. 

  2020.         property  CtxEngine : TSslEngine read FCtxEngine write SetCtxEngine;                                             

    2021. 

  2021.     {$ENDIF}

    2022. 

  2022.     end;

    2023. 

  2023. 

    2024. 

  2024.     {TSslState = (sslNone,

    2025. 

  2025.                  sslWantConnect,

    2026. 

  2026.                  sslConnectWantRead,

    2027. 

  2027.                  sslConnectWantWrite,

    2028. 

  2028.                  sslConnected,

    2029. 

  2029.                  sslAccepted,

    2030. 

  2030.                  sslAcceptWantRead,

    2031. 

  2031.                  sslAcceptWantWrite,

    2032. 

  2032.                  sslWriteWantRead,

    2033. 

  2033.                  sslWriteWantWrite,

    2034. 

  2034.                  sslShutdown,

    2035. 

  2035.                  sslShutdownWantRead,

    2036. 

  2036.                  sslShutdownWantWrite);

    2037. 

  2037.      }

    2038. 

  2038. 

    2039. 

  2039.     TSslState = (sslNone,  // Not yet finished, Francois, could you care about states ??

    2040. 

  2040.                  sslHandshakeInit,

    2041. 

  2041.                  sslHandshakeStarted,

    2042. 

  2042.                  sslHandshakeFailed,

    2043. 

  2043.                  sslEstablished,

    2044. 

  2044.                  sslInShutdown,

    2045. 

  2045.                  sslShutdownComplete);

    2046. 

  2046. 

    2047. 

  2047.   TSslVerifyPeerEvent = procedure (Sender    : TObject;

    2048. 

  2048.                                    var Ok    : Integer;

    2049. 

  2049.                                    Cert      : TX509Base) of object;

    2050. 

  2050.   TSslHandshakeDoneEvent = procedure (Sender            : TObject;

    2051. 

  2051.                                       ErrCode           : Word;

    2052. 

  2052.                                       PeerCert          : TX509Base;

    2053. 

  2053.                                       var Disconnect    : Boolean) of object;

    2054. 

  2054.   TSslEvent = (sslFdRead, sslFdWrite, sslFdClose);

    2055. 

  2055.   TSslPendingEvents = set of TSslEvent;

    2056. 

  2056.   TSslMode  = (sslModeClient, sslModeServer);

    2057. 

  2057.   //Client-side session caching

    2058. 

  2058.   TSslCliGetSession         = procedure(Sender          : TObject;

    2059. 

  2059.                                         var SslSession  : Pointer;

    2060. 

  2060.                                         var FreeSession : Boolean) of object;

    2061. 

  2061.   TSslCliNewSession         = procedure(Sender          : TObject;

    2062. 

  2062.                                         SslSession      : Pointer;

    2063. 

  2063.                                         WasReused       : Boolean;

    2064. 

  2064.                                         var IncRefCount : Boolean) of object;

    2065. 

  2065. 

    2066. 

  2066.   //Server-side session caching

    2067. 

  2067.   TSslSetSessionIDContext   = procedure(Sender                  : TObject;

    2068. 

  2068.                                         var SessionIDContext    : TSslSessionIdContext) of object;

    2069. 

  2069.   TSslSvrNewSession         = procedure(Sender                  : TObject;

    2070. 

  2070.                                         SslSession              : Pointer;

    2071. 

  2071.                                         SessId                  : Pointer;

    2072. 

  2072.                                         Idlen                   : Integer;

    2073. 

  2073.                                         var AddToInternalCache  : Boolean) of object;

    2074. 

  2074.   TSslSvrGetSession         = procedure(Sender                  : TObject;

    2075. 

  2075.                                         var SslSession          : Pointer;

    2076. 

  2076.                                         SessId                  : Pointer;

    2077. 

  2077.                                         Idlen                   : Integer;

    2078. 

  2078.                                         var IncRefCount         : Boolean) of object;

    2079. 

  2079. 

    2080. 

  2080.   TSslCliCertRequest        = procedure(Sender     : TObject;

    2081. 

  2081.                                         var Cert   : TX509Base) of object;

    2082. 

  2082.   TSslShutDownComplete      = procedure(Sender          : TObject;

    2083. 

  2083.                                         Bidirectional   : Boolean;

    2084. 

  2084.                                         ErrCode         : Integer) of object;

    2085. 

  2085. {$IFNDEF OPENSSL_NO_TLSEXT}

    2086. 

  2086.   TTlsExtError = (teeOk, teeAlertWarning, teeAlertFatal, teeNoAck);

    2087. 

  2087. {

    2088. 

  2088.   SSL_TLSEXT_ERR_OK                           = 0;

    2089. 

  2089.   SSL_TLSEXT_ERR_ALERT_WARNING                = 1;

    2090. 

  2090.   SSL_TLSEXT_ERR_ALERT_FATAL                  = 2;

    2091. 

  2091.   SSL_TLSEXT_ERR_NOACK                        = 3;

    2092. 

  2092. }

    2093. 

  2093.   TSslServerNameEvent       = procedure(Sender               : TObject;                                        

    2094. 

  2094.                                         var Ctx              : TSslContext;

    2095. 

  2095.                                         var ErrCode          : TTlsExtError) of object;

    2096. 

  2096. {$ENDIF}

    2097. 

  2097. 

    2098. 

  2098.   TCustomSslWSocket = class(TCustomSocksWSocket)

    2099. 

  2099.   protected

    2100. 

  2100.         FSslContext                 : TSslContext;

    2101. 

  2101.         FOnSslSvrNewSession         : TSslSvrNewSession;

    2102. 

  2102.         FOnSslSvrGetSession         : TSslSvrGetSession;

    2103. 

  2103.         FOnSslCliGetSession         : TSslCliGetSession;

    2104. 

  2104.         FOnSslCliNewSession         : TSslCliNewSession;

    2105. 

  2105.         FOnSslSetSessionIDContext   : TSslSetSessionIDContext;

    2106. 

  2106.     {$IFNDEF OPENSSL_NO_TLSEXT}

    2107. 

  2107.         FOnSslServerName            : TSslServerNameEvent;

    2108. 

  2108.     {$ENDIF}

    2109. 

  2109.         FOnSslCliCertRequest        : TSslCliCertRequest;

    2110. 

  2110.         FX509Class                  : TX509Class;

    2111. 

  2111.         FSslCertChain               : TX509List;

    2112. 

  2112.         FSslMode                    : TSslMode;

    2113. 

  2113.         //FTriggerCount               : Integer; //Test

    2114. 

  2114.         FSslBufList                 : TIcsBufferHandler;

    2115. 

  2115.         FExplizitSsl                : Boolean;

    2116. 

  2116.         bSslAllSent                 : Boolean;

    2117. 

  2117.         FMayTriggerFD_Read          : Boolean;

    2118. 

  2118.         FMayTriggerFD_Write         : Boolean;

    2119. 

  2119.         FMayTriggerDoRecv           : Boolean;

    2120. 

  2120.         FMayTriggerSslTryToSend     : Boolean;

    2121. 

  2121.         //FHandShakeDoneInvoked       : Boolean;

    2122. 

  2122.         FCloseCalled                : Boolean;

    2123. 

  2123.         //FCloseReceived              : Boolean;

    2124. 

  2124.         FPendingSslEvents           : TSslPendingEvents;

    2125. 

  2125.         FSslIntShutDown             : Integer;

    2126. 

  2126.         FShutDownHow                : Integer;

    2127. 

  2127.         FSslEnable                  : Boolean;

    2128. 

  2128.         //FSslEstablished           : Boolean;

    2129. 

  2129.         FLastSslError               : Integer;

    2130. 

  2130.         FSslInRenegotiation         : Boolean;    // <= 01/01/06

    2131. 

  2131.         FSslBioWritePendingBytes    : Integer;

    2132. 

  2132.         FSendPending                : Boolean;

    2133. 

  2133.         FSslBiShutDownFlag          : Boolean;    // <= 01/08/06

    2134. 

  2134.         FOnSslShutDownComplete      : TSslShutDownComplete;

    2135. 

  2135.         FNetworkError               : Integer;

    2136. 

  2136.         FSslInitialized             : Boolean;

    2137. 

  2137.         FInHandshake                : Boolean;

    2138. 

  2138.         FHandshakeDone              : Boolean;

    2139. 

  2139.         FSslVersNum                 : Integer;        //12/09/05

    2140. 

  2140.         FSSLState                   : TSslState;

    2141. 

  2141.         FSsl_In_CB                  : Boolean;

    2142. 

  2142.         FSsl                        : PSSL;

    2143. 

  2143.         FSslBio                     : PBIO;

    2144. 

  2144.         FIBio                       : PBIO;

    2145. 

  2145.         FNBio                       : PBIO;

    2146. 

  2146.         FSslAcceptableHosts         : TStrings;

    2147. 

  2147.         FSslVerifyResult            : Integer;

    2148. 

  2148.         FSslVersion                 : String;

    2149. 

  2149.         FSslCipher                  : String;

    2150. 

  2150.         FSslTotalBits               : Integer;

    2151. 

  2151.         FSslSecretBits              : Integer;

    2152. 

  2152.         FSslSupportsSecureRenegotiation : Boolean;

    2153. 

  2153.         FMsg_WM_TRIGGER_DATASENT    : UINT;

    2154. 

  2154.         FMsg_WM_SSL_ASYNCSELECT     : UINT;

    2155. 

  2155.         FMsg_WM_RESET_SSL           : UINT;

    2156. 

  2156.         FMsg_WM_BI_SSL_SHUTDOWN     : UINT;

    2157. 

  2157.         FMsg_WM_TRIGGER_SSL_SHUTDOWN_COMPLETED : UINT;

    2158. 

  2158.         FOnSslVerifyPeer            : TSslVerifyPeerEvent;

    2159. 

  2159.         FOnSslHandshakeDone         : TSslHandshakeDoneEvent;

    2160. 

  2160.         FHandShakeCount             : Integer;

    2161. 

  2161.     {$IFNDEF OPENSSL_NO_TLSEXT}

    2162. 

  2162.         FSslServerName              : String;

    2163. 

  2163.     {$ENDIF}

    2164. 

  2164.         //procedure   SetSslEnable(const Value: Boolean); virtual;

    2165. 

  2165.         procedure   RaiseLastOpenSslError(EClass          : ExceptClass;

    2166. 

  2166.                                           Dump            : Boolean = FALSE;

    2167. 

  2167.                                           const CustomMsg : String  = ''); virtual;

    2168. 

  2168.         function  SocketDataPending : Boolean;

    2169. 

  2169.         procedure InternalShutdown(How: Integer);

    2170. 

  2170.         procedure PutDataInSslBuffer(Data: Pointer; Len: Integer);

    2171. 

  2171.         procedure DeleteBufferedSslData;

    2172. 

  2172.         function  GetRcvdCount : LongInt; override;

    2173. 

  2173.         procedure WMSslBiShutDown(var msg: TMessage);

    2174. 

  2174.         procedure WMSslASyncSelect(var msg: TMessage);

    2175. 

  2175.         procedure WMTriggerSslShutDownComplete(var msg: TMessage);

    2176. 

  2176.         procedure Do_SSL_FD_READ(var Msg: TMessage);

    2177. 

  2177.         function  TriggerEvent(Event: TSslEvent; ErrCode: Word): Boolean;

    2178. 

  2178. 

    2179. 

  2179.         procedure AssignDefaultValue; override;

    2180. 

  2180.         procedure Do_FD_CONNECT(var Msg : TMessage); override;

    2181. 

  2181.         procedure Do_FD_READ(var Msg : TMessage); override;

    2182. 

  2182.         procedure Do_FD_WRITE(var Msg : TMessage); override;

    2183. 

  2183.         procedure Do_FD_CLOSE(var Msg : TMessage); override;

    2184. 

  2184.         procedure Do_FD_ACCEPT(var Msg : TMessage); override;

    2185. 

  2185.         //procedure WMSslHandshakeDone(var msg: TMessage); message WM_TRIGGER_SSLHANDSHAKEDONE;

    2186. 

  2186.         function  SslShutdownCompleted(How: Integer) : Boolean;

    2187. 

  2187.         function  DoRecv(var Buffer : TWSocketData;

    2188. 

  2188.                          BufferSize : Integer;

    2189. 

  2189.                          Flags      : Integer) : Integer; override;

    2190. 

  2190.         procedure TryToSend; override;

    2191. 

  2191.         procedure InitializeSsl;

    2192. 

  2192.         procedure FinalizeSsl;

    2193. 

  2193.         procedure InitSSLConnection(ClientMode : Boolean; pSSLContext : PSSL_CTX = nil);

    2194. 

  2194.         //function  LoadCertificate(out ErrMsg : String) : Boolean;

    2195. 

  2195.         procedure DupConnected; override;

    2196. 

  2196.         procedure InternalClose(bShut : Boolean; Error : Word); override;

    2197. 

  2197.         procedure InternalAbort(ErrCode : Word); override;

    2198. 

  2198.         procedure WndProc(var MsgRec: TMessage); override;

    2199. 

  2199.         procedure SetSslAcceptableHosts(Value : TStrings);

    2200. 

  2200.         procedure TriggerEvents;

    2201. 

  2201.         procedure TriggerSessionConnected(ErrCode : Word); override;

    2202. 

  2202.         procedure TriggerSslHandshakeDone(ErrCode : Word); virtual;

    2203. 

  2203.         procedure TriggerSslVerifyPeer(var Ok     : Integer;

    2204. 

  2204.                                        Cert       : TX509Base); virtual;

    2205. 

  2205.         procedure TriggerSslCliNewSession; virtual;

    2206. 

  2206.         procedure SetSslContext(const Value: TSslContext);

    2207. 

  2207.         procedure Notification(AComponent: TComponent; Operation: TOperation); override;

    2208. 

  2208.         procedure TriggerSslShutDownComplete(ErrCode: Integer); virtual;

    2209. 

  2209.         function  MsgHandlersCount : Integer; override;

    2210. 

  2210.         procedure AllocateMsgHandlers; override;

    2211. 

  2211.         procedure FreeMsgHandlers; override;

    2212. 

  2212.         property  X509Class : TX509Class read FX509Class write FX509Class;

    2213. 

  2213.     public

    2214. 

  2214.         constructor Create(AOwner : TComponent); override;

    2215. 

  2215.         destructor  Destroy; override;

    2216. 

  2216.         procedure   ResetSSL;

    2217. 

  2217.         procedure   Listen; override;

    2218. 

  2218.         function    Accept : TSocket; override;

    2219. 

  2219.         procedure   Close; override;

    2220. 

  2220.         procedure   Dup(NewHSocket: Integer); override;

    2221. 

  2221.         procedure   ThreadAttach; override;

    2222. 

  2222.         procedure   Resume; override;

    2223. 

  2223.         //procedure DoSslShutdown;

    2224. 

  2224.         procedure   ResetSslDelayed;

    2225. 

  2225.         procedure   SslBiShutDownAsync;

    2226. 

  2226.         function    SslStartRenegotiation : Boolean;

    2227. 

  2227.         function    SslRenegotiatePending : Boolean;

    2228. 

  2228.         function    SslSessionReused : Boolean;

    2229. 

  2229.         procedure   Shutdown(How : Integer); override;

    2230. 

  2230.         procedure   PutDataInSendBuffer(Data : TWSocketData; Len : Integer); override;

    2231. 

  2231.         procedure   StartSslHandshake;

    2232. 

  2232.         procedure   AcceptSslHandshake;

    2233. 

  2233.         procedure   SetAcceptableHostsList(const SemiColonSeparatedList : String);

    2234. 

  2234. 

    2235. 

  2235.         property    LastSslError       : Integer          read FLastSslError;

    2236. 

  2236.         property    ExplizitSsl        : Boolean          read  FExplizitSsl

    2237. 

  2237.                                                           write FExplizitSsl;

    2238. 

  2238.     {$IFNDEF OPENSSL_NO_TLSEXT}

    2239. 

  2239.         property    SslServerName      : String           read  FSslServerName

    2240. 

  2240.                                                           write FSslServerName;

    2241. 

  2241.     {$ENDIF}

    2242. 

  2242.         property  OnSslShutDownComplete : TSslShutDownComplete

    2243. 

  2243.                                                read   FOnSslShutDownComplete

    2244. 

  2244.                                                write  FOnSslShutDownComplete;

    2245. 

  2245.         property  SSL                :  PSsl              read  FSsl;

    2246. 

  2246.                                                           //write FSsl;

    2247. 

  2247.         property  SslInRenegotiation : Boolean            read  FSslInRenegotiation; //<= 01/01/06 AG

    2248. 

  2248.         property  SslEnable          : Boolean            read  FSslEnable

    2249. 

  2249.                                                           write FSslEnable;

    2250. 

  2250.         //property  SslEstablished      : Boolean           read  FSslEstablished;

    2251. 

  2251.         property  SslState            : TSslState         read  FSslState;

    2252. 

  2252.         property  SslContext          : TSslContext       read  FSslContext

    2253. 

  2253.                                                           write SetSslContext;

    2254. 

  2254.         property  SslCertChain        : TX509List         read  FSslCertChain;

    2255. 

  2255. 

    2256. 

  2256.         property  OnSslVerifyPeer : TSslVerifyPeerEvent   read  FOnSslVerifyPeer

    2257. 

  2257.                                                           write FOnSslVerifyPeer;

    2258. 

  2258.         property  OnSslCliCertRequest : TSslCliCertRequest

    2259. 

  2259.                                                           read  FOnSslCliCertRequest

    2260. 

  2260.                                                           write FOnSslCliCertRequest;

    2261. 

  2261.         property  OnSslHandshakeDone : TSslHandshakeDoneEvent

    2262. 

  2262.                                                           read  FOnSslHandshakeDone

    2263. 

  2263.                                                           write FOnSslHandshakeDone;

    2264. 

  2264.         property  OnSslSvrNewSession : TSslSvrNewSession  read  FOnSslSvrNewSession

    2265. 

  2265.                                                           write FOnSslSvrNewSession;

    2266. 

  2266.         property  OnSslSvrGetSession : TSslSvrGetSession  read  FOnSslSvrGetSession

    2267. 

  2267.                                                           write FOnSslSvrGetSession;

    2268. 

  2268.         property  OnSslCliGetSession : TSslCliGetSession

    2269. 

  2269.                                                           read  FOnSslCliGetSession

    2270. 

  2270.                                                           write FOnSslCliGetSession;

    2271. 

  2271.         property  OnSslCliNewSession : TSslCliNewSession  read  FOnSslCliNewSession

    2272. 

  2272.                                                           write FOnSslCliNewSession;

    2273. 

  2273.         property  OnSslSetSessionIDContext : TSslSetSessionIDContext

    2274. 

  2274.                                                           read  FOnSslSetSessionIDContext

    2275. 

  2275.                                                           write FOnSslSetSessionIDContext;

    2276. 

  2276.     {$IFNDEF OPENSSL_NO_TLSEXT}

    2277. 

  2277.         property  OnSslServerName    : TSslServerNameEvent

    2278. 

  2278.                                                           read  FOnSslServerName

    2279. 

  2279.                                                           write FOnSslServerName;

    2280. 

  2280.     {$ENDIF}

    2281. 

  2281.         property  SslAcceptableHosts : TStrings           read  FSslAcceptableHosts

    2282. 

  2282.                                                           write SetSslAcceptableHosts;

    2283. 

  2283.         property  SslMode            : TSslMode           read  FSslMode

    2284. 

  2284.                                                           write FSslMode;

    2285. 

  2285.         property  SslVersion    : String                  read  FSslVersion;

    2286. 

  2286.         property  SslCipher     : String                  read  FSslCipher;

    2287. 

  2287.         property  SslTotalBits  : Integer                 read  FSslTotalBits;

    2288. 

  2288.         property  SslSecretBits : Integer                 read  FSslSecretBits;

    2289. 

  2289.   private

    2290. 

  2290.       function my_WSocket_recv(s: TSocket;

    2291. 

  2291.                                var Buf: TWSocketData; len, flags: Integer): Integer;

    2292. 

  2292.       function my_RealSend(Buf : TWSocketData; Len : Integer) : Integer;

    2293. 

  2293. {$IFNDEF NO_DEBUG_LOG}

    2294. 

  2294.       function GetMyBioName(B: PBIO) : String;

    2295. 

  2295. {$ENDIF}

    2296. 

  2296.       function my_BIO_ctrl_pending(B: PBIO) : integer;

    2297. 

  2297.       function my_BIO_read(B: PBIO; Buf: Pointer; Len: Integer): Integer;

    2298. 

  2298.       function my_BIO_write(B: PBIO; Buf: Pointer; Len: Integer): Integer;

    2299. 

  2299.       function my_BIO_ctrl(bp: PBIO; Cmd: Integer; LArg: LongInt; PArg: Pointer): LongInt;

    2300. 

  2300.       function my_BIO_ctrl_get_write_guarantee(b: PBIO): Integer;

    2301. 

  2301.       function my_BIO_ctrl_get_read_request(b: PBIO): Integer; 

    2302. 

  2302.       function my_BIO_should_retry(b: PBIO): Boolean;

    2303. 

  2303.       procedure HandleSslError;

    2304. 

  2304.   end;

    2305. 

  2305. 

    2306. 

  2306. //procedure OutputDebugString(const Msg: String);

    2307. 

  2307. 

    2308. 

  2308. var

    2309. 

  2309.     SslCritSect : TRTLCriticalSection;

    2310. 

  2310. 

    2311. 

  2311. type    

    2312. 

  2312. 

    2313. 

  2313. {$ENDIF} // USE_SSL

    2314. 

  2314. 

    2315. 

  2315.   TLineLimitEvent = procedure (Sender        : TObject;

    2316. 

  2316.                                RcvdLength    : LongInt;

    2317. 

  2317.                                var ClearData : Boolean) of object;

    2318. 

  2318.                                

    2319. 

  2319. { You must define USE_SSL so that SSL code is included in the component.    }

    2320. 

  2320. { Either in OverbyteIcsDefs.inc or in the project/package options.          }

    2321. 

  2321. 

    2322. 

  2322. {$IFDEF USE_SSL}              // Makes the IDE happy

    2323. 

  2323.   TBaseParentWSocket = TCustomSslWSocket;

    2324. 

  2324. {$ELSE}

    2325. 

  2325.   TBaseParentWSocket = TCustomSocksWSocket;

    2326. 

  2326. {$ENDIF}

    2327. 

  2327. (*

    2328. 

  2328. {$IFDEF USE_SSL}

    2329. 

  2329.   TCustomLineWSocket = class (TCustomSslWSocket)

    2330. 

  2330. {$ELSE}

    2331. 

  2331.   TCustomLineWSocket = class (TCustomSocksWSocket)

    2332. 

  2332. {$ENDIF}

    2333. 

  2333. *)

    2334. 

  2334.   TCustomLineWSocket = class (TBaseParentWSocket)

    2335. 

  2335.   protected

    2336. 

  2336.       FRcvdPtr             : TWSocketData;

    2337. 

  2337.       FRcvBufSize          : LongInt;

    2338. 

  2338.       FRcvdCnt             : LongInt;

    2339. 

  2339.       {$IFDEF CLR}

    2340. 

  2340.       FLocalBuf            : TBytes;

    2341. 

  2341.       {$ENDIF}

    2342. 

  2342.       FLineEnd             : AnsiString;

    2343. 

  2343.       FLineMode            : Boolean;

    2344. 

  2344.       FLineLength          : Integer;    { When a line is available  }

    2345. 

  2345.       FLineLimit           : LongInt;    { Max line length we accept }

    2346. 

  2346.       FLineReceivedFlag    : Boolean;

    2347. 

  2347.       FLineFound           : Boolean;

    2348. 

  2348.       FLineClearData       : Boolean;

    2349. 

  2349.       FLineEcho            : Boolean;    { Echo received data    }

    2350. 

  2350.       FLineEdit            : Boolean;    { Edit received data    }

    2351. 

  2351.       FTimeout             : LongInt;    { Given in milliseconds }

    2352. 

  2352.       FTimeStop            : LongInt;    { Milliseconds          }

    2353. 

  2353.       FOnLineLimitExceeded : TLineLimitEvent;

    2354. 

  2354.       procedure   WndProc(var MsgRec: TMessage); override;

    2355. 

  2355.       procedure   WMTriggerDataAvailable(var msg: TMessage);

    2356. 

  2356.       function    TriggerDataAvailable(ErrCode : Word) : Boolean; override;

    2357. 

  2357.       procedure   TriggerSessionClosed(Error : Word); override;

    2358. 

  2358.       procedure   TriggerLineLimitExceeded(Cnt: Integer;

    2359. 

  2359.                                            var ClearData : Boolean); virtual;

    2360. 

  2360.       procedure   SetLineMode(newValue : Boolean); virtual;

    2361. 

  2361.       procedure   EditLine(var Len : Integer); virtual;

    2362. 

  2362.       function    GetRcvdCount : LongInt; override;

    2363. 

  2363.       function    DoRecv(var Buffer : TWSocketData;

    2364. 

  2364.                          BufferSize : Integer;

    2365. 

  2365.                          Flags      : Integer) : Integer; override;

    2366. 

  2366.   public

    2367. 

  2367.       constructor Create{$IFDEF VCL}(AOwner : TComponent){$ENDIF}; override;

    2368. 

  2368.       destructor  Destroy; override;

    2369. 

  2369.       function    SendLine(const Str : RawByteString) : Integer; {$IFDEF COMPILER12_UP} overload; {$ENDIF} virtual;

    2370. 

  2370. {$IFDEF COMPILER12_UP}

    2371. 

  2371.       function    SendLine(const Str : UnicodeString; ACodePage: LongWord) : Integer; overload; virtual;

    2372. 

  2372.       function    SendLine(const Str : UnicodeString) : Integer; overload; virtual;

    2373. 

  2373. {$ENDIF}

    2374. 

  2374.       property    LineLength : Integer      read  FLineLength;

    2375. 

  2375.       property    RcvdPtr    : TWSocketData read  FRcvdPtr;

    2376. 

  2376.       property    RcvdCnt    : LongInt      read  FRcvdCnt;

    2377. 

  2377.   published

    2378. 

  2378.       property LineMode : Boolean           read  FLineMode

    2379. 

  2379.                                             write SetLineMode;

    2380. 

  2380.       property LineLimit : LongInt          read  FLineLimit

    2381. 

  2381.                                             write FLineLimit;

    2382. 

  2382.       property LineEnd  : AnsiString        read  FLineEnd

    2383. 

  2383.                                             write FLineEnd;

    2384. 

  2384.       property LineEcho : Boolean           read  FLineEcho

    2385. 

  2385.                                             write FLineEcho;

    2386. 

  2386.       property LineEdit : Boolean           read  FLineEdit

    2387. 

  2387.                                             write FLineEdit;

    2388. 

  2388.       property OnLineLimitExceeded : TLineLimitEvent

    2389. 

  2389.                                             read  FOnLineLimitExceeded

    2390. 

  2390.                                             write FOnLineLimitExceeded;

    2391. 

  2391.   end;

    2392. 

  2392. 

    2393. 

  2393.   { DEPRECATED: DO NOT USE Synchronize, WaitUntilReady, ReadLine procedure }

    2394. 

  2394.   { for a new application.                                                 }

    2395. 

  2395.   TCustomSyncWSocket = class(TCustomLineWSocket)

    2396. 

  2396.   protected

    2397. 

  2397. {$IFDEF CLR}

    2398. 

  2398.       FLinePointer : TBytes;

    2399. 

  2399. {$ENDIF}

    2400. 

  2400. {$IFDEF WIN32}

    2401. 

  2401.       FLinePointer : ^AnsiString;

    2402. 

  2402. {$ENDIF}

    2403. 

  2403.       function    Synchronize(Proc         : TWSocketSyncNextProc;

    2404. 

  2404.                               var DoneFlag : Boolean) : Integer; virtual;

    2405. 

  2405.       function    WaitUntilReady(var DoneFlag : Boolean) : Integer; virtual;

    2406. 

  2406.       procedure   InternalDataAvailable(Sender: TObject; Error: Word);

    2407. 

  2407.   public

    2408. 

  2408.       procedure   ReadLine(Timeout : Integer; var Buffer : AnsiString); deprecated

    2409. 

  2409.           {$IFDEF COMPILER12_UP}'Do not use in new applications'{$ENDIF};

    2410. 

  2410.   end;

    2411. 

  2411. 

    2412. 

  2412. {$IFDEF BUILTIN_TIMEOUT}

    2413. 

  2413.   TTimeoutReason = (torConnect, torIdle);

    2414. 

  2414.   TTimeoutEvent = procedure (Sender: TObject; Reason: TTimeoutReason) of object;

    2415. 

  2415.   TCustomTimeoutWSocket = class(TCustomSyncWSocket)

    2416. 

  2416.   private

    2417. 

  2417.       FTimeoutConnect         : LongWord;

    2418. 

  2418.       FTimeoutIdle            : LongWord;

    2419. 

  2419.       FTimeoutSampling        : LongWord;

    2420. 

  2420.       FOnTimeout              : TTimeoutEvent;

    2421. 

  2421.       FTimeoutTimer           : TIcsThreadTimer;

    2422. 

  2422.       FTimeoutConnectStartTick: LongWord;

    2423. 

  2423.       FTimeoutOldTimerEnabled : Boolean;

    2424. 

  2424.       FTimeoutKeepThreadAlive : Boolean;

    2425. 

  2425.       procedure TimeoutHandleTimer(Sender: TObject);

    2426. 

  2426.       procedure SetTimeoutSampling(const Value: LongWord);

    2427. 

  2427.       procedure SetTimeoutKeepThreadAlive(const Value: Boolean);

    2428. 

  2428.   protected

    2429. 

  2429.       procedure TriggerTimeout(Reason: TTimeoutReason); virtual;

    2430. 

  2430.       procedure TriggerSessionConnectedSpecial(Error: Word); override;

    2431. 

  2431.       procedure TriggerSessionClosed(Error: Word); override;

    2432. 

  2432.       procedure DupConnected; override;

    2433. 

  2433.   public

    2434. 

  2434.       constructor Create(AOwner: TComponent); override;

    2435. 

  2435.       procedure Connect; override;

    2436. 

  2436.       procedure TimeoutStartSampling;

    2437. 

  2437.       procedure TimeoutStopSampling;

    2438. 

  2438.       procedure ThreadAttach; override;

    2439. 

  2439.       procedure ThreadDetach; override;

    2440. 

  2440.       property  TimeoutKeepThreadAlive: Boolean    read  FTimeoutKeepThreadAlive

    2441. 

  2441.                                                    write SetTimeoutKeepThreadAlive

    2442. 

  2442.                                                    default TRUE;

    2443. 

  2443.   //published

    2444. 

  2444.       property TimeoutSampling: LongWord           read  FTimeoutSampling

    2445. 

  2445.                                                    write SetTimeoutSampling;

    2446. 

  2446.       property TimeoutConnect: LongWord            read  FTimeoutConnect

    2447. 

  2447.                                                    write FTimeoutConnect;

    2448. 

  2448.       property TimeoutIdle: LongWord read FTimeoutIdle write FTimeoutIdle;

    2449. 

  2449.       property OnTimeout: TTimeoutEvent read FOnTimeout write FOnTimeout;

    2450. 

  2450.   end;

    2451. 

  2451. {$ENDIF}

    2452. 

  2452. 

    2453. 

  2453. {$IFDEF BUILTIN_THROTTLE}

    2454. 

  2454.   {$IFDEF BUILTIN_TIMEOUT}

    2455. 

  2455.   TCustomThrottledWSocket = class(TCustomTimeoutWSocket)

    2456. 

  2456.   {$ELSE}

    2457. 

  2457.   TCustomThrottledWSocket = class(TCustomSyncWSocket)

    2458. 

  2458.   {$ENDIF}

    2459. 

  2459.   private

    2460. 

  2460.       FBandwidthLimit           : LongWord;  // Bytes per second, null = disabled

    2461. 

  2461.       FBandwidthSampling        : LongWord;  // Msec sampling interval

    2462. 

  2462.       FBandwidthCount           : LongWord;  // Byte counter

    2463. 

  2463.       FBandwidthMaxCount        : LongWord;  // Bytes during sampling period

    2464. 

  2464.       FBandwidthTimer           : TIcsThreadTimer;

    2465. 

  2465.       FBandwidthPaused          : Boolean;

    2466. 

  2466.       FBandwidthEnabled         : Boolean;

    2467. 

  2467.       FBandwidthOldTimerEnabled : Boolean;

    2468. 

  2468.       FBandwidthKeepThreadAlive : Boolean;

    2469. 

  2469.       procedure BandwidthHandleTimer(Sender: TObject);

    2470. 

  2470.       procedure SetBandwidthControl;

    2471. 

  2471.       procedure SetBandwidthSampling(const Value: LongWord);

    2472. 

  2472.       procedure SetBandwidthKeepThreadAlive(const Value: Boolean);

    2473. 

  2473.   protected

    2474. 

  2474.       procedure DupConnected; override;

    2475. 

  2475.       function  RealSend(var Data: TWSocketData; Len : Integer) : Integer; override;

    2476. 

  2476.       procedure TriggerSessionConnectedSpecial(Error: Word); override;

    2477. 

  2477.       procedure TriggerSessionClosed(Error: Word); override;

    2478. 

  2478.   public

    2479. 

  2479.       constructor Create(AOwner: TComponent); override;

    2480. 

  2480.       function  Receive(Buffer: TWSocketData; BufferSize: Integer) : Integer; override;

    2481. 

  2481.       procedure ThreadAttach; override;

    2482. 

  2482.       procedure ThreadDetach; override;

    2483. 

  2483.       property  TimeoutKeepThreadAlive: Boolean    read  FBandwidthKeepThreadAlive

    2484. 

  2484.                                                    write SetBandwidthKeepThreadAlive

    2485. 

  2485.                                                    default TRUE;

    2486. 

  2486.   //published

    2487. 

  2487.       property BandwidthLimit       : LongWord     read  FBandwidthLimit

    2488. 

  2488.                                                    write FBandwidthLimit;

    2489. 

  2489.       property BandwidthSampling    : LongWord     read  FBandwidthSampling

    2490. 

  2490.                                                    write SetBandwidthSampling;

    2491. 

  2491.   end;

    2492. 

  2492. {$ENDIF}

    2493. 

  2493. 

    2494. 

  2494. {$IFDEF CLR}

    2495. 

  2495. //  [DesignTimeVisibleAttribute(TRUE)]

    2496. 

  2496. {$ENDIF}

    2497. 

  2497. {$IFDEF BUILTIN_THROTTLE}

    2498. 

  2498.   TWSocket = class(TCustomThrottledWSocket)

    2499. 

  2499. {$ELSE}

    2500. 

  2500.   {$IFDEF BUILTIN_TIMEOUT}

    2501. 

  2501.   TWSocket = class(TCustomTimeoutWSocket)

    2502. 

  2502.   {$ELSE}

    2503. 

  2503.   TWSocket = class(TCustomSyncWSocket)

    2504. 

  2504.   {$ENDIF}

    2505. 

  2505. {$ENDIF}

    2506. 

  2506.   public

    2507. 

  2507.     property PortNum;

    2508. 

  2508.     property Handle;

    2509. 

  2509.     property HSocket;

    2510. 

  2510.     property BufSize;

    2511. 

  2511.     property Text;

    2512. 

  2512.     property AllSent;

    2513. 

  2513.   {$IFDEF DELPHI1}

    2514. 

  2514.     property TrumpetCompability;

    2515. 

  2515.   {$ENDIF}

    2516. 

  2516.     property PeerAddr;

    2517. 

  2517.     property PeerPort;

    2518. 

  2518.     property State;

    2519. 

  2519.     property DnsResult;

    2520. 

  2520.     property DnsResultList;

    2521. 

  2521.     property ReadCount;

    2522. 

  2522.     property RcvdCount;

    2523. 

  2523.     property SocketRcvBufSize;     {AG 03/10/07}

    2524. 

  2524.     property SocketSndBufSize;     {AG 03/10/07}

    2525. 

  2525.     property OnDebugDisplay;

    2526. 

  2526.     property Counter;

    2527. 

  2527.   published

    2528. 

  2528.     property Addr;

    2529. 

  2529.     property Port;

    2530. 

  2530.     property Proto;

    2531. 

  2531.     property LocalAddr;

    2532. 

  2532.     property LocalPort;

    2533. 

  2533.     property MultiThreaded;

    2534. 

  2534.     property MultiCast;

    2535. 

  2535.     property MultiCastAddrStr;

    2536. 

  2536.     property MultiCastIpTTL;

    2537. 

  2537.     property FlushTimeout;

    2538. 

  2538.     property SendFlags;

    2539. 

  2539.     property LingerOnOff;

    2540. 

  2540.     property LingerTimeout;

    2541. 

  2541.     property KeepAliveOnOff;

    2542. 

  2542.     property KeepAliveTime;

    2543. 

  2543.     property KeepAliveInterval;

    2544. 

  2544.     property SocksLevel;

    2545. 

  2545.     property SocksServer;

    2546. 

  2546.     property SocksPort;

    2547. 

  2547.     property SocksUsercode;

    2548. 

  2548.     property SocksPassword;

    2549. 

  2549.     property SocksAuthentication;

    2550. 

  2550.     property LastError;

    2551. 

  2551.     property ReuseAddr;

    2552. 

  2552.     property ComponentOptions;

    2553. 

  2553.     property ListenBacklog;

    2554. 

  2554.     property ReqVerLow;

    2555. 

  2555.     property ReqVerHigh;

    2556. 

  2556.     property OnDataAvailable;

    2557. 

  2557.     property OnDataSent;

    2558. 

  2558.     property OnSendData;

    2559. 

  2559.     property OnSessionClosed;

    2560. 

  2560.     property OnSessionAvailable;

    2561. 

  2561.     property OnSessionConnected;

    2562. 

  2562.     property OnSocksConnected;

    2563. 

  2563.     property OnChangeState;

    2564. 

  2564.     { property OnLineTooLong; }

    2565. 

  2565.     property OnDnsLookupDone;

    2566. 

  2566.     property OnError;

    2567. 

  2567.     property OnBgException;

    2568. 

  2568.     property OnSocksError;

    2569. 

  2569.     property OnSocksAuthState;

    2570. 

  2570. {$IFNDEF NO_DEBUG_LOG}

    2571. 

  2571.     property IcsLogger;                       { V5.21 }

    2572. 

  2572. {$ENDIF}

    2573. 

  2573.   end;

    2574. 

  2574. 

    2575. 

  2575.   TSocksWSocket = class(TWSocket)

    2576. 

  2576.   end;

    2577. 

  2577. 

    2578. 

  2578. { You must define USE_SSL so that SSL code is included in the component.    }

    2579. 

  2579. { Either in OverbyteIcsDefs.inc or in the project/package options.          }

    2580. 

  2580. {$IFDEF USE_SSL}

    2581. 

  2581.   TSslWSocket = class(TWSocket)

    2582. 

  2582.   public

    2583. 

  2583.       property  SslVersion;

    2584. 

  2584.       property  SslCipher;

    2585. 

  2585.       property  SslTotalBits;

    2586. 

  2586.       property  SslSecretBits;

    2587. 

  2587.       property  X509Class;

    2588. 

  2588.       //property  SslEstablished;

    2589. 

  2589.       property  SslState;

    2590. 

  2590. {$IFNDEF OPENSSL_NO_TLSEXT}

    2591. 

  2591.       property  SslServerName;

    2592. 

  2592.       property  OnSslServerName;

    2593. 

  2593. {$ENDIF}

    2594. 

  2594.   published

    2595. 

  2595. {$IFNDEF NO_DEBUG_LOG}

    2596. 

  2596.       property IcsLogger;                      { V5.21 }

    2597. 

  2597. {$ENDIF}

    2598. 

  2598.       property  SslContext;

    2599. 

  2599.       property  SslEnable;

    2600. 

  2600.       property  SslAcceptableHosts;

    2601. 

  2601.       property  SslMode;

    2602. 

  2602.       property  OnSslVerifyPeer;

    2603. 

  2603.       property  OnSslHandshakeDone;

    2604. 

  2604.       property  OnSslCliGetSession;

    2605. 

  2605.       property  OnSslCliNewSession;

    2606. 

  2606.       property  OnSslSvrNewSession;

    2607. 

  2607.       property  OnSslSvrGetSession;

    2608. 

  2608.       property  OnSslSetSessionIDContext;

    2609. 

  2609.       property  OnSslShutDownComplete;

    2610. 

  2610.       property  OnSslCliCertRequest;

    2611. 

  2611.   end;

    2612. 

  2612. {$ENDIF}

    2613. 

  2613. 

    2614. 

  2614. function  HasOption(OptSet : TWSocketOptions; Opt : TWSocketOption) : Boolean;

    2615. 

  2615. function  RemoveOption(OptSet : TWSocketOptions; Opt : TWSocketOption) : TWSocketOptions;

    2616. 

  2616. function  AddOptions(Opts: array of TWSocketOption): TWSocketOptions;

    2617. 

  2617. function  WinsockInfo : TWSADATA;

    2618. 

  2618. function  WSocketErrorDesc(ErrCode: Integer) : String;

    2619. 

  2619. function  GetWinsockErr(ErrCode: Integer) : String;

    2620. 

  2620. function  GetWindowsErr(ErrCode: Integer): String;

    2621. 

  2621. {$IFDEF CLR}

    2622. 

  2622. function  WSocketGetHostByAddr(const Addr : String) : IntPtr;

    2623. 

  2623. function  WSocketGetHostByName(const Name : String) : IntPtr;

    2624. 

  2624. {$ENDIF}

    2625. 

  2625. {$IFDEF WIN32}

    2626. 

  2626. function  WSocketGetHostByAddr(Addr : AnsiString) : PHostEnt;

    2627. 

  2627. function  WSocketGetHostByName(Name : AnsiString) : PHostEnt;

    2628. 

  2628. {$ENDIF}

    2629. 

  2629. function  LocalHostName : AnsiString;

    2630. 

  2630. function  LocalIPList : TStrings;

    2631. 

  2631. function  WSocketResolveIp(IpAddr : AnsiString) : AnsiString;

    2632. 

  2632. function  WSocketResolveHost(InAddr : AnsiString) : TInAddr;

    2633. 

  2633. function  WSocketResolvePort(Port : AnsiString; Proto : AnsiString) : Word;

    2634. 

  2634. function  WSocketResolveProto(sProto : AnsiString) : Integer;

    2635. 

  2635. procedure WSocketForceLoadWinsock;

    2636. 

  2636. procedure WSocketCancelForceLoadWinsock;

    2637. 

  2637. procedure WSocketUnloadWinsock;

    2638. 

  2638. function  WSocketIsDottedIP(const S : AnsiString) : Boolean;

    2639. 

  2639. { function  WSocketLoadWinsock : Boolean; 14/02/99 }

    2640. 

  2640. 

    2641. 

  2641. {$IFDEF DELPHI1}

    2642. 

  2642. type

    2643. 

  2643.     DWORD = LongInt;

    2644. 

  2644.     TWSAStartup            = function (wVersionRequired: word;

    2645. 

  2645.                                        var WSData: TWSAData): Integer;

    2646. 

  2646.     TWSACleanup            = function : Integer;

    2647. 

  2647.     TWSASetLastError       = procedure (iError: Integer);

    2648. 

  2648.     TWSAGetLastError       = function : Integer;

    2649. 

  2649.     TWSACancelAsyncRequest = function (hAsyncTaskHandle: THandle): Integer;

    2650. 

  2650.     TWSAAsyncGetHostByName = function (HWindow: HWND;

    2651. 

  2651.                                        wMsg: u_int;

    2652. 

  2652.                                        name, buf: PChar;

    2653. 

  2653.                                        buflen: Integer): THandle;

    2654. 

  2654.     TWSAAsyncGetHostByAddr = function (HWindow: HWND;

    2655. 

  2655.                                        wMsg: u_int; addr: PChar;

    2656. 

  2656.                                        len, Struct: Integer;

    2657. 

  2657.                                        buf: PChar;

    2658. 

  2658.                                        buflen: Integer): THandle;

    2659. 

  2659.     TWSAAsyncSelect        = function (s: TSocket;

    2660. 

  2660.                                       HWindow: HWND;

    2661. 

  2661.                                       wMsg: u_int;

    2662. 

  2662.                                       lEvent: Longint): Integer;

    2663. 

  2663.     TGetServByName         = function (name, proto: PChar): PServEnt;

    2664. 

  2664.     TGetProtoByName        = function (name: PChar): PProtoEnt;

    2665. 

  2665.     TGetHostByName         = function (name: PChar): PHostEnt;

    2666. 

  2666.     TGetHostByAddr         = function (addr: Pointer; len, Struct: Integer): PHostEnt;

    2667. 

  2667.     TGetHostName           = function (name: PChar; len: Integer): Integer;

    2668. 

  2668.     TOpenSocket            = function (af, Struct, protocol: Integer): TSocket;

    2669. 

  2669.     TShutdown              = function (s: TSocket; how: Integer): Integer;

    2670. 

  2670.     TSetSockOpt            = function (s: TSocket; level, optname: Integer;

    2671. 

  2671.                                        optval: PChar;

    2672. 

  2672.                                        optlen: Integer): Integer; 

    2673. 

  2673.     TGetSockOpt            = function (s: TSocket; level, optname: Integer; optval: PChar; var optlen: Integer): Integer; 

    2674. 

  2674.     TSendTo                = function (s: TSocket; var Buf;

    2675. 

  2675.                                        len, flags: Integer;

    2676. 

  2676.                                        var addrto: TSockAddr;

    2677. 

  2677.                                        tolen: Integer): Integer; 

    2678. 

  2678.     TSend                  = function (s: TSocket; var Buf;

    2679. 

  2679.                                        len, flags: Integer): Integer;

    2680. 

  2680.     TRecv                  = function (s: TSocket;

    2681. 

  2681.                                        var Buf;

    2682. 

  2682.                                        len, flags: Integer): Integer; 

    2683. 

  2683.     TRecvFrom              = function (s: TSocket;

    2684. 

  2684.                                        var Buf; len, flags: Integer;

    2685. 

  2685.                                        var from: TSockAddr;

    2686. 

  2686.                                        var fromlen: Integer): Integer;

    2687. 

  2687.     Tntohs                 = function (netshort: u_short): u_short;

    2688. 

  2688.     Tntohl                 = function (netlong: u_long): u_long;

    2689. 

  2689.     TListen                = function (s: TSocket; backlog: Integer): Integer;

    2690. 

  2690.     TIoctlSocket           = function (s: TSocket; cmd: DWORD;

    2691. 

  2691.                                        var arg: u_long): Integer;

    2692. 

  2692.     TInet_ntoa             = function (inaddr: TInAddr): PChar;

    2693. 

  2693.     TInet_addr             = function (cp: PChar): u_long;

    2694. 

  2694.     Thtons                 = function (hostshort: u_short): u_short;

    2695. 

  2695.     Thtonl                 = function (hostlong: u_long): u_long;

    2696. 

  2696.     TGetSockName           = function (s: TSocket; var name: TSockAddr;

    2697. 

  2697.                                        var namelen: Integer): Integer;

    2698. 

  2698.     TGetPeerName           = function (s: TSocket; var name: TSockAddr;

    2699. 

  2699.                                        var namelen: Integer): Integer;

    2700. 

  2700.     TConnect               = function (s: TSocket; var name: TSockAddr;

    2701. 

  2701.                                        namelen: Integer): Integer;

    2702. 

  2702.     TCloseSocket           = function (s: TSocket): Integer;

    2703. 

  2703.     TBind                  = function (s: TSocket; var addr: TSockAddr;

    2704. 

  2704.                                        namelen: Integer): Integer;

    2705. 

  2705.     TAccept                = function (s: TSocket; var addr: TSockAddr;

    2706. 

  2706.                                        var addrlen: Integer): TSocket;

    2707. 

  2707. {$ELSE}

    2708. 

  2708. {$IFDEF WIN32}   // DotNET doesn't support dynamic winsock loading

    2709. 

  2709. type

    2710. 

  2710.     TWSAStartup            = function (wVersionRequired: word;

    2711. 

  2711.                                        var WSData: TWSAData): Integer; stdcall;

    2712. 

  2712.     TWSACleanup            = function : Integer; stdcall;

    2713. 

  2713.     TWSASetLastError       = procedure (iError: Integer); stdcall;

    2714. 

  2714.     TWSAGetLastError       = function : Integer; stdcall;

    2715. 

  2715.     TWSACancelAsyncRequest = function (hAsyncTaskHandle: THandle): Integer; stdcall;

    2716. 

  2716.     TWSAAsyncGetHostByName = function (HWindow: HWND;

    2717. 

  2717.                                        wMsg: u_int;

    2718. 

  2718.                                        name, buf: PAnsiChar;

    2719. 

  2719.                                        buflen: Integer): THandle; stdcall;

    2720. 

  2720.     TWSAAsyncGetHostByAddr = function (HWindow: HWND;

    2721. 

  2721.                                        wMsg: u_int; addr: PAnsiChar;

    2722. 

  2722.                                        len, Struct: Integer;

    2723. 

  2723.                                        buf: PAnsiChar;

    2724. 

  2724.                                        buflen: Integer): THandle; stdcall;

    2725. 

  2725.     TWSAAsyncSelect        = function (s: TSocket;

    2726. 

  2726.                                        HWindow: HWND;

    2727. 

  2727.                                        wMsg: u_int;

    2728. 

  2728.                                        lEvent: Longint): Integer; stdcall;

    2729. 

  2729.     TGetServByName         = function (name, proto: PAnsiChar): PServEnt; stdcall;

    2730. 

  2730.     TGetProtoByName        = function (name: PAnsiChar): PProtoEnt; stdcall;

    2731. 

  2731.     TGetHostByName         = function (name: PAnsiChar): PHostEnt; stdcall;

    2732. 

  2732.     TGetHostByAddr         = function (addr: Pointer; len, Struct: Integer): PHostEnt; stdcall;

    2733. 

  2733.     TGetHostName           = function (name: PAnsiChar; len: Integer): Integer; stdcall;

    2734. 

  2734.     TOpenSocket            = function (af, Struct, protocol: Integer): TSocket; stdcall;

    2735. 

  2735.     TShutdown              = function (s: TSocket; how: Integer): Integer; stdcall;

    2736. 

  2736.     TSetSockOpt            = function (s: TSocket; level, optname: Integer;

    2737. 

  2737.                                        optval: PAnsiChar;

    2738. 

  2738.                                        optlen: Integer): Integer; stdcall;

    2739. 

  2739.     TGetSockOpt            = function (s: TSocket; level, optname: Integer;

    2740. 

  2740.                                        optval: PAnsiChar;

    2741. 

  2741.                                        var optlen: Integer): Integer; stdcall;

    2742. 

  2742.     TSendTo                = function (s: TSocket; var Buf;

    2743. 

  2743.                                        len, flags: Integer;

    2744. 

  2744.                                        var addrto: TSockAddr;

    2745. 

  2745.                                        tolen: Integer): Integer; stdcall;

    2746. 

  2746.     TSend                  = function (s: TSocket; var Buf;

    2747. 

  2747.                                        len, flags: Integer): Integer; stdcall;

    2748. 

  2748.     TRecv                  = function (s: TSocket;

    2749. 

  2749.                                        var Buf;

    2750. 

  2750.                                        len, flags: Integer): Integer; stdcall;

    2751. 

  2751.     TRecvFrom              = function (s: TSocket;

    2752. 

  2752.                                        var Buf; len, flags: Integer;

    2753. 

  2753.                                        var from: TSockAddr;

    2754. 

  2754.                                        var fromlen: Integer): Integer; stdcall;

    2755. 

  2755.     Tntohs                 = function (netshort: u_short): u_short; stdcall;

    2756. 

  2756.     Tntohl                 = function (netlong: u_long): u_long; stdcall;

    2757. 

  2757.     TListen                = function (s: TSocket;

    2758. 

  2758.                                        backlog: Integer): Integer; stdcall;

    2759. 

  2759.     TIoctlSocket           = function (s: TSocket; cmd: DWORD;

    2760. 

  2760.                                        var arg: u_long): Integer; stdcall;

    2761. 

  2761.     TWSAIoctl              = function (s                 : TSocket;

    2762. 

  2762.                                        IoControlCode     : DWORD;

    2763. 

  2763.                                        InBuffer          : Pointer;

    2764. 

  2764.                                        InBufferSize      : DWORD;

    2765. 

  2765.                                        OutBuffer         : Pointer;

    2766. 

  2766.                                        OutBufferSize     : DWORD;

    2767. 

  2767.                                        var BytesReturned : DWORD;

    2768. 

  2768.                                        Overlapped        : POverlapped;

    2769. 

  2769.                                        CompletionRoutine : FARPROC): Integer; stdcall;

    2770. 

  2770.     TInet_ntoa             = function (inaddr: TInAddr): PAnsiChar; stdcall; 

    2771. 

  2771.     TInet_addr             = function (cp: PAnsiChar): u_long; stdcall;  

    2772. 

  2772.     Thtons                 = function (hostshort: u_short): u_short; stdcall;

    2773. 

  2773.     Thtonl                 = function (hostlong: u_long): u_long; stdcall;

    2774. 

  2774.     TGetSockName           = function (s: TSocket; var name: TSockAddr;

    2775. 

  2775.                                        var namelen: Integer): Integer; stdcall;

    2776. 

  2776.     TGetPeerName           = function (s: TSocket; var name: TSockAddr;

    2777. 

  2777.                                        var namelen: Integer): Integer; stdcall;

    2778. 

  2778.     TConnect               = function (s: TSocket; var name: TSockAddr;

    2779. 

  2779.                                        namelen: Integer): Integer; stdcall;

    2780. 

  2780.     TCloseSocket           = function (s: TSocket): Integer; stdcall;

    2781. 

  2781.     TBind                  = function (s: TSocket; var addr: TSockAddr;

    2782. 

  2782.                                        namelen: Integer): Integer; stdcall;

    2783. 

  2783. {$IFDEF VER90} { Delphi 2 has a special definition}

    2784. 

  2784.     TAccept                = function (s: TSocket; var addr: TSockAddr;

    2785. 

  2785.                                        var addrlen: Integer): TSocket; stdcall;

    2786. 

  2786. {$ELSE}

    2787. 

  2787.     TAccept                = function (s: TSocket; addr: PSockAddr;

    2788. 

  2788.                                        addrlen: PInteger): TSocket; stdcall;

    2789. 

  2789. {$ENDIF}

    2790. 

  2790. {$ENDIF}

    2791. 

  2791. {$ENDIF}

    2792. 

  2792. 

    2793. 

  2793. {$IFDEF WIN32}  // DotNET doesn't support dynamic winsock loading

    2794. 

  2794. var

    2795. 

  2795.    FWSAStartup            : TWSAStartup;

    2796. 

  2796.    FWSACleanup            : TWSACleanup;

    2797. 

  2797.    FWSASetLastError       : TWSASetLastError;

    2798. 

  2798.    FWSAGetLastError       : TWSAGetLastError;

    2799. 

  2799.    FWSACancelAsyncRequest : TWSACancelAsyncRequest;

    2800. 

  2800.    FWSAAsyncGetHostByName : TWSAAsyncGetHostByName;

    2801. 

  2801.    FWSAAsyncGetHostByAddr : TWSAAsyncGetHostByAddr;

    2802. 

  2802.    FWSAAsyncSelect        : TWSAAsyncSelect;

    2803. 

  2803.    FGetServByName         : TGetServByName;

    2804. 

  2804.    FGetProtoByName        : TGetProtoByName;

    2805. 

  2805.    FGetHostByName         : TGetHostByName;

    2806. 

  2806.    FGetHostByAddr         : TGetHostByAddr;

    2807. 

  2807.    FGetHostName           : TGetHostName;

    2808. 

  2808.    FOpenSocket            : TOpenSocket;

    2809. 

  2809.    FShutdown              : TShutdown;

    2810. 

  2810.    FSetSockOpt            : TSetSockOpt;

    2811. 

  2811.    FGetSockOpt            : TGetSockOpt;

    2812. 

  2812.    FSendTo                : TSendTo;

    2813. 

  2813.    FSend                  : TSend;

    2814. 

  2814.    FRecv                  : TRecv;

    2815. 

  2815.    FRecvFrom              : TRecvFrom;

    2816. 

  2816.    Fntohs                 : Tntohs;

    2817. 

  2817.    Fntohl                 : Tntohl;

    2818. 

  2818.    FListen                : TListen;

    2819. 

  2819.    FIoctlSocket           : TIoctlSocket;

    2820. 

  2820. {$IFDEF COMPILER2_UP}

    2821. 

  2821.    FWSAIoctl              : TWSAIoctl;

    2822. 

  2822. {$ENDIF}

    2823. 

  2823.    FInet_ntoa             : TInet_ntoa;

    2824. 

  2824.    FInet_addr             : TInet_addr;

    2825. 

  2825.    Fhtons                 : Thtons;

    2826. 

  2826.    Fhtonl                 : Thtonl;

    2827. 

  2827.    FGetSockName           : TGetSockName;

    2828. 

  2828.    FGetPeerName           : TGetPeerName;

    2829. 

  2829.    FConnect               : TConnect;

    2830. 

  2830.    FCloseSocket           : TCloseSocket;

    2831. 

  2831.    FBind                  : TBind;

    2832. 

  2832.    FAccept                : TAccept;

    2833. 

  2833. 

    2834. 

  2834. function WSocketGetProc(const ProcName : AnsiString) : Pointer;

    2835. 

  2835. {$IFDEF COMPILER2_UP}

    2836. 

  2836. function WSocket2GetProc(const ProcName : AnsiString) : Pointer;

    2837. 

  2837. {$ENDIF}

    2838. 

  2838. {$ENDIF}

    2839. 

  2839. 

    2840. 

  2840. function WSocket_WSAStartup(wVersionRequired: word;

    2841. 

  2841.                            var WSData: TWSAData): Integer;

    2842. 

  2842. function WSocket_WSACleanup : Integer;

    2843. 

  2843. procedure WSocket_WSASetLastError(iError: Integer);

    2844. 

  2844. function WSocket_WSAGetLastError: Integer;

    2845. 

  2845. function WSocket_WSACancelAsyncRequest(hAsyncTaskHandle: THandle): Integer;

    2846. 

  2846. {$IFDEF CLR}

    2847. 

  2847. function  WSocket_WSAAsyncGetHostByName(HWindow: HWND; wMsg: u_int;

    2848. 

  2848.                                         const name : String; buf: IntPtr;

    2849. 

  2849.                                         buflen: Integer): THandle;

    2850. 

  2850. function  WSocket_WSAAsyncGetHostByAddr(HWindow: HWND;

    2851. 

  2851.                                         wMsg: u_int; var addr: u_long;

    2852. 

  2852.                                         len, Struct: Integer;

    2853. 

  2853.                                         buf: IntPtr;

    2854. 

  2854.                                         buflen: Integer): THandle;

    2855. 

  2855. {$ENDIF}

    2856. 

  2856. {$IFDEF WIN32}

    2857. 

  2857. function WSocket_WSAAsyncGetHostByName(HWindow: HWND; wMsg: u_int;

    2858. 

  2858.                                       name, buf: PAnsiChar;

    2859. 

  2859.                                       buflen: Integer): THandle;

    2860. 

  2860. function WSocket_WSAAsyncGetHostByAddr(HWindow: HWND;

    2861. 

  2861.                                       wMsg: u_int; addr: PAnsiChar;

    2862. 

  2862.                                       len, Struct: Integer;

    2863. 

  2863.                                       buf: PAnsiChar;

    2864. 

  2864.                                       buflen: Integer): THandle;

    2865. 

  2865. {$ENDIF}

    2866. 

  2866. function WSocket_WSAAsyncSelect(s: TSocket; HWindow: HWND; wMsg: u_int; lEvent: Longint): Integer;

    2867. 

  2867. function WSocket_recv(s: TSocket;

    2868. 

  2868.                       var Buf: TWSocketData; len, flags: Integer): Integer;

    2869. 

  2869. function WSocket_recvfrom(s: TSocket;

    2870. 

  2870.                          var Buf: TWSocketData; len, flags: Integer;

    2871. 

  2871.                          var from: TSockAddr;

    2872. 

  2872.                          var fromlen: Integer): Integer;

    2873. 

  2873. {$IFDEF CLR}

    2874. 

  2874. function  WSocket_getservbyname(const name, proto: String): IntPtr;

    2875. 

  2875. function  WSocket_getprotobyname(const name: String): IntPtr;

    2876. 

  2876. function  WSocket_gethostbyname(const name: String): IntPtr;

    2877. 

  2877. function  WSocket_gethostbyaddr(var addr: u_long; len, Struct: Integer): IntPtr;

    2878. 

  2878. {$ENDIF}

    2879. 

  2879. {$IFDEF WIN32}

    2880. 

  2880. function WSocket_getservbyname(name, proto: PAnsiChar): PServEnt;

    2881. 

  2881. function WSocket_getprotobyname(name: PAnsiChar): PProtoEnt;

    2882. 

  2882. function WSocket_gethostbyname(name: PAnsiChar): PHostEnt;

    2883. 

  2883. function WSocket_gethostbyaddr(addr: Pointer; len, Struct: Integer): PHostEnt;

    2884. 

  2884. {$ENDIF}

    2885. 

  2885. function WSocket_gethostname(out name: AnsiString): Integer;

    2886. 

  2886. function WSocket_socket(af, Struct, protocol: Integer): TSocket;

    2887. 

  2887. function WSocket_shutdown(s: TSocket; how: Integer): Integer;

    2888. 

  2888. {$IFDEF CLR}

    2889. 

  2889. function  WSocket_getsockopt(s: TSocket; level, optname: Integer;

    2890. 

  2890.                              var optval: Integer;

    2891. 

  2891.                              var optlen: Integer): Integer; overload;

    2892. 

  2892. function  WSocket_getsockopt(s: TSocket; level, optname: Integer;

    2893. 

  2893.                              var optval: ip_mreq;

    2894. 

  2894.                              var optlen: Integer): Integer; overload;

    2895. 

  2895. function  WSocket_getsockopt(s: TSocket; level, optname: Integer;

    2896. 

  2896.                              var optval: TInAddr;

    2897. 

  2897.                              var optlen: Integer): Integer; overload;

    2898. 

  2898. function  WSocket_getsockopt(s: TSocket; level, optname: Integer;

    2899. 

  2899.                              var optval: TLinger;

    2900. 

  2900.                              var optlen: Integer): Integer; overload;

    2901. 

  2901. {$ENDIF}

    2902. 

  2902. {$IFDEF WIN32}

    2903. 

  2903. function WSocket_setsockopt(s: TSocket; level, optname: Integer; optval: PAnsiChar;

    2904. 

  2904.                             optlen: Integer): Integer; overload;

    2905. 

  2905. function WSocket_setsockopt(s: TSocket; level, optname: Integer; var optval: TLinger;

    2906. 

  2906.                             optlen: Integer): Integer; overload;

    2907. 

  2907. function WSocket_getsockopt(s: TSocket; level, optname: Integer; optval: PAnsiChar;

    2908. 

  2908.                             var optlen: Integer): Integer;

    2909. 

  2909. {$ENDIF}

    2910. 

  2910. function WSocket_sendto(s: TSocket; var Buf : TWSocketData; len, flags: Integer;

    2911. 

  2911.                         var addrto: TSockAddr;

    2912. 

  2912.                         tolen: Integer): Integer;

    2913. 

  2913. function WSocket_send(s: TSocket; var Buf : TWSocketData; len, flags: Integer): Integer;

    2914. 

  2914. function WSocket_ntohs(netshort: u_short): u_short;

    2915. 

  2915. function WSocket_ntohl(netlong: u_long): u_long;

    2916. 

  2916. function WSocket_listen(s: TSocket; backlog: Integer): Integer;

    2917. 

  2917. function WSocket_ioctlsocket(s: TSocket; cmd: DWORD; var arg: u_long): Integer;

    2918. 

  2918. {$IFNDEF VER80}

    2919. 

  2919. {$IFDEF WIN32}

    2920. 

  2920. function WSocket_WSAIoctl(s                 : TSocket; IoControlCode : DWORD;

    2921. 

  2921.                           InBuffer          : Pointer; InBufferSize  : DWORD;

    2922. 

  2922.                           OutBuffer         : Pointer; OutBufferSize : DWORD;

    2923. 

  2923.                           var BytesReturned : DWORD; Overlapped      : POverlapped;

    2924. 

  2924.                           CompletionRoutine : FARPROC): Integer;

    2925. 

  2925. {$ENDIF}

    2926. 

  2926. {$ENDIF}

    2927. 

  2927. function WSocket_inet_ntoa(inaddr: TInAddr): AnsiString;

    2928. 

  2928. function WSocket_inet_addr(const cp: AnsiString): u_long;

    2929. 

  2929. function WSocket_htons(hostshort: u_short): u_short;

    2930. 

  2930. function WSocket_htonl(hostlong: u_long): u_long;

    2931. 

  2931. function WSocket_getsockname(s: TSocket; var name: TSockAddr;

    2932. 

  2932.                              var namelen: Integer): Integer;

    2933. 

  2933. function WSocket_getpeername(s: TSocket; var name: TSockAddr;

    2934. 

  2934.                              var namelen: Integer): Integer;

    2935. 

  2935. function WSocket_connect(s: TSocket; var name: TSockAddr;

    2936. 

  2936.                          namelen: Integer): Integer;

    2937. 

  2937. function WSocket_closesocket(s: TSocket): Integer;

    2938. 

  2938. function WSocket_bind(s: TSocket; var addr: TSockAddr; namelen: Integer): Integer;

    2939. 

  2939. {$IFDEF DELPHI1}

    2940. 

  2940. function WSocket_accept(s: TSocket; var addr: TSockAddr; var addrlen: Integer): TSocket;

    2941. 

  2941. {$ELSE}

    2942. 

  2942. {$IFDEF VER90}

    2943. 

  2943. function WSocket_accept(s: TSocket; var addr: TSockAddr; var addrlen: Integer): TSocket;

    2944. 

  2944. {$ELSE}

    2945. 

  2945. {$IFDEF CLR}

    2946. 

  2946. function WSocket_accept(s: TSocket; var addr: TSockAddr; var addrlen: Integer): TSocket;

    2947. 

  2947. {$ENDIF}

    2948. 

  2948. {$IFDEF WIN32}

    2949. 

  2949. function WSocket_accept(s: TSocket; addr: PSockAddr; addrlen: PInteger): TSocket;

    2950. 

  2950. {$ENDIF}

    2951. 

  2951. {$ENDIF}

    2952. 

  2952. {$ENDIF}

    2953. 

  2953. 

    2954. 

  2954. {$IFNDEF NO_ADV_MT}

    2955. 

  2955. function SafeWSocketGCount : Integer;

    2956. 

  2956. {$ENDIF}

    2957. 

  2957. 

    2958. 

  2958. {$IFDEF USE_SSL}

    2959. 

  2959. function OpenSslErrMsg(const AErrCode: LongWord): String;

    2960. 

  2960. {$ENDIF}

    2961. 

  2961. 

    2962. 

  2962. const

    2963. 

  2963.     WSocketGCount   : Integer = 0;

    2964. 

  2964.     WSocketGForced  : boolean = FALSE;

    2965. 

  2965.     GReqVerLow      : BYTE    = 1;

    2966. 

  2966.     GReqVerHigh     : BYTE    = 1;

    2967. 

  2967. 

    2968. 

  2968. {$EXTERNALSYM IOC_UNIX}

    2969. 

  2969.     IOC_UNIX             = $00000000;       { Do not use this in Windows     }

    2970. 

  2970. {   IOCPARM_MASK         = $000007F7;  }    { Parameters must be < 128 bytes }

    2971. 

  2971.  {$EXTERNALSYM IOC_WS2}

    2972. 

  2972.     IOC_WS2              = $08000000;

    2973. 

  2973.  {$EXTERNALSYM IOC_PROTOCOL}

    2974. 

  2974.     IOC_PROTOCOL         = $10000000;

    2975. 

  2975. {   IOC_VOID             = $20000000;  }    { No parameters                  }

    2976. 

  2976. {   IOC_OUT              = $40000000;  }    { Copy out parameters            }

    2977. 

  2977. {$EXTERNALSYM IOC_IN}

    2978. 

  2978.     IOC_IN               = $80000000;       { Copy in parameters             }

    2979. 

  2979. {   IOC_INOUT            = (IOC_IN or IOC_OUT); }

    2980. 

  2980. {$EXTERNALSYM IOC_VENDOR}

    2981. 

  2981.     IOC_VENDOR           = $18000000;

    2982. 

  2982.     SIO_RCVALL           = IOC_IN or IOC_VENDOR or 1;

    2983. 

  2983.     SIO_RCVALL_MCAST     = IOC_IN or IOC_VENDOR or 2;

    2984. 

  2984.     SIO_RCVALL_IGMPMCAST = IOC_IN or IOC_VENDOR or 3;

    2985. 

  2985.     SIO_KEEPALIVE_VALS   = IOC_IN or IOC_VENDOR or 4;

    2986. 

  2986.     SIO_ABSORB_RTRALERT  = IOC_IN or IOC_VENDOR or 5;

    2987. 

  2987.     SIO_UCAST_IF         = IOC_IN or IOC_VENDOR or 6;

    2988. 

  2988.     SIO_LIMIT_BROADCASTS = IOC_IN or IOC_VENDOR or 7;

    2989. 

  2989.     SIO_INDEX_BIND       = IOC_IN or IOC_VENDOR or 8;

    2990. 

  2990.     SIO_INDEX_MCASTIF    = IOC_IN or IOC_VENDOR or 9;

    2991. 

  2991.     SIO_INDEX_ADD_MCAST  = IOC_IN or IOC_VENDOR or 10;

    2992. 

  2992.     SIO_INDEX_DEL_MCAST  = IOC_IN or IOC_VENDOR or 11;

    2993. 

  2993. 

    2994. 

  2994. {$IFNDEF NO_DEBUG_LOG}

    2995. 

  2995. var

    2996. 

  2996.     __DataSocket : TCustomWSocket;

    2997. 

  2997. {$ENDIF}

    2998. 

  2998. 

    2999. 

  2999. implementation

    3000. 

  3000. 

    3001. 

  3001. { R 'OverbyteIcsWSocket.TWSocket.bmp'}

    3002. 

  3002. 

    3003. 

  3003. const

    3004. 

  3004.     FDllHandle     : THandle  = 0;

    3005. 

  3005.     FDll2Handle    : THandle  = 0;

    3006. 

  3006.     socksNoError              = 20000;

    3007. 

  3007.     socksProtocolError        = 20001;

    3008. 

  3008.     socksVersionError         = 20002;

    3009. 

  3009.     socksAuthMethodError      = 20003;

    3010. 

  3010.     socksGeneralFailure       = 20004;

    3011. 

  3011.     socksConnectionNotAllowed = 20005;

    3012. 

  3012.     socksNetworkUnreachable   = 20006;

    3013. 

  3013.     socksHostUnreachable      = 20007;

    3014. 

  3014.     socksConnectionRefused    = 20008;

    3015. 

  3015.     socksTtlExpired           = 20009;

    3016. 

  3016.     socksUnknownCommand       = 20010;

    3017. 

  3017.     socksUnknownAddressType   = 20011;

    3018. 

  3018.     socksUnassignedError      = 20012;

    3019. 

  3019.     socksInternalError        = 20013;

    3020. 

  3020.     socksDataReceiveError     = 20014;

    3021. 

  3021.     socksAuthenticationFailed = 20015;

    3022. 

  3022.     socksRejectedOrFailed     = 20016;

    3023. 

  3023.     socksHostResolutionFailed = 20017;

    3024. 

  3024. 

    3025. 

  3025. {$IFDEF DELPHI1}

    3026. 

  3026.     IP_DEFAULT_MULTICAST_TTL  = 1;

    3027. 

  3027.     IP_MULTICAST_IF           = 2;

    3028. 

  3028.     IP_MULTICAST_TTL          = 3;

    3029. 

  3029.     IP_MULTICAST_LOOP         = 4;

    3030. 

  3030.     IP_ADD_MEMBERSHIP         = 5;

    3031. 

  3031.     IP_DROP_MEMBERSHIP        = 6;

    3032. 

  3032. type

    3033. 

  3033.     in_addr = TInAddr;

    3034. 

  3034. {$ENDIF}

    3035. 

  3035. {$IFNDEF DELPHI1}

    3036. 

  3036. {$IFNDEF COMPILER4_UP}

    3037. 

  3037. type

    3038. 

  3038.     in_addr = TInAddr;

    3039. 

  3039. {$ENDIF}

    3040. 

  3040. {$ENDIF}

    3041. 

  3041. 

    3042. 

  3042. var

    3043. 

  3043.     GInitData         : TWSADATA;

    3044. 

  3044.     IPList            : TStrings;

    3045. 

  3045. {$IFDEF CLR}

    3046. 

  3046.     GWSAStartupCalled : Boolean = FALSE;

    3047. 

  3047. {$ENDIF}

    3048. 

  3048. {$IFDEF COMPILER2_UP}

    3049. 

  3049.     GClassCritSect    : TRTLCriticalSection;

    3050. 

  3050.     GWSockCritSect    : TRTLCriticalSection;

    3051. 

  3051. //  V6.01 moved GSendBufCritSect to OverbyteIcsWSocket.pas

    3052. 

  3052. //  GSendBufCritSect  : TRTLCriticalSection;                 { v6.00f }

    3053. 

  3053. {$ENDIF}

    3054. 

  3054. 

    3055. 

  3055. 

    3056. 

  3056. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    3057. 

  3057. {$IFDEF DELPHI1}

    3058. 

  3058. { Delphi 1 miss the SetLength procedure. So we rewrite it. }

    3059. 

  3059. procedure SetLength(var S: String; NewLength: Integer);

    3060. 

  3060. begin

    3061. 

  3061.     S[0] := chr(NewLength);

    3062. 

  3062. end;

    3063. 

  3063. {$ENDIF}

    3064. 

  3064. 

    3065. 

  3065. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    3066. 

  3066. function IsDigit(Ch : AnsiChar) : Boolean;

    3067. 

  3067. begin

    3068. 

  3068.     Result := (ch >= '0') and (ch <= '9');

    3069. 

  3069. end;

    3070. 

  3070. 

    3071. 

  3071. 

    3072. 

  3072. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    3073. 

  3073. { Check for a valid numeric dotted IP address such as 192.161.65.25         }

    3074. 

  3074. { Accept leading and trailing spaces.                                       }

    3075. 

  3075. function WSocketIsDottedIP(const S : AnsiString) : Boolean;

    3076. 

  3076. var

    3077. 

  3077.     I          : Integer;

    3078. 

  3078.     DotCount   : Integer;

    3079. 

  3079.     NumVal     : Integer;

    3080. 

  3080. begin

    3081. 

  3081.     Result     := FALSE;

    3082. 

  3082.     DotCount   := 0;

    3083. 

  3083.     NumVal     := 0;

    3084. 

  3084.     I          := 1;

    3085. 

  3085. 

    3086. 

  3086.     { Skip leading spaces }

    3087. 

  3087.     while (I <= Length(S)) and (S[I] = ' ') do

    3088. 

  3088.         Inc(I);

    3089. 

  3089.     { Can't begin with a dot }

    3090. 

  3090.     if (I <= Length(S)) and (S[I] = '.') then

    3091. 

  3091.         Exit;

    3092. 

  3092.     { Scan full string }

    3093. 

  3093.     while I <= Length(S) do begin

    3094. 

  3094.         if S[I] = '.' then begin

    3095. 

  3095.             Inc(DotCount);

    3096. 

  3096.             if (DotCount > 3) or (NumVal > 255) then

    3097. 

  3097.                 Exit;

    3098. 

  3098.             NumVal := 0;

    3099. 

  3099.             { A dot must be followed by a digit }

    3100. 

  3100.             if (I >= Length(S)) or (not (AnsiChar(S[I + 1]) in ['0'..'9'])) then

    3101. 

  3101.                 Exit;

    3102. 

  3102.         end

    3103. 

  3103.         else if AnsiChar(S[I]) in ['0'..'9'] then

    3104. 

  3104.             NumVal := NumVal * 10 + Ord(S[I]) - Ord('0')

    3105. 

  3105.         else begin

    3106. 

  3106.             { Not a digit nor a dot. Accept spaces until end of string }

    3107. 

  3107.             while (I <= Length(S)) and (S[I] = ' ') do

    3108. 

  3108.                 Inc(I);

    3109. 

  3109.             if I <= Length(S) then

    3110. 

  3110.                 Exit;  { Not a space, do not accept }

    3111. 

  3111.             break;     { Only spaces, accept        }

    3112. 

  3112.         end;

    3113. 

  3113.         Inc(I);

    3114. 

  3114.     end;

    3115. 

  3115.     { We must have exactly 3 dots }

    3116. 

  3116.     if (DotCount <> 3) or (NumVal > 255) then

    3117. 

  3117.         Exit;

    3118. 

  3118.     Result := TRUE;

    3119. 

  3119. end;

    3120. 

  3120. 

    3121. 

  3121. 

    3122. 

  3122. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    3123. 

  3123. {$IFDEF DELPHI1}

    3124. 

  3124. function TrimRight(Str : String) : String;

    3125. 

  3125. var

    3126. 

  3126.     i : Integer;

    3127. 

  3127. begin

    3128. 

  3128.     i := Length(Str);

    3129. 

  3129.     while (i > 0) and (Str[i] in [' ', #9]) do

    3130. 

  3130.         i := i - 1;

    3131. 

  3131.     Result := Copy(Str, 1, i);

    3132. 

  3132. end;

    3133. 

  3133. 

    3134. 

  3134. 

    3135. 

  3135. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    3136. 

  3136. function TrimLeft(Str : String) : String;

    3137. 

  3137. var

    3138. 

  3138.     i : Integer;

    3139. 

  3139. begin

    3140. 

  3140.     if Str[1] <> ' ' then

    3141. 

  3141.         Result := Str

    3142. 

  3142.     else begin

    3143. 

  3143.         i := 1;

    3144. 

  3144.         while (i <= Length(Str)) and (Str[i] = ' ') do

    3145. 

  3145.             i := i + 1;

    3146. 

  3146.         Result := Copy(Str, i, Length(Str) - i + 1);

    3147. 

  3147.     end;

    3148. 

  3148. end;

    3149. 

  3149. 

    3150. 

  3150. 

    3151. 

  3151. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    3152. 

  3152. function Trim(Str : String) : String;

    3153. 

  3153. begin

    3154. 

  3154.     Result := TrimLeft(TrimRight(Str));

    3155. 

  3155. end;

    3156. 

  3156. {$ENDIF}

    3157. 

  3157. 

    3158. 

  3158. 

    3159. 

  3159. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    3160. 

  3160. procedure TCustomWSocket.RaiseException(const Msg : String);

    3161. 

  3161. begin

    3162. 

  3162.     if Assigned(FOnError) then

    3163. 

  3163.         TriggerError                 { Should be modified to pass Msg ! }

    3164. 

  3164.     else

    3165. 

  3165.         raise ESocketException.Create(Msg);

    3166. 

  3166. end;

    3167. 

  3167. 

    3168. 

  3168. 

    3169. 

  3169. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    3170. 

  3170. //procedure TCustomWSocket.RaiseExceptionFmt(const Fmt : String; args : array of const);

    3171. 

  3171. //begin

    3172. 

  3172. //    if Assigned(FOnError) then

    3173. 

  3173. //        TriggerError

    3174. 

  3174. //    else

    3175. 

  3175. //        raise ESocketException.CreateFmt(Fmt, args);

    3176. 

  3176. //end;

    3177. 

  3177. 

    3178. 

  3178. 

    3179. 

  3179. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    3180. 

  3180. {$IFDEF WIN32}

    3181. 

  3181. function WSocket_Synchronized_WSAStartup(

    3182. 

  3182.     wVersionRequired: word;

    3183. 

  3183.     var WSData: TWSAData): Integer;

    3184. 

  3184. begin

    3185. 

  3185.     if @FWSAStartup = nil then

    3186. 

  3186.         @FWSAStartup := WSocketGetProc('WSAStartup');

    3187. 

  3187.     Result := FWSAStartup(wVersionRequired, WSData);

    3188. 

  3188. end;

    3189. 

  3189. 

    3190. 

  3190. 

    3191. 

  3191. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    3192. 

  3192. function WSocket_Synchronized_WSACleanup : Integer;

    3193. 

  3193. begin

    3194. 

  3194.     if @FWSACleanup = nil then

    3195. 

  3195.         @FWSACleanup := WSocketGetProc('WSACleanup');

    3196. 

  3196.     Result := FWSACleanup;

    3197. 

  3197. end;

    3198. 

  3198. 

    3199. 

  3199. 

    3200. 

  3200. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    3201. 

  3201. procedure WSocket_Synchronized_WSASetLastError(iError: Integer);

    3202. 

  3202. begin

    3203. 

  3203.     if @FWSASetLastError = nil then

    3204. 

  3204.         @FWSASetLastError := WSocketGetProc('WSASetLastError');

    3205. 

  3205.     FWSASetLastError(iError);

    3206. 

  3206. end;

    3207. 

  3207. 

    3208. 

  3208. 

    3209. 

  3209. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    3210. 

  3210. function WSocket_Synchronized_WSAGetLastError: Integer;

    3211. 

  3211. begin

    3212. 

  3212.     if @FWSAGetLastError = nil then

    3213. 

  3213.         @FWSAGetLastError := WSocketGetProc('WSAGetLastError');

    3214. 

  3214.     Result := FWSAGetLastError;

    3215. 

  3215. end;

    3216. 

  3216. 

    3217. 

  3217. 

    3218. 

  3218. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    3219. 

  3219. function WSocket_Synchronized_WSACancelAsyncRequest(hAsyncTaskHandle: THandle): Integer;

    3220. 

  3220. begin

    3221. 

  3221.     if @FWSACancelAsyncRequest = nil then

    3222. 

  3222.         @FWSACancelAsyncRequest := WSocketGetProc('WSACancelAsyncRequest');

    3223. 

  3223.     Result := FWSACancelAsyncRequest(hAsyncTaskHandle);

    3224. 

  3224. end;

    3225. 

  3225. 

    3226. 

  3226. 

    3227. 

  3227. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    3228. 

  3228. function WSocket_Synchronized_WSAAsyncGetHostByName(

    3229. 

  3229.     HWindow: HWND; wMsg: u_int;

    3230. 

  3230.     name, buf: PAnsiChar;

    3231. 

  3231.     buflen: Integer): THandle;

    3232. 

  3232. begin

    3233. 

  3233.     if @FWSAAsyncGetHostByName = nil then

    3234. 

  3234.         @FWSAAsyncGetHostByName := WSocketGetProc('WSAAsyncGetHostByName');

    3235. 

  3235.     Result := FWSAAsyncGetHostByName(HWindow, wMsg, name, buf, buflen);

    3236. 

  3236. end;

    3237. 

  3237. 

    3238. 

  3238. 

    3239. 

  3239. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    3240. 

  3240. function WSocket_Synchronized_WSAAsyncGetHostByAddr(

    3241. 

  3241.     HWindow: HWND;

    3242. 

  3242.     wMsg: u_int; addr: PAnsiChar;

    3243. 

  3243.     len, Struct: Integer;

    3244. 

  3244.     buf: PAnsiChar;

    3245. 

  3245.     buflen: Integer): THandle;

    3246. 

  3246. begin

    3247. 

  3247.     if @FWSAAsyncGetHostByAddr = nil then

    3248. 

  3248.         @FWSAAsyncGetHostByAddr := WSocketGetProc('WSAAsyncGetHostByAddr');

    3249. 

  3249.     Result := FWSAAsyncGetHostByAddr(HWindow, wMsg, addr, len, struct, buf, buflen);

    3250. 

  3250. end;

    3251. 

  3251. 

    3252. 

  3252. 

    3253. 

  3253. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    3254. 

  3254. function WSocket_Synchronized_WSAAsyncSelect(

    3255. 

  3255.     s: TSocket;

    3256. 

  3256.     HWindow: HWND;

    3257. 

  3257.     wMsg: u_int;

    3258. 

  3258.     lEvent: Longint): Integer;

    3259. 

  3259. begin

    3260. 

  3260.     if @FWSAAsyncSelect = nil then

    3261. 

  3261.         @FWSAAsyncSelect := WSocketGetProc('WSAAsyncSelect');

    3262. 

  3262.     Result := FWSAAsyncSelect(s, HWindow, wMsg, lEvent);

    3263. 

  3263. end;

    3264. 

  3264. 

    3265. 

  3265. 

    3266. 

  3266. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    3267. 

  3267. function WSocket_Synchronized_getservbyname(name, proto: PAnsiChar): PServEnt;

    3268. 

  3268. begin

    3269. 

  3269.     if @Fgetservbyname = nil then

    3270. 

  3270.         @Fgetservbyname := WSocketGetProc('getservbyname');

    3271. 

  3271.     Result := Fgetservbyname(name, proto);

    3272. 

  3272. end;

    3273. 

  3273. 

    3274. 

  3274. 

    3275. 

  3275. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    3276. 

  3276. function WSocket_Synchronized_getprotobyname(const Name: AnsiString): PProtoEnt;

    3277. 

  3277. begin

    3278. 

  3278.     if @Fgetprotobyname = nil then

    3279. 

  3279.         @Fgetprotobyname := WSocketGetProc('getprotobyname');

    3280. 

  3280.     Result := Fgetprotobyname(PAnsiChar(Name));

    3281. 

  3281. end;

    3282. 

  3282. 

    3283. 

  3283. 

    3284. 

  3284. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    3285. 

  3285. function WSocket_Synchronized_gethostbyname(name: PAnsiChar): PHostEnt;

    3286. 

  3286. begin

    3287. 

  3287.     if @Fgethostbyname = nil then

    3288. 

  3288.         @Fgethostbyname := WSocketGetProc('gethostbyname');

    3289. 

  3289.     Result := Fgethostbyname(name);

    3290. 

  3290. end;

    3291. 

  3291. 

    3292. 

  3292. 

    3293. 

  3293. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    3294. 

  3294. function WSocket_Synchronized_gethostbyaddr(addr: Pointer; len, Struct: Integer): PHostEnt;

    3295. 

  3295. begin

    3296. 

  3296.     if @Fgethostbyaddr = nil then

    3297. 

  3297.         @Fgethostbyaddr := WSocketGetProc('gethostbyaddr');

    3298. 

  3298.     Result := Fgethostbyaddr(addr, len, Struct);

    3299. 

  3299. end;

    3300. 

  3300. 

    3301. 

  3301. 

    3302. 

  3302. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    3303. 

  3303. function WSocket_Synchronized_gethostname(name: PAnsiChar; len: Integer): Integer;

    3304. 

  3304. begin

    3305. 

  3305.     if @Fgethostname = nil then

    3306. 

  3306.         @Fgethostname := WSocketGetProc('gethostname');

    3307. 

  3307.     Result := Fgethostname(name, len);

    3308. 

  3308. end;

    3309. 

  3309. 

    3310. 

  3310. 

    3311. 

  3311. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    3312. 

  3312. function WSocket_Synchronized_socket(af, Struct, protocol: Integer): TSocket;

    3313. 

  3313. begin

    3314. 

  3314.     if @FOpenSocket= nil then

    3315. 

  3315.         @FOpenSocket := WSocketGetProc('socket');

    3316. 

  3316.     Result := FOpenSocket(af, Struct, protocol);

    3317. 

  3317. end;

    3318. 

  3318. 

    3319. 

  3319. 

    3320. 

  3320. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    3321. 

  3321. function WSocket_Synchronized_shutdown(s: TSocket; how: Integer): Integer;

    3322. 

  3322. begin

    3323. 

  3323.     if @FShutdown = nil then

    3324. 

  3324.         @FShutdown := WSocketGetProc('shutdown');

    3325. 

  3325.     Result := FShutdown(s, how);

    3326. 

  3326. end;

    3327. 

  3327. 

    3328. 

  3328. 

    3329. 

  3329. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    3330. 

  3330. function WSocket_Synchronized_setsockopt(s: TSocket; level, optname: Integer; optval: PAnsiChar;

    3331. 

  3331.                             optlen: Integer): Integer; overload;

    3332. 

  3332. begin

    3333. 

  3333.     if @FSetSockOpt = nil then

    3334. 

  3334.         @FSetSockOpt := WSocketGetProc('setsockopt');

    3335. 

  3335.     Result := FSetSockOpt(s, level, optname, optval, optlen);

    3336. 

  3336. end;

    3337. 

  3337. 

    3338. 

  3338. 

    3339. 

  3339. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    3340. 

  3340. function WSocket_Synchronized_setsockopt(s: TSocket; level, optname: Integer; var optval: TLinger;

    3341. 

  3341.                             optlen: Integer): Integer; overload;

    3342. 

  3342. begin

    3343. 

  3343.     if @FSetSockOpt = nil then

    3344. 

  3344.         @FSetSockOpt := WSocketGetProc('setsockopt');

    3345. 

  3345.     Result := FSetSockOpt(s, level, optname, @optval, optlen);

    3346. 

  3346. end;

    3347. 

  3347. 

    3348. 

  3348. 

    3349. 

  3349. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    3350. 

  3350. function WSocket_Synchronized_setsockopt(s: TSocket; level, optname: Integer; var optval: ip_mreq;

    3351. 

  3351.                             optlen: Integer): Integer; overload;

    3352. 

  3352. begin

    3353. 

  3353.     if @FSetSockOpt = nil then

    3354. 

  3354.         @FSetSockOpt := WSocketGetProc('setsockopt');

    3355. 

  3355.     Result := FSetSockOpt(s, level, optname, @optval, optlen);

    3356. 

  3356. end;

    3357. 

  3357. 

    3358. 

  3358. 

    3359. 

  3359. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    3360. 

  3360. function WSocket_Synchronized_setsockopt(s: TSocket; level, optname: Integer; var optval: Integer;

    3361. 

  3361.                             optlen: Integer): Integer; overload;

    3362. 

  3362. begin

    3363. 

  3363.     if @FSetSockOpt = nil then

    3364. 

  3364.         @FSetSockOpt := WSocketGetProc('setsockopt');

    3365. 

  3365.     Result := FSetSockOpt(s, level, optname, @optval, optlen);

    3366. 

  3366. end;

    3367. 

  3367. 

    3368. 

  3368. 

    3369. 

  3369. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    3370. 

  3370. function WSocket_Synchronized_setsockopt(s: TSocket; level, optname: Integer; var optval: TInAddr;

    3371. 

  3371.                             optlen: Integer): Integer; overload;

    3372. 

  3372. begin

    3373. 

  3373.     if @FSetSockOpt = nil then

    3374. 

  3374.         @FSetSockOpt := WSocketGetProc('setsockopt');

    3375. 

  3375.     Result := FSetSockOpt(s, level, optname, @optval, optlen);

    3376. 

  3376. end;

    3377. 

  3377. 

    3378. 

  3378. 

    3379. 

  3379. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    3380. 

  3380. function WSocket_Synchronized_getsockopt(

    3381. 

  3381.     s: TSocket; level, optname: Integer;

    3382. 

  3382.     optval: PAnsiChar; var optlen: Integer): Integer;

    3383. 

  3383. begin

    3384. 

  3384.     if @FGetSockOpt = nil then

    3385. 

  3385.         @FGetSockOpt := WSocketGetProc('getsockopt');

    3386. 

  3386.     Result := FGetSockOpt(s, level, optname, optval, optlen);

    3387. 

  3387. end;

    3388. 

  3388. 

    3389. 

  3389. 

    3390. 

  3390. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    3391. 

  3391. function WSocket_Synchronized_sendto(

    3392. 

  3392.     s          : TSocket;

    3393. 

  3393.     const Buf  : TWSocketData;

    3394. 

  3394.     len, flags : Integer;

    3395. 

  3395.     var addrto : TSockAddr;

    3396. 

  3396.     tolen      : Integer): Integer;

    3397. 

  3397. begin

    3398. 

  3398.     if @FSendTo = nil then

    3399. 

  3399.         @FSendTo := WSocketGetProc('sendto');

    3400. 

  3400.     Result := FSendTo(s, Buf^, len, flags, addrto, tolen);

    3401. 

  3401. end;

    3402. 

  3402. 

    3403. 

  3403. 

    3404. 

  3404. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    3405. 

  3405. function WSocket_Synchronized_send(s: TSocket; var Buf : TWSocketData; len, flags: Integer): Integer;

    3406. 

  3406. begin

    3407. 

  3407.     if @FSend = nil then

    3408. 

  3408.         @FSend := WSocketGetProc('send');

    3409. 

  3409.     Result := FSend(s, Buf^, len, flags);

    3410. 

  3410. end;

    3411. 

  3411. 

    3412. 

  3412. 

    3413. 

  3413. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    3414. 

  3414. function WSocket_Synchronized_ntohs(netshort: u_short): u_short;

    3415. 

  3415. begin

    3416. 

  3416.     if @Fntohs = nil then

    3417. 

  3417.         @Fntohs := WSocketGetProc('ntohs');

    3418. 

  3418.     Result := Fntohs(netshort);

    3419. 

  3419. end;

    3420. 

  3420. 

    3421. 

  3421. 

    3422. 

  3422. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    3423. 

  3423. function WSocket_Synchronized_ntohl(netlong: u_long): u_long;

    3424. 

  3424. begin

    3425. 

  3425.     if @Fntohl = nil then

    3426. 

  3426.         @Fntohl := WSocketGetProc('ntohl');

    3427. 

  3427.     Result := Fntohl(netlong);

    3428. 

  3428. end;

    3429. 

  3429. 

    3430. 

  3430. 

    3431. 

  3431. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    3432. 

  3432. function WSocket_Synchronized_listen(s: TSocket; backlog: Integer): Integer;

    3433. 

  3433. begin

    3434. 

  3434.     if @FListen = nil then

    3435. 

  3435.         @FListen := WSocketGetProc('listen');

    3436. 

  3436.     Result := FListen(s, backlog);

    3437. 

  3437. end;

    3438. 

  3438. 

    3439. 

  3439. 

    3440. 

  3440. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    3441. 

  3441. function WSocket_Synchronized_ioctlsocket(s: TSocket; cmd: DWORD; var arg: u_long): Integer;

    3442. 

  3442. begin

    3443. 

  3443.     if @FIoctlSocket = nil then

    3444. 

  3444.         @FIoctlSocket := WSocketGetProc('ioctlsocket');

    3445. 

  3445.     Result := FIoctlSocket(s, cmd, arg);

    3446. 

  3446. end;

    3447. 

  3447. 

    3448. 

  3448. 

    3449. 

  3449. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    3450. 

  3450. {$IFDEF COMPILER2_UP}

    3451. 

  3451. function WSocket_Synchronized_WSAIoctl(

    3452. 

  3452.     s                 : TSocket; IoControlCode : DWORD;

    3453. 

  3453.     InBuffer          : Pointer; InBufferSize  : DWORD;

    3454. 

  3454.     OutBuffer         : Pointer; OutBufferSize : DWORD;

    3455. 

  3455.     var BytesReturned : DWORD; Overlapped      : POverlapped;

    3456. 

  3456.     CompletionRoutine : FARPROC): Integer;

    3457. 

  3457. begin

    3458. 

  3458.     if @FWSAIoctl = nil then

    3459. 

  3459.         @FWSAIoctl := WSocket2GetProc('WSAIoctl');

    3460. 

  3460.     Result := FWSAIoctl(s, IoControlCode, InBuffer, InBufferSize, OutBuffer,

    3461. 

  3461.                         OutBufferSize, BytesReturned, Overlapped, CompletionRoutine);

    3462. 

  3462. end;

    3463. 

  3463. {$ENDIF}

    3464. 

  3464. 

    3465. 

  3465. 

    3466. 

  3466. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    3467. 

  3467. function WSocket_Synchronized_inet_ntoa(inaddr: TInAddr): PAnsiChar; 

    3468. 

  3468. begin

    3469. 

  3469.     if @FInet_ntoa = nil then

    3470. 

  3470.         @FInet_ntoa := WSocketGetProc('inet_ntoa');

    3471. 

  3471.     Result := FInet_ntoa(inaddr);

    3472. 

  3472. end;

    3473. 

  3473. 

    3474. 

  3474. 

    3475. 

  3475. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    3476. 

  3476. function WSocket_Synchronized_inet_addr(const cp: AnsiString): u_long; 

    3477. 

  3477. begin

    3478. 

  3478.     if @FInet_addr = nil then

    3479. 

  3479.         @FInet_addr := WSocketGetProc('inet_addr');

    3480. 

  3480.     Result := FInet_addr(PAnsiChar(cp)); 

    3481. 

  3481. end;

    3482. 

  3482. 

    3483. 

  3483. 

    3484. 

  3484. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    3485. 

  3485. function WSocket_Synchronized_htons(hostshort: u_short): u_short;

    3486. 

  3486. begin

    3487. 

  3487.     if @Fhtons = nil then

    3488. 

  3488.         @Fhtons := WSocketGetProc('htons');

    3489. 

  3489.     Result := Fhtons(hostshort);

    3490. 

  3490. end;

    3491. 

  3491. 

    3492. 

  3492. 

    3493. 

  3493. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    3494. 

  3494. function WSocket_Synchronized_htonl(hostlong: u_long): u_long;

    3495. 

  3495. begin

    3496. 

  3496.     if @Fhtonl = nil then

    3497. 

  3497.         @Fhtonl := WSocketGetProc('htonl');

    3498. 

  3498.     Result := Fhtonl(hostlong);

    3499. 

  3499. end;

    3500. 

  3500. 

    3501. 

  3501. 

    3502. 

  3502. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    3503. 

  3503. function WSocket_Synchronized_getsockname(

    3504. 

  3504.     s           : TSocket;

    3505. 

  3505.     var name    : TSockAddr;

    3506. 

  3506.     var namelen : Integer): Integer;

    3507. 

  3507. begin

    3508. 

  3508.     if @FGetSockName = nil then

    3509. 

  3509.         @FGetSockName := WSocketGetProc('getsockname');

    3510. 

  3510.     Result := FGetSockName(s, name, namelen);

    3511. 

  3511. end;

    3512. 

  3512. 

    3513. 

  3513. 

    3514. 

  3514. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    3515. 

  3515. function WSocket_Synchronized_getpeername(

    3516. 

  3516.     s           : TSocket;

    3517. 

  3517.     var name    : TSockAddr;

    3518. 

  3518.     var namelen : Integer): Integer;

    3519. 

  3519. begin

    3520. 

  3520.     if @FGetPeerName = nil then

    3521. 

  3521.         @FGetPeerName := WSocketGetProc('getpeername');

    3522. 

  3522.     Result := FGetPeerName(s, name, namelen);

    3523. 

  3523. end;

    3524. 

  3524. 

    3525. 

  3525. 

    3526. 

  3526. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    3527. 

  3527. function WSocket_Synchronized_connect(

    3528. 

  3528.     s        : TSocket;

    3529. 

  3529.     var name : TSockAddr;

    3530. 

  3530.     namelen  : Integer): Integer;

    3531. 

  3531. begin

    3532. 

  3532.     if @FConnect= nil then

    3533. 

  3533.         @FConnect := WSocketGetProc('connect');

    3534. 

  3534.     Result := FConnect(s, name, namelen);

    3535. 

  3535. end;

    3536. 

  3536. 

    3537. 

  3537. 

    3538. 

  3538. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    3539. 

  3539. function WSocket_Synchronized_closesocket(s: TSocket): Integer;

    3540. 

  3540. begin

    3541. 

  3541.     if @FCloseSocket = nil then

    3542. 

  3542.         @FCloseSocket := WSocketGetProc('closesocket');

    3543. 

  3543.     Result := FCloseSocket(s);

    3544. 

  3544. end;

    3545. 

  3545. 

    3546. 

  3546. 

    3547. 

  3547. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    3548. 

  3548. function WSocket_Synchronized_bind(

    3549. 

  3549.     s: TSocket;

    3550. 

  3550.     var addr: TSockAddr;

    3551. 

  3551.     namelen: Integer): Integer;

    3552. 

  3552. begin

    3553. 

  3553.     if @FBind = nil then

    3554. 

  3554.         @FBind := WSocketGetProc('bind');

    3555. 

  3555.     Result := FBind(s, addr, namelen);

    3556. 

  3556. end;

    3557. 

  3557. 

    3558. 

  3558. 

    3559. 

  3559. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    3560. 

  3560. function WSocket_Synchronized_accept(

    3561. 

  3561.     s: TSocket;

    3562. 

  3562. {$IFDEF DELPHI1} { Delphi 1 }

    3563. 

  3563.     var addr: TSockAddr;

    3564. 

  3564.     var addrlen: Integer): TSocket;

    3565. 

  3565. {$ELSE}

    3566. 

  3566. {$IFDEF VER90} { Delphi 2 }

    3567. 

  3567.     var addr: TSockAddr;

    3568. 

  3568.     var addrlen: Integer): TSocket;

    3569. 

  3569. {$ELSE}{ Delphi 3/4/5, Bcb 1/3/4 }

    3570. 

  3570.     addr: PSockAddr;

    3571. 

  3571.     addrlen: PInteger): TSocket;

    3572. 

  3572. {$ENDIF}

    3573. 

  3573. {$ENDIF}

    3574. 

  3574. begin

    3575. 

  3575.     if @FAccept = nil then

    3576. 

  3576.         @FAccept := WSocketGetProc('accept');

    3577. 

  3577.     Result := FAccept(s, addr, addrlen);

    3578. 

  3578. end;

    3579. 

  3579. 

    3580. 

  3580. 

    3581. 

  3581. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    3582. 

  3582. function WSocket_Synchronized_recv(s: TSocket; var Buf: TWSocketData; len, flags: Integer): Integer;

    3583. 

  3583. begin

    3584. 

  3584.     if @FRecv= nil then

    3585. 

  3585.         @FRecv := WSocketGetProc('recv');

    3586. 

  3586.     Result := FRecv(s, Buf^, len, flags);

    3587. 

  3587. end;

    3588. 

  3588. 

    3589. 

  3589. 

    3590. 

  3590. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    3591. 

  3591. function WSocket_Synchronized_recvfrom(

    3592. 

  3592.     s: TSocket;

    3593. 

  3593.     var Buf: TWSocketData; len, flags: Integer;

    3594. 

  3594.     var from: TSockAddr;

    3595. 

  3595.     var fromlen: Integer): Integer;

    3596. 

  3596. begin

    3597. 

  3597.     if @FRecvFrom = nil then

    3598. 

  3598.         @FRecvFrom := WSocketGetProc('recvfrom');

    3599. 

  3599.     Result := FRecvFrom(s, Buf^, len, flags, from, fromlen);

    3600. 

  3600. end;

    3601. 

  3601. {$ENDIF}

    3602. 

  3602. 

    3603. 

  3603. 

    3604. 

  3604. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    3605. 

  3605. { Winsock is dynamically loaded and unloaded when needed. In some cases     }

    3606. 

  3606. { you may find winsock being loaded and unloaded very often in your app     }

    3607. 

  3607. { This happend for example when you dynamically create a TWSocket and       }

    3608. 

  3608. { destroy a TWSocket when there is no "permanant" TWSocket (that is a       }

    3609. 

  3609. { TWSocket dropped on a persitant form). It is the very inefficiant.        }

    3610. 

  3610. { Calling WSocketForceLoadWinsock will increament the reference count so    }

    3611. 

  3611. { that winsock will not be unloaded when the last TWSocket is destroyed.    }

    3612. 

  3612. procedure WSocketForceLoadWinsock;

    3613. 

  3613. begin

    3614. 

  3614. {$IFDEF WIN32}

    3615. 

  3615. {$IFDEF COMPILER2_UP}

    3616. 

  3616.     _EnterCriticalSection(GWSockCritSect);

    3617. 

  3617.     try

    3618. 

  3618. {$ENDIF}

    3619. 

  3619.         if not WSocketGForced then begin

    3620. 

  3620.             WSocketGForced := TRUE;

    3621. 

  3621.             Inc(WSocketGCount);

    3622. 

  3622.             WSocketGetProc('');

    3623. 

  3623.         end;

    3624. 

  3624. {$IFDEF COMPILER2_UP}

    3625. 

  3625.     finally

    3626. 

  3626.         _LeaveCriticalSection(GWSockCritSect);

    3627. 

  3627.     end;

    3628. 

  3628. {$ENDIF}

    3629. 

  3629. {$ENDIF}

    3630. 

  3630. end;

    3631. 

  3631. 

    3632. 

  3632. 

    3633. 

  3633. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    3634. 

  3634. { Cancel the operation done with WSocketForceLoadWinsock.                   }

    3635. 

  3635. procedure WSocketCancelForceLoadWinsock;

    3636. 

  3636. begin

    3637. 

  3637. {$IFDEF WIN32}

    3638. 

  3638. {$IFDEF COMPILER2_UP}

    3639. 

  3639.     _EnterCriticalSection(GWSockCritSect);

    3640. 

  3640.     try

    3641. 

  3641. {$ENDIF}

    3642. 

  3642.         if WSocketGForced then begin

    3643. 

  3643.             WSocketGForced := FALSE;

    3644. 

  3644.             Dec(WSocketGCount);

    3645. 

  3645.             if WSocketGCount <= 0 then

    3646. 

  3646.                 WSocketUnloadWinsock;

    3647. 

  3647.         end;

    3648. 

  3648. {$IFDEF COMPILER2_UP}

    3649. 

  3649.     finally

    3650. 

  3650.         _LeaveCriticalSection(GWSockCritSect);

    3651. 

  3651.     end;

    3652. 

  3652. {$ENDIF}

    3653. 

  3653. {$ENDIF}

    3654. 

  3654. end;

    3655. 

  3655. 

    3656. 

  3656. 

    3657. 

  3657. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    3658. 

  3658. procedure WSocketUnloadWinsock;

    3659. 

  3659. begin

    3660. 

  3660. {$IFDEF WIN32}

    3661. 

  3661. {$IFDEF NEVER}   { 14/02/99 }

    3662. 

  3662.     if DllStarted then begin

    3663. 

  3663.         DllStarted := FALSE;

    3664. 

  3664.         WSocket_WSACleanup;

    3665. 

  3665.     end;

    3666. 

  3666. {$ENDIF}

    3667. 

  3667. {$IFDEF COMPILER2_UP}

    3668. 

  3668.     _EnterCriticalSection(GWSockCritSect);

    3669. 

  3669.     try

    3670. 

  3670. {$ENDIF}

    3671. 

  3671.         if (FDllHandle <> 0) and (WSocketGCount = 0) then begin

    3672. 

  3672.             WSocket_Synchronized_WSACleanup;

    3673. 

  3673. {$IFDEF COMPILER2_UP}

    3674. 

  3674.             if FDll2Handle <> 0 then begin

    3675. 

  3675.                 _FreeLibrary(FDll2Handle);

    3676. 

  3676.                 FDll2Handle        := 0;

    3677. 

  3677.                 FWSAIoctl          := nil;

    3678. 

  3678.             end;

    3679. 

  3679. {$ENDIF}

    3680. 

  3680.             _FreeLibrary(FDllHandle);

    3681. 

  3681.             FDllHandle             := 0;

    3682. 

  3682.             FWSAStartup            := nil;

    3683. 

  3683.             FWSACleanup            := nil;

    3684. 

  3684.             FWSASetLastError       := nil;

    3685. 

  3685.             FWSAGetLastError       := nil;

    3686. 

  3686.             FWSACancelAsyncRequest := nil;

    3687. 

  3687.             FWSAAsyncGetHostByName := nil;

    3688. 

  3688.             FWSAAsyncGetHostByAddr := nil;

    3689. 

  3689.             FWSAAsyncSelect        := nil;

    3690. 

  3690.             FGetServByName         := nil;

    3691. 

  3691.             FGetProtoByName        := nil;

    3692. 

  3692.             FGetHostByName         := nil;

    3693. 

  3693.             FGetHostByAddr         := nil;

    3694. 

  3694.             FGetHostName           := nil;

    3695. 

  3695.             FOpenSocket            := nil;

    3696. 

  3696.             FShutdown              := nil;

    3697. 

  3697.             FSetSockOpt            := nil;

    3698. 

  3698.             FGetSockOpt            := nil;

    3699. 

  3699.             FSendTo                := nil;

    3700. 

  3700.             FSend                  := nil;

    3701. 

  3701.             FRecv                  := nil;

    3702. 

  3702.             FRecvFrom              := nil;

    3703. 

  3703.             Fntohs                 := nil;

    3704. 

  3704.             Fntohl                 := nil;

    3705. 

  3705.             FListen                := nil;

    3706. 

  3706.             FIoctlSocket           := nil;

    3707. 

  3707. {$IFDEF COMPILER2_UP}

    3708. 

  3708.             FWSAIoctl              := nil;

    3709. 

  3709. {$ENDIF}

    3710. 

  3710.             FInet_ntoa             := nil;

    3711. 

  3711.             FInet_addr             := nil;

    3712. 

  3712.             Fhtons                 := nil;

    3713. 

  3713.             Fhtonl                 := nil;

    3714. 

  3714.             FGetSockName           := nil;

    3715. 

  3715.             FGetPeerName           := nil;

    3716. 

  3716.             FConnect               := nil;

    3717. 

  3717.             FCloseSocket           := nil;

    3718. 

  3718.             FBind                  := nil;

    3719. 

  3719.             FAccept                := nil;

    3720. 

  3720.         end;

    3721. 

  3721.         WSocketGForced := FALSE;

    3722. 

  3722. {$IFDEF COMPILER2_UP}

    3723. 

  3723.     finally

    3724. 

  3724.         _LeaveCriticalSection(GWSockCritSect);

    3725. 

  3725.     end;

    3726. 

  3726. {$ENDIF}

    3727. 

  3727. {$ENDIF}

    3728. 

  3728. end;

    3729. 

  3729. 

    3730. 

  3730. 

    3731. 

  3731. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    3732. 

  3732. {$IFDEF WIN32}

    3733. 

  3733. function WSocketGetProc(const ProcName : AnsiString) : Pointer;

    3734. 

  3734. var

    3735. 

  3735.     LastError : LongInt;

    3736. 

  3736. begin

    3737. 

  3737.     { Prevents compiler warning "Return value might be undefined"  }

    3738. 

  3738.     Result := nil;

    3739. 

  3739. 

    3740. 

  3740.     _EnterCriticalSection(GWSockCritSect);

    3741. 

  3741.     try

    3742. 

  3742.         if FDllHandle = 0 then begin

    3743. 

  3743.             FDllHandle := _LoadLibrary(@winsocket[1]);

    3744. 

  3744.             if FDllHandle = 0 then

    3745. 

  3745.              {   raise ESocketException.Create('Unable to load ' + winsocket +

    3746. 

  3746.                                               ' Error #' + IntToStr(GetLastError));}

    3747. 

  3747.                 raise ESocketException.Create('Unable to load ' + winsocket +

    3748. 

  3748.                               ' - ' + GetWindowsErr (GetLastError)); { V5.26 }

    3749. 

  3749.             LastError := WSocket_Synchronized_WSAStartup(MAKEWORD(GReqVerLow, GReqVerHigh) { $202 $101}, GInitData);

    3750. 

  3750.             if LastError <> 0 then begin

    3751. 

  3751.               {  raise ESocketException.CreateFmt('%s: WSAStartup error #%d',

    3752. 

  3752.                                                  [winsocket, LastError]);  }

    3753. 

  3753.                 raise ESocketException.Create('Winsock startup error ' + winsocket +

    3754. 

  3754.                                      ' - ' + GetWindowsErr (LastError)); { V5.26 }

    3755. 

  3755.             end;

    3756. 

  3756.         end;

    3757. 

  3757.         if Length(ProcName) = 0 then

    3758. 

  3758.             Result := nil

    3759. 

  3759.         else begin

    3760. 

  3760.             Result := _GetProcAddress(FDllHandle, @ProcName[1]);

    3761. 

  3761.             if Result = nil then

    3762. 

  3762.                 raise ESocketException.Create('Procedure ' + String(ProcName) +

    3763. 

  3763.                                               ' not found in ' + winsocket +

    3764. 

  3764.                                    ' - ' + GetWindowsErr (GetLastError)); { V5.26 }

    3765. 

  3765.         end;

    3766. 

  3766.     finally

    3767. 

  3767.         _LeaveCriticalSection(GWSockCritSect);

    3768. 

  3768.     end;

    3769. 

  3769. end;

    3770. 

  3770. 

    3771. 

  3771. 

    3772. 

  3772. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    3773. 

  3773. function WSocket2GetProc(const ProcName : AnsiString) : Pointer;

    3774. 

  3774. begin

    3775. 

  3775.     { Prevents compiler warning "Return value might be undefined"  }

    3776. 

  3776.     Result := nil;

    3777. 

  3777. 

    3778. 

  3778.     _EnterCriticalSection(GWSockCritSect);

    3779. 

  3779.     try

    3780. 

  3780.         if FDll2Handle = 0 then begin

    3781. 

  3781.             { Be sure to have main winsock.dll loaded }

    3782. 

  3782.             if FDllHandle = 0 then

    3783. 

  3783.                 WSocketGetProc('');

    3784. 

  3784.             FDll2Handle := _LoadLibrary(@winsocket2[1]);

    3785. 

  3785.             if FDll2Handle = 0 then

    3786. 

  3786.               {  raise ESocketException.Create('Unable to load ' + winsocket2 +

    3787. 

  3787.                                               ' Error #' + IntToStr(GetLastError));  }

    3788. 

  3788.                 raise ESocketException.Create('Unable to load ' + winsocket2 +

    3789. 

  3789.                               ' - ' + GetWindowsErr (GetLastError)); { V5.26 }

    3790. 

  3790.         end;

    3791. 

  3791.         if Length(ProcName) = 0 then

    3792. 

  3792.             Result := nil

    3793. 

  3793.         else begin

    3794. 

  3794.             Result := _GetProcAddress(FDll2Handle, @ProcName[1]);

    3795. 

  3795.             if Result = nil then

    3796. 

  3796.                 raise ESocketException.Create('Procedure ' + String(ProcName) +

    3797. 

  3797.                                               ' not found in ' + winsocket2 +

    3798. 

  3798.                                 ' - ' + GetWindowsErr (GetLastError)); { V5.26 }

    3799. 

  3799.         end;

    3800. 

  3800.     finally

    3801. 

  3801.         _LeaveCriticalSection(GWSockCritSect);

    3802. 

  3802.     end;

    3803. 

  3803. end;

    3804. 

  3804. 

    3805. 

  3805. 

    3806. 

  3806. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    3807. 

  3807. function WinsockInfo : TWSADATA;

    3808. 

  3808. begin

    3809. 

  3809. {    LoadWinsock(winsocket); 14/02/99 }

    3810. 

  3810.     { Load winsock and initialize it as needed }

    3811. 

  3811.     _EnterCriticalSection(GWSockCritSect);

    3812. 

  3812.     try

    3813. 

  3813.         WSocketGetProc('');

    3814. 

  3814.         Result := GInitData;

    3815. 

  3815.         { If no socket created, then unload winsock immediately }

    3816. 

  3816.         if WSocketGCount <= 0 then

    3817. 

  3817.             WSocketUnloadWinsock;

    3818. 

  3818.     finally

    3819. 

  3819.         _LeaveCriticalSection(GWSockCritSect);

    3820. 

  3820.     end;

    3821. 

  3821. end;

    3822. 

  3822. {$ENDIF}

    3823. 

  3823. 

    3824. 

  3824. 

    3825. 

  3825. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    3826. 

  3826. {$IFDEF CLR}

    3827. 

  3827. function WSocket_Synchronized_WSAStartup(

    3828. 

  3828.     wVersionRequired : Word;

    3829. 

  3829.     out WSData       : TWSAData): Integer;

    3830. 

  3830. begin

    3831. 

  3831.     if GWSAStartupCalled then

    3832. 

  3832.         Result := 0

    3833. 

  3833.     else begin

    3834. 

  3834.         Result := OverByteIcsWinsock.WSAStartup(wVersionRequired, WSData);

    3835. 

  3835.         GWSAStartupCalled := TRUE;

    3836. 

  3836.     end;

    3837. 

  3837. end;

    3838. 

  3838. 

    3839. 

  3839. 

    3840. 

  3840. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    3841. 

  3841. function WSocket_Synchronized_WSACleanup : Integer;

    3842. 

  3842. begin

    3843. 

  3843.     Result := OverByteIcsWinsock.WSACleanup;

    3844. 

  3844.     GWSAStartupCalled := FALSE;

    3845. 

  3845. end;

    3846. 

  3846. 

    3847. 

  3847. 

    3848. 

  3848. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    3849. 

  3849. procedure WSocket_Synchronized_WSASetLastError(ErrCode: Integer);

    3850. 

  3850. begin

    3851. 

  3851.     if not GWSAStartupCalled then

    3852. 

  3852.         WSocket_Synchronized_WSAStartup(MAKEWORD(GReqVerLow, GReqVerHigh), GInitData);

    3853. 

  3853.     OverByteIcsWinsock.WsaSetLastError(ErrCode);

    3854. 

  3854. end;

    3855. 

  3855. 

    3856. 

  3856. 

    3857. 

  3857. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    3858. 

  3858. function WSocket_Synchronized_WSAGetLastError: Integer;

    3859. 

  3859. begin

    3860. 

  3860.     if not GWSAStartupCalled then

    3861. 

  3861.         WSocket_Synchronized_WSAStartup(MAKEWORD(GReqVerLow, GReqVerHigh), GInitData);

    3862. 

  3862.     Result := OverByteIcsWinsock.WSAGetLastError;

    3863. 

  3863. end;

    3864. 

  3864. 

    3865. 

  3865. 

    3866. 

  3866. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    3867. 

  3867. function WSocket_Synchronized_WSACancelAsyncRequest(hAsyncTaskHandle: THandle): Integer;

    3868. 

  3868. begin

    3869. 

  3869.     if not GWSAStartupCalled then

    3870. 

  3870.         WSocket_Synchronized_WSAStartup(MAKEWORD(GReqVerLow, GReqVerHigh), GInitData);

    3871. 

  3871.     Result := OverByteIcsWinsock.WSACancelAsyncRequest(hAsyncTaskHandle);

    3872. 

  3872. end;

    3873. 

  3873. 

    3874. 

  3874. 

    3875. 

  3875. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    3876. 

  3876. function WSocket_Synchronized_WSAAsyncGetHostByName(

    3877. 

  3877.     HWindow: HWND; wMsg: u_int;

    3878. 

  3878.     const name : String; buf: IntPtr;

    3879. 

  3879.     buflen: Integer): THandle;

    3880. 

  3880. begin

    3881. 

  3881.     if not GWSAStartupCalled then

    3882. 

  3882.         WSocket_Synchronized_WSAStartup(MAKEWORD(GReqVerLow, GReqVerHigh), GInitData);

    3883. 

  3883.     Result := OverByteIcsWinsock.WSAAsyncGetHostByName(

    3884. 

  3884.                   HWindow, wMsg, name, buf, buflen);

    3885. 

  3885. end;

    3886. 

  3886. 

    3887. 

  3887. 

    3888. 

  3888. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    3889. 

  3889. function WSocket_Synchronized_WSAAsyncGetHostByAddr(

    3890. 

  3890.     HWindow: HWND;

    3891. 

  3891.     wMsg: u_int; var addr: u_long;

    3892. 

  3892.     len, Struct: Integer;

    3893. 

  3893.     buf: IntPtr;

    3894. 

  3894.     buflen: Integer): THandle;

    3895. 

  3895. begin

    3896. 

  3896.     if not GWSAStartupCalled then

    3897. 

  3897.         WSocket_Synchronized_WSAStartup(MAKEWORD(GReqVerLow, GReqVerHigh), GInitData);

    3898. 

  3898.     Result := OverByteIcsWinsock.WSAAsyncGetHostByAddr(

    3899. 

  3899.                    HWindow, wMsg, addr, len, struct, buf, buflen);

    3900. 

  3900. end;

    3901. 

  3901. 

    3902. 

  3902. 

    3903. 

  3903. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    3904. 

  3904. function WSocket_Synchronized_WSAAsyncSelect(

    3905. 

  3905.     S       : TSocket;

    3906. 

  3906.     HWindow : HWND;

    3907. 

  3907.     wMsg    : u_int;

    3908. 

  3908.     lEvent  : Longint): Integer;

    3909. 

  3909. begin

    3910. 

  3910.     if not GWSAStartupCalled then

    3911. 

  3911.         WSocket_Synchronized_WSAStartup(MAKEWORD(GReqVerLow, GReqVerHigh), GInitData);

    3912. 

  3912.     Result := OverByteIcsWinsock.WSAAsyncSelect(S, HWindow, wMsg, lEvent);

    3913. 

  3913. end;

    3914. 

  3914. 

    3915. 

  3915. 

    3916. 

  3916. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    3917. 

  3917. function WSocket_Synchronized_getservbyname(const Name, Proto: String): IntPtr;

    3918. 

  3918. begin

    3919. 

  3919.     if not GWSAStartupCalled then

    3920. 

  3920.         WSocket_Synchronized_WSAStartup(MAKEWORD(GReqVerLow, GReqVerHigh), GInitData);

    3921. 

  3921.     Result := OverByteIcsWinsock.getservbyname(Name, Proto);

    3922. 

  3922. end;

    3923. 

  3923. 

    3924. 

  3924. 

    3925. 

  3925. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    3926. 

  3926. function WSocket_Synchronized_getprotobyname(const name: String): IntPtr;

    3927. 

  3927. begin

    3928. 

  3928.     if not GWSAStartupCalled then

    3929. 

  3929.         WSocket_Synchronized_WSAStartup(MAKEWORD(GReqVerLow, GReqVerHigh), GInitData);

    3930. 

  3930.     Result := OverByteIcsWinsock.getprotobyname(name);

    3931. 

  3931. end;

    3932. 

  3932. 

    3933. 

  3933. 

    3934. 

  3934. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    3935. 

  3935. function WSocket_Synchronized_gethostbyname(const Name: String): IntPtr;

    3936. 

  3936. begin

    3937. 

  3937.     if not GWSAStartupCalled then

    3938. 

  3938.         WSocket_Synchronized_WSAStartup(MAKEWORD(GReqVerLow, GReqVerHigh), GInitData);

    3939. 

  3939.     Result := OverByteIcsWinsock.gethostbyname(Name);

    3940. 

  3940. end;

    3941. 

  3941. 

    3942. 

  3942. 

    3943. 

  3943. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    3944. 

  3944. function WSocket_Synchronized_gethostbyaddr(

    3945. 

  3945.     var addr: u_long; len, Struct: Integer): IntPtr;

    3946. 

  3946. begin

    3947. 

  3947.     if not GWSAStartupCalled then

    3948. 

  3948.         WSocket_Synchronized_WSAStartup(MAKEWORD(GReqVerLow, GReqVerHigh), GInitData);

    3949. 

  3949.     Result := OverByteIcsWinsock.gethostbyaddr(addr, len, Struct);

    3950. 

  3950. end;

    3951. 

  3951. 

    3952. 

  3952. 

    3953. 

  3953. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    3954. 

  3954. function WSocket_Synchronized_gethostname(out Name: String): Integer;

    3955. 

  3955. var

    3956. 

  3956.     SB: System.Text.StringBuilder;

    3957. 

  3957. begin

    3958. 

  3958.     if not GWSAStartupCalled then

    3959. 

  3959.         WSocket_Synchronized_WSAStartup(MAKEWORD(GReqVerLow, GReqVerHigh), GInitData);

    3960. 

  3960.     SB     := System.Text.StringBuilder.Create(256);

    3961. 

  3961.     Result := OverByteIcsWinsock.gethostname(SB, SB.Capacity);

    3962. 

  3962.     if Result <> 0 then

    3963. 

  3963.         Name := ''

    3964. 

  3964.     else

    3965. 

  3965.         Name := SB.ToString;

    3966. 

  3966. end;

    3967. 

  3967. 

    3968. 

  3968. 

    3969. 

  3969. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    3970. 

  3970. function WSocket_Synchronized_socket(af, Struct, protocol: Integer): TSocket;

    3971. 

  3971. begin

    3972. 

  3972.     if not GWSAStartupCalled then

    3973. 

  3973.         WSocket_Synchronized_WSAStartup(MAKEWORD(GReqVerLow, GReqVerHigh), GInitData);

    3974. 

  3974.     Result := OverByteIcsWinsock.socket(af, Struct, protocol);

    3975. 

  3975. end;

    3976. 

  3976. 

    3977. 

  3977. 

    3978. 

  3978. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    3979. 

  3979. function WSocket_Synchronized_shutdown(s: TSocket; how: Integer): Integer;

    3980. 

  3980. begin

    3981. 

  3981.     if not GWSAStartupCalled then

    3982. 

  3982.         WSocket_Synchronized_WSAStartup(MAKEWORD(GReqVerLow, GReqVerHigh), GInitData);

    3983. 

  3983.     Result := OverByteIcsWinsock.shutdown(s, how);

    3984. 

  3984. end;

    3985. 

  3985. 

    3986. 

  3986. 

    3987. 

  3987. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    3988. 

  3988. function WSocket_Synchronized_setsockopt(

    3989. 

  3989.     s              : TSocket;

    3990. 

  3990.     level, optname : Integer;

    3991. 

  3991.     var optval     : Integer;

    3992. 

  3992.     optlen         : Integer): Integer; overload;

    3993. 

  3993. begin

    3994. 

  3994.     if not GWSAStartupCalled then

    3995. 

  3995.         WSocket_Synchronized_WSAStartup(MAKEWORD(GReqVerLow, GReqVerHigh), GInitData);

    3996. 

  3996.     Result := OverByteIcsWinsock.setsockopt_integer(

    3997. 

  3997.                   S, Level, OptName, OptVal, 4);

    3998. 

  3998. end;

    3999. 

  3999. 

    4000. 

  4000. 

    4001. 

  4001. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    4002. 

  4002. function WSocket_Synchronized_setsockopt(

    4003. 

  4003.     s              : TSocket;

    4004. 

  4004.     level, optname : Integer;

    4005. 

  4005.     var optval     : ip_mreq;

    4006. 

  4006.     optlen         : Integer): Integer; overload;

    4007. 

  4007. begin

    4008. 

  4008.     if not GWSAStartupCalled then

    4009. 

  4009.         WSocket_Synchronized_WSAStartup(MAKEWORD(GReqVerLow, GReqVerHigh), GInitData);

    4010. 

  4010.     Result := OverByteIcsWinsock.setsockopt_ip_mreq(

    4011. 

  4011.                   S, Level, OptName, OptVal, 8);

    4012. 

  4012. end;

    4013. 

  4013. 

    4014. 

  4014. 

    4015. 

  4015. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    4016. 

  4016. function WSocket_Synchronized_setsockopt(

    4017. 

  4017.     s              : TSocket;

    4018. 

  4018.     level, optname : Integer;

    4019. 

  4019.     var optval     : TInAddr;

    4020. 

  4020.     optlen         : Integer): Integer; overload;

    4021. 

  4021. begin

    4022. 

  4022.     if not GWSAStartupCalled then

    4023. 

  4023.         WSocket_Synchronized_WSAStartup(MAKEWORD(GReqVerLow, GReqVerHigh), GInitData);

    4024. 

  4024.     Result := OverByteIcsWinsock.setsockopt_tinaddr(

    4025. 

  4025.                   S, Level, OptName, OptVal, 4);

    4026. 

  4026. end;

    4027. 

  4027. 

    4028. 

  4028. 

    4029. 

  4029. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    4030. 

  4030. function WSocket_Synchronized_setsockopt(

    4031. 

  4031.     s              : TSocket;

    4032. 

  4032.     level, optname : Integer;

    4033. 

  4033.     var optval     : TLinger;

    4034. 

  4034.     optlen         : Integer): Integer; overload;

    4035. 

  4035. begin

    4036. 

  4036.     if not GWSAStartupCalled then

    4037. 

  4037.         WSocket_Synchronized_WSAStartup(MAKEWORD(GReqVerLow, GReqVerHigh), GInitData);

    4038. 

  4038.     Result := OverByteIcsWinsock.setsockopt_tlinger(

    4039. 

  4039.                   S, Level, OptName, OptVal, 4);

    4040. 

  4040. end;

    4041. 

  4041. 

    4042. 

  4042. 

    4043. 

  4043. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    4044. 

  4044. function WSocket_Synchronized_getsockopt(

    4045. 

  4045.     s: TSocket; level, optname: Integer;

    4046. 

  4046.     var optval: Integer; var optlen: Integer): Integer; overload;

    4047. 

  4047. begin

    4048. 

  4048.     if not GWSAStartupCalled then

    4049. 

  4049.         WSocket_Synchronized_WSAStartup(MAKEWORD(GReqVerLow, GReqVerHigh), GInitData);

    4050. 

  4050.     Result := OverByteIcsWinsock.getsockopt_integer(

    4051. 

  4051.                   s, level, optname, optval, optlen);

    4052. 

  4052. end;

    4053. 

  4053. 

    4054. 

  4054. 

    4055. 

  4055. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    4056. 

  4056. function WSocket_Synchronized_getsockopt(

    4057. 

  4057.     s: TSocket; level, optname: Integer;

    4058. 

  4058.     var optval: ip_mreq; var optlen: Integer): Integer; overload;

    4059. 

  4059. begin

    4060. 

  4060.     if not GWSAStartupCalled then

    4061. 

  4061.         WSocket_Synchronized_WSAStartup(MAKEWORD(GReqVerLow, GReqVerHigh), GInitData);

    4062. 

  4062.     Result := OverByteIcsWinsock.getsockopt_ip_mreq(

    4063. 

  4063.                   s, level, optname, optval, optlen);

    4064. 

  4064. end;

    4065. 

  4065. 

    4066. 

  4066. 

    4067. 

  4067. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    4068. 

  4068. function WSocket_Synchronized_getsockopt(

    4069. 

  4069.     s: TSocket; level, optname: Integer;

    4070. 

  4070.     var optval: TInAddr; var optlen: Integer): Integer; overload;

    4071. 

  4071. begin

    4072. 

  4072.     if not GWSAStartupCalled then

    4073. 

  4073.         WSocket_Synchronized_WSAStartup(MAKEWORD(GReqVerLow, GReqVerHigh), GInitData);

    4074. 

  4074.     Result := OverByteIcsWinsock.getsockopt_tinaddr(

    4075. 

  4075.                   s, level, optname, optval, optlen);

    4076. 

  4076. end;

    4077. 

  4077. 

    4078. 

  4078. 

    4079. 

  4079. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    4080. 

  4080. function WSocket_Synchronized_getsockopt(

    4081. 

  4081.     s: TSocket; level, optname: Integer;

    4082. 

  4082.     var optval: TLinger; var optlen: Integer): Integer; overload;

    4083. 

  4083. begin

    4084. 

  4084.     if not GWSAStartupCalled then

    4085. 

  4085.         WSocket_Synchronized_WSAStartup(MAKEWORD(GReqVerLow, GReqVerHigh), GInitData);

    4086. 

  4086.     Result := OverByteIcsWinsock.getsockopt_tlinger(

    4087. 

  4087.                   s, level, optname, optval, optlen);

    4088. 

  4088. end;

    4089. 

  4089. 

    4090. 

  4090. 

    4091. 

  4091. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    4092. 

  4092. function WSocket_Synchronized_sendto(

    4093. 

  4093.     s          : TSocket;

    4094. 

  4094.     const Buf  : TBytes;

    4095. 

  4095.     len, flags : Integer;

    4096. 

  4096.     var addrto : TSockAddr;

    4097. 

  4097.     tolen      : Integer): Integer;

    4098. 

  4098. begin

    4099. 

  4099.     if not GWSAStartupCalled then

    4100. 

  4100.         WSocket_Synchronized_WSAStartup(MAKEWORD(GReqVerLow, GReqVerHigh), GInitData);

    4101. 

  4101.     Result := OverByteIcsWinsock.sendto(

    4102. 

  4102.                   s, Buf, len, flags, addrto, SizeOfTSockAddr);

    4103. 

  4103. end;

    4104. 

  4104. 

    4105. 

  4105. 

    4106. 

  4106. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    4107. 

  4107. function WSocket_Synchronized_send(

    4108. 

  4108.     s: TSocket;

    4109. 

  4109.     const Buf : TBytes;

    4110. 

  4110.     len, flags: Integer): Integer;

    4111. 

  4111. begin

    4112. 

  4112.     if not GWSAStartupCalled then

    4113. 

  4113.         WSocket_Synchronized_WSAStartup(MAKEWORD(GReqVerLow, GReqVerHigh), GInitData);

    4114. 

  4114.     Result := OverByteIcsWinsock.send(s, Buf, len, flags);

    4115. 

  4115. end;

    4116. 

  4116. 

    4117. 

  4117. 

    4118. 

  4118. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    4119. 

  4119. function WSocket_Synchronized_ntohs(netshort: u_short): u_short;

    4120. 

  4120. begin

    4121. 

  4121.     if not GWSAStartupCalled then

    4122. 

  4122.         WSocket_Synchronized_WSAStartup(MAKEWORD(GReqVerLow, GReqVerHigh), GInitData);

    4123. 

  4123.     Result := OverByteIcsWinsock.ntohs(netshort);

    4124. 

  4124. end;

    4125. 

  4125. 

    4126. 

  4126. 

    4127. 

  4127. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    4128. 

  4128. function WSocket_Synchronized_ntohl(netlong: u_long): u_long;

    4129. 

  4129. begin

    4130. 

  4130.     if not GWSAStartupCalled then

    4131. 

  4131.         WSocket_Synchronized_WSAStartup(MAKEWORD(GReqVerLow, GReqVerHigh), GInitData);

    4132. 

  4132.     Result := OverByteIcsWinsock.ntohl(netlong);

    4133. 

  4133. end;

    4134. 

  4134. 

    4135. 

  4135. 

    4136. 

  4136. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    4137. 

  4137. function WSocket_Synchronized_listen(s: TSocket; backlog: Integer): Integer;

    4138. 

  4138. begin

    4139. 

  4139.     if not GWSAStartupCalled then

    4140. 

  4140.         WSocket_Synchronized_WSAStartup(MAKEWORD(GReqVerLow, GReqVerHigh), GInitData);

    4141. 

  4141.     Result := OverByteIcsWinsock.listen(s, backlog);

    4142. 

  4142. end;

    4143. 

  4143. 

    4144. 

  4144. 

    4145. 

  4145. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    4146. 

  4146. function WSocket_Synchronized_ioctlsocket(s: TSocket; cmd: DWORD; var arg: u_long): Integer;

    4147. 

  4147. begin

    4148. 

  4148.     if not GWSAStartupCalled then

    4149. 

  4149.         WSocket_Synchronized_WSAStartup(MAKEWORD(GReqVerLow, GReqVerHigh), GInitData);

    4150. 

  4150.     Result := OverByteIcsWinsock.ioctlsocket(s, cmd, arg);

    4151. 

  4151. end;

    4152. 

  4152. 

    4153. 

  4153. 

    4154. 

  4154. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    4155. 

  4155. function WSocket_Synchronized_inet_ntoa(inaddr: TInAddr): String;

    4156. 

  4156. begin

    4157. 

  4157.     if not GWSAStartupCalled then

    4158. 

  4158.         WSocket_Synchronized_WSAStartup(MAKEWORD(GReqVerLow, GReqVerHigh), GInitData);

    4159. 

  4159.     Result := OverByteIcsWinsock.inet_ntoa(inaddr);

    4160. 

  4160. end;

    4161. 

  4161. 

    4162. 

  4162. 

    4163. 

  4163. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    4164. 

  4164. function WSocket_Synchronized_inet_addr(const cp: String): u_long;

    4165. 

  4165. begin

    4166. 

  4166.     if not GWSAStartupCalled then

    4167. 

  4167.         WSocket_Synchronized_WSAStartup(MAKEWORD(GReqVerLow, GReqVerHigh), GInitData);

    4168. 

  4168.     Result := OverByteIcsWinsock.inet_addr(cp);

    4169. 

  4169. end;

    4170. 

  4170. 

    4171. 

  4171. 

    4172. 

  4172. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    4173. 

  4173. function WSocket_Synchronized_htons(hostshort: u_short): u_short;

    4174. 

  4174. begin

    4175. 

  4175.     if not GWSAStartupCalled then

    4176. 

  4176.         WSocket_Synchronized_WSAStartup(MAKEWORD(GReqVerLow, GReqVerHigh), GInitData);

    4177. 

  4177.     Result := OverByteIcsWinsock.htons(hostshort);

    4178. 

  4178. end;

    4179. 

  4179. 

    4180. 

  4180. 

    4181. 

  4181. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    4182. 

  4182. function WSocket_Synchronized_htonl(hostlong: u_long): u_long;

    4183. 

  4183. begin

    4184. 

  4184.     if not GWSAStartupCalled then

    4185. 

  4185.         WSocket_Synchronized_WSAStartup(MAKEWORD(GReqVerLow, GReqVerHigh), GInitData);

    4186. 

  4186.     Result := OverByteIcsWinsock.htonl(hostlong);

    4187. 

  4187. end;

    4188. 

  4188. 

    4189. 

  4189. 

    4190. 

  4190. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    4191. 

  4191. function WSocket_Synchronized_getsockname(

    4192. 

  4192.     S           : TSocket;

    4193. 

  4193.     var Name    : TSockAddr;

    4194. 

  4194.     var NameLen : Integer): Integer;

    4195. 

  4195. var

    4196. 

  4196.     APINameLen : Integer;

    4197. 

  4197. begin

    4198. 

  4198.     APINameLen := SizeOfTSockAddr;

    4199. 

  4199.     if not GWSAStartupCalled then

    4200. 

  4200.         WSocket_Synchronized_WSAStartup(MAKEWORD(GReqVerLow, GReqVerHigh), GInitData);

    4201. 

  4201.     Result     := OverByteIcsWinsock.getsockname(S, Name, APINameLen);

    4202. 

  4202. end;

    4203. 

  4203. 

    4204. 

  4204. 

    4205. 

  4205. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    4206. 

  4206. function WSocket_Synchronized_getpeername(

    4207. 

  4207.     S           : TSocket;

    4208. 

  4208.     out Name    : TSockAddr;

    4209. 

  4209.     var NameLen : Integer): Integer;

    4210. 

  4210. var

    4211. 

  4211.     APINameLen : Integer;

    4212. 

  4212. begin

    4213. 

  4213.     APINameLen := SizeOfTSockAddr;

    4214. 

  4214.     if not GWSAStartupCalled then

    4215. 

  4215.         WSocket_Synchronized_WSAStartup(MAKEWORD(GReqVerLow, GReqVerHigh), GInitData);

    4216. 

  4216.     Result     := OverByteIcsWinsock.getpeername(S, Name, APINameLen);

    4217. 

  4217. end;

    4218. 

  4218. 

    4219. 

  4219. 

    4220. 

  4220. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    4221. 

  4221. function WSocket_Synchronized_connect(

    4222. 

  4222.     S        : TSocket;

    4223. 

  4223.     var Name : TSockAddr;

    4224. 

  4224.     NameLen  : Integer): Integer;

    4225. 

  4225. begin

    4226. 

  4226.     if not GWSAStartupCalled then

    4227. 

  4227.         WSocket_Synchronized_WSAStartup(MAKEWORD(GReqVerLow, GReqVerHigh), GInitData);

    4228. 

  4228.     Result := OverByteIcsWinsock.connect(S, Name, SizeOfTSockAddr);

    4229. 

  4229. end;

    4230. 

  4230. 

    4231. 

  4231. 

    4232. 

  4232. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    4233. 

  4233. function WSocket_Synchronized_closesocket(s: TSocket): Integer;

    4234. 

  4234. begin

    4235. 

  4235.     if not GWSAStartupCalled then

    4236. 

  4236.         WSocket_Synchronized_WSAStartup(MAKEWORD(GReqVerLow, GReqVerHigh), GInitData);

    4237. 

  4237.     Result := OverByteIcsWinsock.closesocket(s);

    4238. 

  4238. end;

    4239. 

  4239. 

    4240. 

  4240. 

    4241. 

  4241. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    4242. 

  4242. function WSocket_Synchronized_bind(

    4243. 

  4243.     S        : TSocket;

    4244. 

  4244.     var Addr : TSockAddr;

    4245. 

  4245.     NameLen  : Integer): Integer;

    4246. 

  4246. begin

    4247. 

  4247.     if not GWSAStartupCalled then

    4248. 

  4248.         WSocket_Synchronized_WSAStartup(MAKEWORD(GReqVerLow, GReqVerHigh), GInitData);

    4249. 

  4249.     Result := OverByteIcsWinsock.bind(S, Addr, SizeOfTSockAddr);

    4250. 

  4250. end;

    4251. 

  4251. 

    4252. 

  4252. 

    4253. 

  4253. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    4254. 

  4254. function WSocket_Synchronized_accept(

    4255. 

  4255.     s           : TSocket;

    4256. 

  4256.     var addr    : TSockAddr;

    4257. 

  4257.     var addrlen : Integer): TSocket;

    4258. 

  4258. begin

    4259. 

  4259.     if not GWSAStartupCalled then

    4260. 

  4260.         WSocket_Synchronized_WSAStartup(MAKEWORD(GReqVerLow, GReqVerHigh), GInitData);

    4261. 

  4261.     addrlen := SizeOfTSockAddr;

    4262. 

  4262.     Result := OverByteIcsWinsock.accept(s, addr, addrlen);

    4263. 

  4263. end;

    4264. 

  4264. 

    4265. 

  4265. 

    4266. 

  4266. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    4267. 

  4267. function WSocket_Synchronized_recv(

    4268. 

  4268.     S          : TSocket;

    4269. 

  4269.     out Buf    : TBytes;

    4270. 

  4270.     Len, Flags : Integer): Integer;

    4271. 

  4271. begin

    4272. 

  4272.     if not GWSAStartupCalled then

    4273. 

  4273.         WSocket_Synchronized_WSAStartup(MAKEWORD(GReqVerLow, GReqVerHigh), GInitData);

    4274. 

  4274.     Result := OverByteIcsWinsock.recv(s, Buf, len, flags);

    4275. 

  4275. end;

    4276. 

  4276. 

    4277. 

  4277. 

    4278. 

  4278. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    4279. 

  4279. function WSocket_Synchronized_recvfrom(

    4280. 

  4280.     S           : TSocket;

    4281. 

  4281.     out Buf     : TBytes;

    4282. 

  4282.     Len, Flags  : Integer;

    4283. 

  4283.     var From    : TSockAddr;

    4284. 

  4284.     var FromLen : Integer): Integer;

    4285. 

  4285. var

    4286. 

  4286.     APIFromLen : Integer;

    4287. 

  4287. begin

    4288. 

  4288.     if not GWSAStartupCalled then

    4289. 

  4289.         WSocket_Synchronized_WSAStartup(MAKEWORD(GReqVerLow, GReqVerHigh), GInitData);

    4290. 

  4290.     APIFromLen := SizeOfTSockAddr;

    4291. 

  4291.     Result     := OverByteIcsWinsock.recvfrom(

    4292. 

  4292.                       S, Buf, Len, Flags, From, APIFromLen);

    4293. 

  4293. end;

    4294. 

  4294. 

    4295. 

  4295. 

    4296. 

  4296. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    4297. 

  4297. function WinsockInfo : TWSADATA;

    4298. 

  4298. begin

    4299. 

  4299.     if not GWSAStartupCalled then

    4300. 

  4300.         WSocket_Synchronized_WSAStartup(MAKEWORD(GReqVerLow, GReqVerHigh), GInitData);

    4301. 

  4301.     Result := GInitData;

    4302. 

  4302. end;

    4303. 

  4303. {$ENDIF}

    4304. 

  4304. 

    4305. 

  4305. 

    4306. 

  4306. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    4307. 

  4307. {$IFNDEF NO_ADV_MT}

    4308. 

  4308. procedure SafeIncrementCount;

    4309. 

  4309. begin

    4310. 

  4310.     _EnterCriticalSection(GWSockCritSect);

    4311. 

  4311.     Inc(WSocketGCount);

    4312. 

  4312.     _LeaveCriticalSection(GWSockCritSect);

    4313. 

  4313. end;

    4314. 

  4314. 

    4315. 

  4315. 

    4316. 

  4316. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    4317. 

  4317. procedure SafeDecrementCount;

    4318. 

  4318. begin

    4319. 

  4319.     _EnterCriticalSection(GWSockCritSect);

    4320. 

  4320.     Dec(WSocketGCount);

    4321. 

  4321.     _LeaveCriticalSection(GWSockCritSect);

    4322. 

  4322. end;

    4323. 

  4323. 

    4324. 

  4324. 

    4325. 

  4325. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    4326. 

  4326. function SafeWSocketGCount : Integer;

    4327. 

  4327. begin

    4328. 

  4328.     _EnterCriticalSection(GWSockCritSect);

    4329. 

  4329.     Result := WSocketGCount;

    4330. 

  4330.     _LeaveCriticalSection(GWSockCritSect);

    4331. 

  4331. end;

    4332. 

  4332. {$ENDIF}

    4333. 

  4333. 

    4334. 

  4334. 

    4335. 

  4335. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    4336. 

  4336. function WSocket_WSAStartup(

    4337. 

  4337.     wVersionRequired : WORD;

    4338. 

  4338.     var WSData       : TWSAData): Integer;

    4339. 

  4339. begin

    4340. 

  4340. {$IFNDEF NO_ADV_MT}

    4341. 

  4341.     SafeIncrementCount;

    4342. 

  4342.     try

    4343. 

  4343. {$ENDIF}

    4344. 

  4344.         Result := WSocket_Synchronized_WSAStartup(wVersionRequired, WSData);

    4345. 

  4345. {$IFNDEF NO_ADV_MT}

    4346. 

  4346.     finally

    4347. 

  4347.         SafeDecrementCount;

    4348. 

  4348.     end;

    4349. 

  4349. {$ENDIF}

    4350. 

  4350. end;

    4351. 

  4351. 

    4352. 

  4352. 

    4353. 

  4353. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    4354. 

  4354. function WSocket_WSACleanup : Integer;

    4355. 

  4355. begin

    4356. 

  4356. {$IFNDEF NO_ADV_MT}

    4357. 

  4357.     SafeIncrementCount;

    4358. 

  4358.     try

    4359. 

  4359. {$ENDIF}

    4360. 

  4360.         Result := WSocket_Synchronized_WSACleanup;

    4361. 

  4361. {$IFNDEF NO_ADV_MT}

    4362. 

  4362.     finally

    4363. 

  4363.         SafeDecrementCount;

    4364. 

  4364.     end;

    4365. 

  4365. {$ENDIF}

    4366. 

  4366. end;

    4367. 

  4367. 

    4368. 

  4368. 

    4369. 

  4369. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    4370. 

  4370. procedure WSocket_WSASetLastError(iError: Integer);

    4371. 

  4371. begin

    4372. 

  4372. {$IFNDEF NO_ADV_MT}

    4373. 

  4373.     SafeIncrementCount;

    4374. 

  4374.     try

    4375. 

  4375. {$ENDIF}

    4376. 

  4376.         WSocket_Synchronized_WSASetLastError(iError);

    4377. 

  4377. {$IFNDEF NO_ADV_MT}

    4378. 

  4378.     finally

    4379. 

  4379.         SafeDecrementCount;

    4380. 

  4380.     end;

    4381. 

  4381. {$ENDIF}

    4382. 

  4382. end;

    4383. 

  4383. 

    4384. 

  4384. 

    4385. 

  4385. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    4386. 

  4386. function WSocket_WSAGetLastError: Integer;

    4387. 

  4387. begin

    4388. 

  4388. {$IFNDEF NO_ADV_MT}

    4389. 

  4389.     SafeIncrementCount;

    4390. 

  4390.     try

    4391. 

  4391. {$ENDIF}

    4392. 

  4392.         Result := WSocket_Synchronized_WSAGetLastError;

    4393. 

  4393. {$IFNDEF NO_ADV_MT}

    4394. 

  4394.     finally

    4395. 

  4395.         SafeDecrementCount;

    4396. 

  4396.     end;

    4397. 

  4397. {$ENDIF}

    4398. 

  4398. end;

    4399. 

  4399. 

    4400. 

  4400. 

    4401. 

  4401. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    4402. 

  4402. function WSocket_WSACancelAsyncRequest(hAsyncTaskHandle: THandle): Integer;

    4403. 

  4403. begin

    4404. 

  4404. {$IFNDEF NO_ADV_MT}

    4405. 

  4405.     SafeIncrementCount;

    4406. 

  4406.     try

    4407. 

  4407. {$ENDIF}

    4408. 

  4408.         Result := WSocket_Synchronized_WSACancelAsyncRequest(hAsyncTaskHandle);

    4409. 

  4409. {$IFNDEF NO_ADV_MT}

    4410. 

  4410.     finally

    4411. 

  4411.         SafeDecrementCount;

    4412. 

  4412.     end;

    4413. 

  4413. {$ENDIF}

    4414. 

  4414. end;

    4415. 

  4415. 

    4416. 

  4416. 

    4417. 

  4417. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    4418. 

  4418. {$IFDEF CLR}

    4419. 

  4419. function WSocket_WSAAsyncGetHostByName(

    4420. 

  4420.     HWindow: HWND; wMsg: u_int;

    4421. 

  4421.     const name : String; buf: IntPtr;

    4422. 

  4422.     buflen: Integer): THandle;

    4423. 

  4423. begin

    4424. 

  4424.     Result := OverByteIcsWinsock.WSAAsyncGetHostByName(

    4425. 

  4425.                   HWindow, wMsg, name, buf, buflen);

    4426. 

  4426. end;

    4427. 

  4427. {$ENDIF}

    4428. 

  4428. 

    4429. 

  4429. 

    4430. 

  4430. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    4431. 

  4431. {$IFDEF CLR}

    4432. 

  4432. function WSocket_WSAAsyncGetHostByAddr(

    4433. 

  4433.     HWindow: HWND;

    4434. 

  4434.     wMsg: u_int; var addr: u_long;

    4435. 

  4435.     len, Struct: Integer;

    4436. 

  4436.     buf: IntPtr;

    4437. 

  4437.     buflen: Integer): THandle;

    4438. 

  4438. begin

    4439. 

  4439.     Result := OverByteIcsWinsock.WSAAsyncGetHostByAddr(

    4440. 

  4440.                    HWindow, wMsg, addr, len, struct, buf, buflen);

    4441. 

  4441. end;

    4442. 

  4442. {$ENDIF}

    4443. 

  4443. 

    4444. 

  4444. 

    4445. 

  4445. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    4446. 

  4446. {$IFDEF WIN32}

    4447. 

  4447. function WSocket_WSAAsyncGetHostByName(

    4448. 

  4448.     HWindow: HWND; wMsg: u_int;

    4449. 

  4449.     name, buf: PAnsiChar;

    4450. 

  4450.     buflen: Integer): THandle;

    4451. 

  4451. begin

    4452. 

  4452. {$IFNDEF NO_ADV_MT}

    4453. 

  4453.     SafeIncrementCount;

    4454. 

  4454.     try

    4455. 

  4455. {$ENDIF}

    4456. 

  4456.         Result := WSocket_Synchronized_WSAAsyncGetHostByName(

    4457. 

  4457.                       HWindow, wMsg, name, buf, buflen);

    4458. 

  4458. {$IFNDEF NO_ADV_MT}

    4459. 

  4459.     finally

    4460. 

  4460.         SafeDecrementCount;

    4461. 

  4461.     end;

    4462. 

  4462. {$ENDIF}

    4463. 

  4463. end;

    4464. 

  4464. {$ENDIF}

    4465. 

  4465. 

    4466. 

  4466. 

    4467. 

  4467. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    4468. 

  4468. {$IFDEF WIN32}

    4469. 

  4469. function WSocket_WSAAsyncGetHostByAddr(

    4470. 

  4470.     HWindow: HWND;

    4471. 

  4471.     wMsg: u_int; addr: PAnsiChar;

    4472. 

  4472.     len, Struct: Integer;

    4473. 

  4473.     buf: PAnsiChar;

    4474. 

  4474.     buflen: Integer): THandle;

    4475. 

  4475. begin

    4476. 

  4476. {$IFNDEF NO_ADV_MT}

    4477. 

  4477.     SafeIncrementCount;

    4478. 

  4478.     try

    4479. 

  4479. {$ENDIF}

    4480. 

  4480.         Result := WSocket_Synchronized_WSAAsyncGetHostByAddr(

    4481. 

  4481.                        HWindow, wMsg, addr, len, struct, buf, buflen);

    4482. 

  4482. {$IFNDEF NO_ADV_MT}

    4483. 

  4483.     finally

    4484. 

  4484.         SafeDecrementCount;

    4485. 

  4485.     end;

    4486. 

  4486. {$ENDIF}

    4487. 

  4487. end;

    4488. 

  4488. {$ENDIF}

    4489. 

  4489. 

    4490. 

  4490. 

    4491. 

  4491. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    4492. 

  4492. function WSocket_WSAAsyncSelect(

    4493. 

  4493.     s: TSocket;

    4494. 

  4494.     HWindow: HWND;

    4495. 

  4495.     wMsg: u_int;

    4496. 

  4496.     lEvent: Longint): Integer;

    4497. 

  4497. begin

    4498. 

  4498. {$IFNDEF NO_ADV_MT}

    4499. 

  4499.     SafeIncrementCount;

    4500. 

  4500.     try

    4501. 

  4501. {$ENDIF}

    4502. 

  4502.         Result := WSocket_Synchronized_WSAAsyncSelect(

    4503. 

  4503.                       s, HWindow, wMsg, lEvent);

    4504. 

  4504. {$IFNDEF NO_ADV_MT}

    4505. 

  4505.     finally

    4506. 

  4506.         SafeDecrementCount;

    4507. 

  4507.     end;

    4508. 

  4508. {$ENDIF}

    4509. 

  4509. end;

    4510. 

  4510. 

    4511. 

  4511. 

    4512. 

  4512. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    4513. 

  4513. {$IFDEF CLR}

    4514. 

  4514. function WSocket_getservbyname(const Name, Proto: String): IntPtr;

    4515. 

  4515. begin

    4516. 

  4516.     Result := OverByteIcsWinsock.getservbyname(Name, Proto);

    4517. 

  4517. end;

    4518. 

  4518. 

    4519. 

  4519. 

    4520. 

  4520. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    4521. 

  4521. function WSocket_getprotobyname(const name: String): IntPtr;

    4522. 

  4522. begin

    4523. 

  4523.     Result := OverByteIcsWinsock.getprotobyname(name);

    4524. 

  4524. end;

    4525. 

  4525. 

    4526. 

  4526. 

    4527. 

  4527. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    4528. 

  4528. function WSocket_gethostbyname(const Name: String): IntPtr;

    4529. 

  4529. begin

    4530. 

  4530.     Result := OverByteIcsWinsock.gethostbyname(Name);

    4531. 

  4531. end;

    4532. 

  4532. 

    4533. 

  4533. 

    4534. 

  4534. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    4535. 

  4535. function WSocket_gethostbyaddr(

    4536. 

  4536.     var addr: u_long; len, Struct: Integer): IntPtr;

    4537. 

  4537. begin

    4538. 

  4538.     Result := OverByteIcsWinsock.gethostbyaddr(addr, len, Struct);

    4539. 

  4539. end;

    4540. 

  4540. 

    4541. 

  4541. 

    4542. 

  4542. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    4543. 

  4543. function WSocket_gethostname(out Name: String): Integer;

    4544. 

  4544. var

    4545. 

  4545.     SB: System.Text.StringBuilder;

    4546. 

  4546. begin

    4547. 

  4547.     SB     := System.Text.StringBuilder.Create(256);

    4548. 

  4548.     Result := OverByteIcsWinsock.gethostname(SB, SB.Capacity);

    4549. 

  4549.     if Result <> 0 then

    4550. 

  4550.         Name := ''

    4551. 

  4551.     else

    4552. 

  4552.         Name := SB.ToString;

    4553. 

  4553. end;

    4554. 

  4554. 

    4555. 

  4555. 

    4556. 

  4556. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    4557. 

  4557. {$ENDIF}

    4558. 

  4558. {$IFDEF WIN32}

    4559. 

  4559. function WSocket_getservbyname(name, proto: PAnsiChar): PServEnt;

    4560. 

  4560. begin

    4561. 

  4561. {$IFNDEF NO_ADV_MT}

    4562. 

  4562.     SafeIncrementCount;

    4563. 

  4563.     try

    4564. 

  4564. {$ENDIF}

    4565. 

  4565.         Result := WSocket_Synchronized_getservbyname(name, proto);

    4566. 

  4566. {$IFNDEF NO_ADV_MT}

    4567. 

  4567.     finally

    4568. 

  4568.         SafeDecrementCount;

    4569. 

  4569.     end;

    4570. 

  4570. {$ENDIF}

    4571. 

  4571. end;

    4572. 

  4572. 

    4573. 

  4573. 

    4574. 

  4574. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    4575. 

  4575. function WSocket_getprotobyname(name: PAnsiChar): PProtoEnt;

    4576. 

  4576. begin

    4577. 

  4577. {$IFNDEF NO_ADV_MT}

    4578. 

  4578.     SafeIncrementCount;

    4579. 

  4579.     try

    4580. 

  4580. {$ENDIF}

    4581. 

  4581.         Result := WSocket_Synchronized_getprotobyname(name);

    4582. 

  4582. {$IFNDEF NO_ADV_MT}

    4583. 

  4583.     finally

    4584. 

  4584.         SafeDecrementCount;

    4585. 

  4585.     end;

    4586. 

  4586. {$ENDIF}

    4587. 

  4587. end;

    4588. 

  4588. 

    4589. 

  4589. 

    4590. 

  4590. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    4591. 

  4591. function WSocket_gethostbyname(name: PAnsiChar): PHostEnt;

    4592. 

  4592. begin

    4593. 

  4593. {$IFNDEF NO_ADV_MT}

    4594. 

  4594.     SafeIncrementCount;

    4595. 

  4595.     try

    4596. 

  4596. {$ENDIF}

    4597. 

  4597.         Result := WSocket_Synchronized_gethostbyname(name);

    4598. 

  4598. {$IFNDEF NO_ADV_MT}

    4599. 

  4599.     finally

    4600. 

  4600.         SafeDecrementCount;

    4601. 

  4601.     end;

    4602. 

  4602. {$ENDIF}

    4603. 

  4603. end;

    4604. 

  4604. 

    4605. 

  4605. 

    4606. 

  4606. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    4607. 

  4607. function WSocket_gethostbyaddr(addr: Pointer; len, Struct: Integer): PHostEnt;

    4608. 

  4608. begin

    4609. 

  4609. {$IFNDEF NO_ADV_MT}

    4610. 

  4610.     SafeIncrementCount;

    4611. 

  4611.     try

    4612. 

  4612. {$ENDIF}

    4613. 

  4613.         Result := WSocket_Synchronized_gethostbyaddr(addr, len, Struct);

    4614. 

  4614. {$IFNDEF NO_ADV_MT}

    4615. 

  4615.     finally

    4616. 

  4616.         SafeDecrementCount;

    4617. 

  4617.     end;

    4618. 

  4618. {$ENDIF}

    4619. 

  4619. end;

    4620. 

  4620. 

    4621. 

  4621. 

    4622. 

  4622. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    4623. 

  4623. function WSocket_gethostname(out name: AnsiString): Integer;

    4624. 

  4624. begin

    4625. 

  4625. {$IFNDEF NO_ADV_MT}

    4626. 

  4626.     SafeIncrementCount;

    4627. 

  4627.     try

    4628. 

  4628. {$ENDIF}

    4629. 

  4629.         SetLength(Name, 256);

    4630. 

  4630.         Result := WSocket_Synchronized_gethostname(PAnsiChar(name), 256);

    4631. 

  4631.         if Result >= 0 then

    4632. 

  4632.             // Unicode will convert on the fly

    4633. 

  4633.             SetLength(Name, _StrLen(PAnsiChar(Name))) // Unicode change

    4634. 

  4634.         else

    4635. 

  4635.             SetLength(Name, 0);

    4636. 

  4636. {$IFNDEF NO_ADV_MT}

    4637. 

  4637.     finally

    4638. 

  4638.         SafeDecrementCount;

    4639. 

  4639.     end;

    4640. 

  4640. {$ENDIF}

    4641. 

  4641. end;

    4642. 

  4642. {$ENDIF}

    4643. 

  4643. 

    4644. 

  4644. 

    4645. 

  4645. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    4646. 

  4646. function WSocket_socket(af, Struct, protocol: Integer): TSocket;

    4647. 

  4647. begin

    4648. 

  4648. {$IFNDEF NO_ADV_MT}

    4649. 

  4649.     SafeIncrementCount;

    4650. 

  4650.     try

    4651. 

  4651. {$ENDIF}

    4652. 

  4652.         Result := WSocket_Synchronized_socket(af, Struct, protocol);

    4653. 

  4653. {$IFNDEF NO_ADV_MT}

    4654. 

  4654.     finally

    4655. 

  4655.         SafeDecrementCount;

    4656. 

  4656.     end;

    4657. 

  4657. {$ENDIF}

    4658. 

  4658. end;

    4659. 

  4659. 

    4660. 

  4660. 

    4661. 

  4661. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    4662. 

  4662. function WSocket_shutdown(s: TSocket; how: Integer): Integer;

    4663. 

  4663. begin

    4664. 

  4664. {$IFNDEF NO_ADV_MT}

    4665. 

  4665.     SafeIncrementCount;

    4666. 

  4666.     try

    4667. 

  4667. {$ENDIF}

    4668. 

  4668.         Result := WSocket_Synchronized_Shutdown(s, how);

    4669. 

  4669. {$IFNDEF NO_ADV_MT}

    4670. 

  4670.     finally

    4671. 

  4671.         SafeDecrementCount;

    4672. 

  4672.     end;

    4673. 

  4673. {$ENDIF}

    4674. 

  4674. end;

    4675. 

  4675. 

    4676. 

  4676. 

    4677. 

  4677. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    4678. 

  4678. {$IFDEF CLR}

    4679. 

  4679. function WSocket_setsockopt(

    4680. 

  4680.     s              : TSocket;

    4681. 

  4681.     level, optname : Integer;

    4682. 

  4682.     var optval     : Integer;

    4683. 

  4683.     optlen         : Integer): Integer; overload;

    4684. 

  4684. begin

    4685. 

  4685.     Result := OverByteIcsWinsock.setsockopt_integer(

    4686. 

  4686.                   S, Level, OptName, OptVal, 4);

    4687. 

  4687. end;

    4688. 

  4688. 

    4689. 

  4689. 

    4690. 

  4690. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    4691. 

  4691. function WSocket_setsockopt(

    4692. 

  4692.     s              : TSocket;

    4693. 

  4693.     level, optname : Integer;

    4694. 

  4694.     var optval     : ip_mreq;

    4695. 

  4695.     optlen         : Integer): Integer; overload;

    4696. 

  4696. begin

    4697. 

  4697.     Result := OverByteIcsWinsock.setsockopt_ip_mreq(

    4698. 

  4698.                   S, Level, OptName, OptVal, 8);

    4699. 

  4699. end;

    4700. 

  4700. 

    4701. 

  4701. 

    4702. 

  4702. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    4703. 

  4703. function WSocket_setsockopt(

    4704. 

  4704.     s              : TSocket;

    4705. 

  4705.     level, optname : Integer;

    4706. 

  4706.     var optval     : TInAddr;

    4707. 

  4707.     optlen         : Integer): Integer; overload;

    4708. 

  4708. begin

    4709. 

  4709.     Result := OverByteIcsWinsock.setsockopt_tinaddr(

    4710. 

  4710.                   S, Level, OptName, OptVal, 4);

    4711. 

  4711. end;

    4712. 

  4712. 

    4713. 

  4713. 

    4714. 

  4714. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    4715. 

  4715. function WSocket_setsockopt(

    4716. 

  4716.     s              : TSocket;

    4717. 

  4717.     level, optname : Integer;

    4718. 

  4718.     var optval     : TLinger;

    4719. 

  4719.     optlen         : Integer): Integer; overload;

    4720. 

  4720. begin

    4721. 

  4721.     Result := OverByteIcsWinsock.setsockopt_tlinger(

    4722. 

  4722.                   S, Level, OptName, OptVal, 4);

    4723. 

  4723. end;

    4724. 

  4724. {$ENDIF}

    4725. 

  4725. 

    4726. 

  4726. 

    4727. 

  4727. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    4728. 

  4728. {$IFDEF WIN32}

    4729. 

  4729. function WSocket_setsockopt(s: TSocket; level, optname: Integer; optval: PAnsiChar;

    4730. 

  4730.                             optlen: Integer): Integer;

    4731. 

  4731. begin

    4732. 

  4732. {$IFNDEF NO_ADV_MT}

    4733. 

  4733.     SafeIncrementCount;

    4734. 

  4734.     try

    4735. 

  4735. {$ENDIF}

    4736. 

  4736.         Result := WSocket_Synchronized_setsockopt(s, level, optname, optval, optlen);

    4737. 

  4737. {$IFNDEF NO_ADV_MT}

    4738. 

  4738.     finally

    4739. 

  4739.         SafeDecrementCount;

    4740. 

  4740.     end;

    4741. 

  4741. {$ENDIF}

    4742. 

  4742. end;

    4743. 

  4743. 

    4744. 

  4744. 

    4745. 

  4745. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    4746. 

  4746. function WSocket_setsockopt(s: TSocket; level, optname: Integer; var optval: TLinger;

    4747. 

  4747.                             optlen: Integer): Integer;

    4748. 

  4748. begin

    4749. 

  4749. {$IFNDEF NO_ADV_MT}

    4750. 

  4750.     SafeIncrementCount;

    4751. 

  4751.     try

    4752. 

  4752. {$ENDIF}

    4753. 

  4753.         Result := WSocket_Synchronized_setsockopt(s, level, optname, optval, optlen);

    4754. 

  4754. {$IFNDEF NO_ADV_MT}

    4755. 

  4755.     finally

    4756. 

  4756.         SafeDecrementCount;

    4757. 

  4757.     end;

    4758. 

  4758. {$ENDIF}

    4759. 

  4759. end;

    4760. 

  4760. {$ENDIF}

    4761. 

  4761. 

    4762. 

  4762. 

    4763. 

  4763. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    4764. 

  4764. {$IFDEF CLR}

    4765. 

  4765. function WSocket_getsockopt(

    4766. 

  4766.     s: TSocket; level, optname: Integer;

    4767. 

  4767.     var optval: Integer; var optlen: Integer): Integer;

    4768. 

  4768. begin

    4769. 

  4769.     Result := OverByteIcsWinsock.getsockopt_integer(

    4770. 

  4770.                   s, level, optname, optval, optlen);

    4771. 

  4771. end;

    4772. 

  4772. 

    4773. 

  4773. 

    4774. 

  4774. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    4775. 

  4775. function WSocket_getsockopt(

    4776. 

  4776.     s: TSocket; level, optname: Integer;

    4777. 

  4777.     var optval: ip_mreq; var optlen: Integer): Integer;

    4778. 

  4778. begin

    4779. 

  4779.     Result := OverByteIcsWinsock.getsockopt_ip_mreq(

    4780. 

  4780.                   s, level, optname, optval, optlen);

    4781. 

  4781. end;

    4782. 

  4782. 

    4783. 

  4783. 

    4784. 

  4784. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    4785. 

  4785. function WSocket_getsockopt(

    4786. 

  4786.     s: TSocket; level, optname: Integer;

    4787. 

  4787.     var optval: TInAddr; var optlen: Integer): Integer;

    4788. 

  4788. begin

    4789. 

  4789.     Result := OverByteIcsWinsock.getsockopt_tinaddr(

    4790. 

  4790.                   s, level, optname, optval, optlen);

    4791. 

  4791. end;

    4792. 

  4792. 

    4793. 

  4793. 

    4794. 

  4794. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    4795. 

  4795. function WSocket_getsockopt(

    4796. 

  4796.     s: TSocket; level, optname: Integer;

    4797. 

  4797.     var optval: TLinger; var optlen: Integer): Integer;

    4798. 

  4798. begin

    4799. 

  4799.     Result := OverByteIcsWinsock.getsockopt_tlinger(

    4800. 

  4800.                   s, level, optname, optval, optlen);

    4801. 

  4801. end;

    4802. 

  4802. {$ENDIF}

    4803. 

  4803. 

    4804. 

  4804. 

    4805. 

  4805. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    4806. 

  4806. {$IFDEF WIN32}

    4807. 

  4807. function WSocket_getsockopt(

    4808. 

  4808.     s: TSocket; level, optname: Integer;

    4809. 

  4809.     optval: PAnsiChar; var optlen: Integer): Integer;

    4810. 

  4810. begin

    4811. 

  4811. {$IFNDEF NO_ADV_MT}

    4812. 

  4812.     SafeIncrementCount;

    4813. 

  4813.     try

    4814. 

  4814. {$ENDIF}

    4815. 

  4815.         Result := WSocket_Synchronized_getsockopt(s, level, optname, optval, optlen);

    4816. 

  4816. {$IFNDEF NO_ADV_MT}

    4817. 

  4817.     finally

    4818. 

  4818.         SafeDecrementCount;

    4819. 

  4819.     end;

    4820. 

  4820. {$ENDIF}

    4821. 

  4821. end;

    4822. 

  4822. {$ENDIF}

    4823. 

  4823. 

    4824. 

  4824. 

    4825. 

  4825. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    4826. 

  4826. function WSocket_sendto(

    4827. 

  4827.     s          : TSocket;

    4828. 

  4828.     var Buf    : TWSocketData;

    4829. 

  4829.     len, flags : Integer;

    4830. 

  4830.     var addrto : TSockAddr;

    4831. 

  4831.     tolen      : Integer): Integer;

    4832. 

  4832. begin

    4833. 

  4833. {$IFNDEF NO_ADV_MT}

    4834. 

  4834.     SafeIncrementCount;

    4835. 

  4835.     try

    4836. 

  4836. {$ENDIF}

    4837. 

  4837.         Result := WSocket_Synchronized_sendto(s, Buf, len, flags, addrto, tolen);

    4838. 

  4838. {$IFNDEF NO_ADV_MT}

    4839. 

  4839.     finally

    4840. 

  4840.         SafeDecrementCount;

    4841. 

  4841.     end;

    4842. 

  4842. {$ENDIF}

    4843. 

  4843. end;

    4844. 

  4844. 

    4845. 

  4845. 

    4846. 

  4846. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    4847. 

  4847. function WSocket_send(s: TSocket; var Buf : TWSocketData; len, flags: Integer): Integer;

    4848. 

  4848. begin

    4849. 

  4849. {$IFNDEF NO_ADV_MT}

    4850. 

  4850.     SafeIncrementCount;

    4851. 

  4851.     try

    4852. 

  4852. {$ENDIF}

    4853. 

  4853.         Result := WSocket_Synchronized_send(s, Buf, len, flags);

    4854. 

  4854. {$IFNDEF NO_ADV_MT}

    4855. 

  4855.     finally

    4856. 

  4856.         SafeDecrementCount;

    4857. 

  4857.     end;

    4858. 

  4858. {$ENDIF}

    4859. 

  4859. end;

    4860. 

  4860. 

    4861. 

  4861. 

    4862. 

  4862. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    4863. 

  4863. function WSocket_ntohs(netshort: u_short): u_short;

    4864. 

  4864. begin

    4865. 

  4865. {$IFNDEF NO_ADV_MT}

    4866. 

  4866.     SafeIncrementCount;

    4867. 

  4867.     try

    4868. 

  4868. {$ENDIF}

    4869. 

  4869.         Result := WSocket_Synchronized_ntohs(netshort);

    4870. 

  4870. {$IFNDEF NO_ADV_MT}

    4871. 

  4871.     finally

    4872. 

  4872.         SafeDecrementCount;

    4873. 

  4873.     end;

    4874. 

  4874. {$ENDIF}

    4875. 

  4875. end;

    4876. 

  4876. 

    4877. 

  4877. 

    4878. 

  4878. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    4879. 

  4879. function WSocket_ntohl(netlong: u_long): u_long;

    4880. 

  4880. begin

    4881. 

  4881. {$IFNDEF NO_ADV_MT}

    4882. 

  4882.     SafeIncrementCount;

    4883. 

  4883.     try

    4884. 

  4884. {$ENDIF}

    4885. 

  4885.         Result := WSocket_Synchronized_ntohl(netlong);

    4886. 

  4886. {$IFNDEF NO_ADV_MT}

    4887. 

  4887.     finally

    4888. 

  4888.         SafeDecrementCount;

    4889. 

  4889.     end;

    4890. 

  4890. {$ENDIF}

    4891. 

  4891. end;

    4892. 

  4892. 

    4893. 

  4893. 

    4894. 

  4894. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    4895. 

  4895. function WSocket_listen(s: TSocket; backlog: Integer): Integer;

    4896. 

  4896. begin

    4897. 

  4897. {$IFNDEF NO_ADV_MT}

    4898. 

  4898.     SafeIncrementCount;

    4899. 

  4899.     try

    4900. 

  4900. {$ENDIF}

    4901. 

  4901.         Result := WSocket_Synchronized_listen(s, backlog);

    4902. 

  4902. {$IFNDEF NO_ADV_MT}

    4903. 

  4903.     finally

    4904. 

  4904.         SafeDecrementCount;

    4905. 

  4905.     end;

    4906. 

  4906. {$ENDIF}

    4907. 

  4907. end;

    4908. 

  4908. 

    4909. 

  4909. 

    4910. 

  4910. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    4911. 

  4911. function WSocket_ioctlsocket(s: TSocket; cmd: DWORD; var arg: u_long): Integer;

    4912. 

  4912. begin

    4913. 

  4913. {$IFNDEF NO_ADV_MT}

    4914. 

  4914.     SafeIncrementCount;

    4915. 

  4915.     try

    4916. 

  4916. {$ENDIF}

    4917. 

  4917.         Result := WSocket_Synchronized_ioctlsocket(s, cmd, arg);

    4918. 

  4918. {$IFNDEF NO_ADV_MT}

    4919. 

  4919.     finally

    4920. 

  4920.         SafeDecrementCount;

    4921. 

  4921.     end;

    4922. 

  4922. {$ENDIF}

    4923. 

  4923. end;

    4924. 

  4924. 

    4925. 

  4925. 

    4926. 

  4926. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    4927. 

  4927. {$IFDEF WIN32}

    4928. 

  4928. {$IFDEF COMPILER2_UP}

    4929. 

  4929. function WSocket_WSAIoctl(

    4930. 

  4930.     s                 : TSocket; IoControlCode : DWORD;

    4931. 

  4931.     InBuffer          : Pointer; InBufferSize  : DWORD;

    4932. 

  4932.     OutBuffer         : Pointer; OutBufferSize : DWORD;

    4933. 

  4933.     var BytesReturned : DWORD; Overlapped      : POverlapped;

    4934. 

  4934.     CompletionRoutine : FARPROC): Integer;

    4935. 

  4935. begin

    4936. 

  4936. {$IFNDEF NO_ADV_MT}

    4937. 

  4937.     SafeIncrementCount;

    4938. 

  4938.     try

    4939. 

  4939. {$ENDIF}

    4940. 

  4940.         Result := WSocket_Synchronized_WSAIoctl(

    4941. 

  4941.                       s, IoControlCode, InBuffer, InBufferSize, OutBuffer,

    4942. 

  4942.                       OutBufferSize, BytesReturned, Overlapped, CompletionRoutine);

    4943. 

  4943. {$IFNDEF NO_ADV_MT}

    4944. 

  4944.     finally

    4945. 

  4945.         SafeDecrementCount;

    4946. 

  4946.     end;

    4947. 

  4947. {$ENDIF}

    4948. 

  4948. end;

    4949. 

  4949. {$ENDIF}

    4950. 

  4950. {$ENDIF}

    4951. 

  4951. 

    4952. 

  4952. 

    4953. 

  4953. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    4954. 

  4954. {$IFDEF CLR}

    4955. 

  4955. function WSocket_inet_ntoa(inaddr: TInAddr): String;

    4956. 

  4956. begin

    4957. 

  4957.     Result := OverByteIcsWinsock.inet_ntoa(inaddr);

    4958. 

  4958. end;

    4959. 

  4959. {$ENDIF}

    4960. 

  4960. 

    4961. 

  4961. 

    4962. 

  4962. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    4963. 

  4963. {$IFDEF WIN32}

    4964. 

  4964. function WSocket_inet_ntoa(inaddr: TInAddr): AnsiString;

    4965. 

  4965. var

    4966. 

  4966.     Temp : PAnsiChar;

    4967. 

  4967. begin

    4968. 

  4968. {$IFNDEF NO_ADV_MT}

    4969. 

  4969.     SafeIncrementCount;

    4970. 

  4970.     try

    4971. 

  4971. {$ENDIF}

    4972. 

  4972.         Temp := WSocket_Synchronized_inet_ntoa(inaddr);

    4973. 

  4973.         if Temp = nil then

    4974. 

  4974.             Result := ''

    4975. 

  4975.         else

    4976. 

  4976.             Result := Temp;

    4977. 

  4977. {$IFNDEF NO_ADV_MT}

    4978. 

  4978.     finally

    4979. 

  4979.         SafeDecrementCount;

    4980. 

  4980.     end;

    4981. 

  4981. {$ENDIF}

    4982. 

  4982. end;

    4983. 

  4983. {$ENDIF}

    4984. 

  4984. 

    4985. 

  4985. 

    4986. 

  4986. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    4987. 

  4987. function WSocket_inet_addr(const cp: AnsiString): u_long;  

    4988. 

  4988. begin

    4989. 

  4989. {$IFNDEF NO_ADV_MT}

    4990. 

  4990.     SafeIncrementCount;

    4991. 

  4991.     try

    4992. 

  4992. {$ENDIF}

    4993. 

  4993.         Result := WSocket_Synchronized_inet_addr(cp);

    4994. 

  4994. {$IFNDEF NO_ADV_MT}

    4995. 

  4995.     finally

    4996. 

  4996.         SafeDecrementCount;

    4997. 

  4997.     end;

    4998. 

  4998. {$ENDIF}

    4999. 

  4999. end;

    5000. 

  5000. 

    5001. 

  5001. 

    5002. 

  5002. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    5003. 

  5003. function WSocket_htons(hostshort: u_short): u_short;

    5004. 

  5004. begin

    5005. 

  5005. {$IFNDEF NO_ADV_MT}

    5006. 

  5006.     SafeIncrementCount;

    5007. 

  5007.     try

    5008. 

  5008. {$ENDIF}

    5009. 

  5009.         Result := WSocket_Synchronized_htons(hostshort);

    5010. 

  5010. {$IFNDEF NO_ADV_MT}

    5011. 

  5011.     finally

    5012. 

  5012.         SafeDecrementCount;

    5013. 

  5013.     end;

    5014. 

  5014. {$ENDIF}

    5015. 

  5015. end;

    5016. 

  5016. 

    5017. 

  5017. 

    5018. 

  5018. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    5019. 

  5019. function WSocket_htonl(hostlong: u_long): u_long;

    5020. 

  5020. begin

    5021. 

  5021. {$IFNDEF NO_ADV_MT}

    5022. 

  5022.     SafeIncrementCount;

    5023. 

  5023.     try

    5024. 

  5024. {$ENDIF}

    5025. 

  5025.         Result := WSocket_Synchronized_htonl(hostlong);

    5026. 

  5026. {$IFNDEF NO_ADV_MT}

    5027. 

  5027.     finally

    5028. 

  5028.         SafeDecrementCount;

    5029. 

  5029.     end;

    5030. 

  5030. {$ENDIF}

    5031. 

  5031. end;

    5032. 

  5032. 

    5033. 

  5033. 

    5034. 

  5034. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    5035. 

  5035. function WSocket_getsockname(

    5036. 

  5036.     s           : TSocket;

    5037. 

  5037.     var name    : TSockAddr;

    5038. 

  5038.     var namelen : Integer): Integer;

    5039. 

  5039. begin

    5040. 

  5040. {$IFNDEF NO_ADV_MT}

    5041. 

  5041.     SafeIncrementCount;

    5042. 

  5042.     try

    5043. 

  5043. {$ENDIF}

    5044. 

  5044.         Result := WSocket_Synchronized_getsockname(s, name, namelen);

    5045. 

  5045. {$IFNDEF NO_ADV_MT}

    5046. 

  5046.     finally

    5047. 

  5047.         SafeDecrementCount;

    5048. 

  5048.     end;

    5049. 

  5049. {$ENDIF}

    5050. 

  5050. end;

    5051. 

  5051. 

    5052. 

  5052. 

    5053. 

  5053. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    5054. 

  5054. function WSocket_getpeername(

    5055. 

  5055.     s           : TSocket;

    5056. 

  5056.     var name    : TSockAddr;

    5057. 

  5057.     var namelen : Integer): Integer;

    5058. 

  5058. begin

    5059. 

  5059. {$IFNDEF NO_ADV_MT}

    5060. 

  5060.     SafeIncrementCount;

    5061. 

  5061.     try

    5062. 

  5062. {$ENDIF}

    5063. 

  5063.         Result := WSocket_Synchronized_getpeername(s, name, namelen);

    5064. 

  5064. {$IFNDEF NO_ADV_MT}

    5065. 

  5065.     finally

    5066. 

  5066.         SafeDecrementCount;

    5067. 

  5067.     end;

    5068. 

  5068. {$ENDIF}

    5069. 

  5069. end;

    5070. 

  5070. 

    5071. 

  5071. 

    5072. 

  5072. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    5073. 

  5073. function WSocket_connect(

    5074. 

  5074.     s        : TSocket;

    5075. 

  5075.     var name : TSockAddr;

    5076. 

  5076.     namelen  : Integer): Integer;

    5077. 

  5077. begin

    5078. 

  5078. {$IFNDEF NO_ADV_MT}

    5079. 

  5079.     SafeIncrementCount;

    5080. 

  5080.     try

    5081. 

  5081. {$ENDIF}

    5082. 

  5082.         Result := WSocket_Synchronized_connect(s, name, namelen);

    5083. 

  5083. {$IFNDEF NO_ADV_MT}

    5084. 

  5084.     finally

    5085. 

  5085.         SafeDecrementCount;

    5086. 

  5086.     end;

    5087. 

  5087. {$ENDIF}

    5088. 

  5088. end;

    5089. 

  5089. 

    5090. 

  5090. 

    5091. 

  5091. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    5092. 

  5092. function WSocket_closesocket(s: TSocket): Integer;

    5093. 

  5093. begin

    5094. 

  5094. {$IFNDEF NO_ADV_MT}

    5095. 

  5095.     SafeIncrementCount;

    5096. 

  5096.     try

    5097. 

  5097. {$ENDIF}

    5098. 

  5098.         Result := WSocket_Synchronized_closesocket(s);

    5099. 

  5099. {$IFNDEF NO_ADV_MT}

    5100. 

  5100.     finally

    5101. 

  5101.         SafeDecrementCount;

    5102. 

  5102.     end;

    5103. 

  5103. {$ENDIF}

    5104. 

  5104. end;

    5105. 

  5105. 

    5106. 

  5106. 

    5107. 

  5107. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    5108. 

  5108. function WSocket_bind(

    5109. 

  5109.     s: TSocket;

    5110. 

  5110.     var addr: TSockAddr;

    5111. 

  5111.     namelen: Integer): Integer;

    5112. 

  5112. begin

    5113. 

  5113. {$IFNDEF NO_ADV_MT}

    5114. 

  5114.     SafeIncrementCount;

    5115. 

  5115.     try

    5116. 

  5116. {$ENDIF}

    5117. 

  5117.         Result := WSocket_Synchronized_bind(s, addr, namelen);

    5118. 

  5118. {$IFNDEF NO_ADV_MT}

    5119. 

  5119.     finally

    5120. 

  5120.         SafeDecrementCount;

    5121. 

  5121.     end;

    5122. 

  5122. {$ENDIF}

    5123. 

  5123. end;

    5124. 

  5124. 

    5125. 

  5125. 

    5126. 

  5126. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    5127. 

  5127. function WSocket_accept(

    5128. 

  5128.     s: TSocket;

    5129. 

  5129. {$IFDEF DELPHI1} { Delphi 1 }

    5130. 

  5130.     var addr: TSockAddr;

    5131. 

  5131.     var addrlen: Integer): TSocket;

    5132. 

  5132. {$ELSE}

    5133. 

  5133. {$IFDEF VER90} { Delphi 2 }

    5134. 

  5134.     var addr: TSockAddr;

    5135. 

  5135.     var addrlen: Integer): TSocket;

    5136. 

  5136. {$ELSE}{ Delphi 3/4/5, Bcb 1/3/4 }

    5137. 

  5137. {$IFDEF CLR}

    5138. 

  5138.     var addr: TSockAddr;

    5139. 

  5139.     var addrlen: Integer): TSocket;

    5140. 

  5140. {$ELSE}

    5141. 

  5141.     addr: PSockAddr;

    5142. 

  5142.     addrlen: PInteger): TSocket;

    5143. 

  5143. {$ENDIF}

    5144. 

  5144. {$ENDIF}

    5145. 

  5145. {$ENDIF}

    5146. 

  5146. begin

    5147. 

  5147. {$IFNDEF NO_ADV_MT}

    5148. 

  5148.     SafeIncrementCount;

    5149. 

  5149.     try

    5150. 

  5150. {$ENDIF}

    5151. 

  5151.         Result := WSocket_Synchronized_accept(s, addr, addrlen);

    5152. 

  5152. {$IFNDEF NO_ADV_MT}

    5153. 

  5153.     finally

    5154. 

  5154.         SafeDecrementCount;

    5155. 

  5155.     end;

    5156. 

  5156. {$ENDIF}

    5157. 

  5157. end;

    5158. 

  5158. 

    5159. 

  5159. 

    5160. 

  5160. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    5161. 

  5161. function WSocket_recv(s: TSocket; var Buf : TWSocketData; len, flags: Integer): Integer;

    5162. 

  5162. begin

    5163. 

  5163. {$IFNDEF NO_ADV_MT}

    5164. 

  5164.     SafeIncrementCount;

    5165. 

  5165.     try

    5166. 

  5166. {$ENDIF}

    5167. 

  5167.         Result := WSocket_Synchronized_recv(s, Buf, len, flags);

    5168. 

  5168. {$IFNDEF NO_ADV_MT}

    5169. 

  5169.     finally

    5170. 

  5170.         SafeDecrementCount;

    5171. 

  5171.     end;

    5172. 

  5172. {$ENDIF}

    5173. 

  5173. end;

    5174. 

  5174. 

    5175. 

  5175. 

    5176. 

  5176. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    5177. 

  5177. function WSocket_recvfrom(

    5178. 

  5178.     s: TSocket;

    5179. 

  5179.     var Buf: TWSocketData; len, flags: Integer;

    5180. 

  5180.     var from: TSockAddr;

    5181. 

  5181.     var fromlen: Integer): Integer;

    5182. 

  5182. begin

    5183. 

  5183. {$IFNDEF NO_ADV_MT}

    5184. 

  5184.     SafeIncrementCount;

    5185. 

  5185.     try

    5186. 

  5186. {$ENDIF}

    5187. 

  5187.         Result := WSocket_Synchronized_recvfrom(s, Buf, len, flags, from, fromlen);

    5188. 

  5188. {$IFNDEF NO_ADV_MT}

    5189. 

  5189.     finally

    5190. 

  5190.         SafeDecrementCount;

    5191. 

  5191.     end;

    5192. 

  5192. {$ENDIF}

    5193. 

  5193. end;

    5194. 

  5194. 

    5195. 

  5195. 

    5196. 

  5196. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    5197. 

  5197. function TWSocketCounter.GetLastAliveTick : Cardinal;

    5198. 

  5198. (*

    5199. 

  5199. begin

    5200. 

  5200.     if FLastRecvTick > FLastSendTick then

    5201. 

  5201.         if FLastRecvTick > FConnectTick then

    5202. 

  5202.             Result := FLastRecvTick

    5203. 

  5203.         else

    5204. 

  5204.             Result := FConnectTick

    5205. 

  5205.     else

    5206. 

  5206.         if FLastSendTick > FConnectTick then

    5207. 

  5207.             Result := FLastSendTick

    5208. 

  5208.         else

    5209. 

  5209.             Result := FConnectTick;

    5210. 

  5210. *)

    5211. 

  5211. asm

    5212. 

  5212.     mov ecx, [eax].FLastRecvTick

    5213. 

  5213.     mov edx, [eax].FLastSendTick

    5214. 

  5214.     mov eax, [eax].FConnectTick

    5215. 

  5215.     cmp eax, edx

    5216. 

  5216.     jb  @below

    5217. 

  5217.     mov edx, ecx

    5218. 

  5218.     jmp @more

    5219. 

  5219. @below:

    5220. 

  5220.     mov eax, ecx

    5221. 

  5221. @more:

    5222. 

  5222.     cmp eax, edx

    5223. 

  5223.     jb  @done

    5224. 

  5224.     ret

    5225. 

  5225. @done:

    5226. 

  5226.     mov eax, edx

    5227. 

  5227. end;

    5228. 

  5228. 

    5229. 

  5229. 

    5230. 

  5230. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    5231. 

  5231. procedure TWSocketCounter.SetConnected;

    5232. 

  5232. begin

    5233. 

  5233.     FLastRecvTick := 0;

    5234. 

  5234.     FLastSendTick := 0;

    5235. 

  5235.     FConnectTick  := _GetTickCount;

    5236. 

  5236.     FConnectDT    := _Now;

    5237. 

  5237. end;

    5238. 

  5238. 

    5239. 

  5239. 

    5240. 

  5240. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    5241. 

  5241. {$IFDEF WIN32}

    5242. 

  5242. procedure TCustomWSocket.Notification(AComponent: TComponent; operation: TOperation);

    5243. 

  5243. begin

    5244. 

  5244.     inherited Notification(AComponent, operation);

    5245. 

  5245.     if operation = opRemove then begin

    5246. 

  5246.     {$IFNDEF NO_DEBUG_LOG}

    5247. 

  5247.         if AComponent = FIcsLogger then                               { V5.21 }

    5248. 

  5248.             FIcsLogger := nil;                                        { V5.21 }

    5249. 

  5249.     {$ENDIF}                                                          { V5.21 }

    5250. 

  5250.     end;

    5251. 

  5251. end;

    5252. 

  5252. {$ENDIF}

    5253. 

  5253. 

    5254. 

  5254. 

    5255. 

  5255. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    5256. 

  5256. procedure TCustomWSocket.AssignDefaultValue;

    5257. 

  5257. begin

    5258. 

  5258.     //FillChar(sin, Sizeof(sin), 0);

    5259. 

  5259.     sin.sin_family      := AF_INET;

    5260. 

  5260.     sin.sin_port        := 0;

    5261. 

  5261.     sin.sin_addr.S_addr := 0;

    5262. 

  5262.     FAddrFormat         := PF_INET;

    5263. 

  5263. 

    5264. 

  5264.     FPortAssigned       := FALSE;

    5265. 

  5265.     FAddrAssigned       := FALSE;

    5266. 

  5266.     FAddrResolved       := FALSE;

    5267. 

  5267.     FPortResolved       := FALSE;

    5268. 

  5268.     FProtoResolved      := FALSE;

    5269. 

  5269.     FLocalPortResolved  := FALSE;

    5270. 

  5270. 

    5271. 

  5271.     FProtoAssigned      := TRUE;

    5272. 

  5272.     FProto              := IPPROTO_TCP;

    5273. 

  5273.     FProtoStr           := 'tcp';

    5274. 

  5274.     FType               := SOCK_STREAM;

    5275. 

  5275.     FLocalPortStr       := '0';

    5276. 

  5276.     FLocalAddr          := '0.0.0.0';

    5277. 

  5277. 

    5278. 

  5278.     FLingerOnOff        := wsLingerOn;

    5279. 

  5279.     FLingerTimeout      := 0;

    5280. 

  5280.     FHSocket            := INVALID_SOCKET;

    5281. 

  5281.     FSelectEvent        := 0;

    5282. 

  5282.     FState              := wsClosed;

    5283. 

  5283.     bAllSent            := TRUE;

    5284. 

  5284.     FPaused             := FALSE;

    5285. 

  5285. {   FReadCount          := 0;  V7.24 only reset when connection opened, not closed }

    5286. 

  5286.     FCloseInvoked       := FALSE;

    5287. 

  5287.     FFlushTimeout       := 60;

    5288. 

  5288. end;

    5289. 

  5289. 

    5290. 

  5290. 

    5291. 

  5291. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    5292. 

  5292. { All exceptions *MUST* be handled. If an exception is not handled, the     }

    5293. 

  5293. { application will be shut down !                                           }

    5294. 

  5294. procedure TCustomWSocket.HandleBackGroundException(E: Exception);

    5295. 

  5295. var

    5296. 

  5296.     CanAbort : Boolean;

    5297. 

  5297. begin

    5298. 

  5298.     CanAbort := TRUE;

    5299. 

  5299.     { First call the error event handler, if any }

    5300. 

  5300.     if Assigned(FOnBgException) then begin

    5301. 

  5301.         try

    5302. 

  5302.             FOnBgException(Self, E, CanAbort);

    5303. 

  5303.         except

    5304. 

  5304.         end;

    5305. 

  5305.     end;

    5306. 

  5306.     { Then abort the socket }

    5307. 

  5307.     if CanAbort then begin

    5308. 

  5308.         try

    5309. 

  5309.             Abort;

    5310. 

  5310.         except

    5311. 

  5311.         end;

    5312. 

  5312.     end;

    5313. 

  5313. end;

    5314. 

  5314. 

    5315. 

  5315. 

    5316. 

  5316. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    5317. 

  5317. { This procedure handle all messages for TWSocket. All exceptions must be   }

    5318. 

  5318. { handled or the application will be shutted down !                         }

    5319. 

  5319. { If WndProc is overridden in descendent components, then the same exception }

    5320. 

  5320. { handling *MUST* be setup because descendent component code is executed    }

    5321. 

  5321. { before the base class code.                                               }

    5322. 

  5322. procedure TCustomWSocket.WndProc(var MsgRec: TMessage);

    5323. 

  5323. begin

    5324. 

  5324.     try

    5325. 

  5325.         with MsgRec do begin

    5326. 

  5326.             if Msg = FMsg_WM_ASYNCSELECT then

    5327. 

  5327.                 WMASyncSelect(MsgRec)

    5328. 

  5328.             else if Msg = FMsg_WM_ASYNCGETHOSTBYNAME then

    5329. 

  5329.                 WMAsyncGetHostByName(MsgRec)

    5330. 

  5330.             else if Msg = FMsg_WM_ASYNCGETHOSTBYADDR then

    5331. 

  5331.                 WMAsyncGetHostByAddr(MsgRec)

    5332. 

  5332.             else if Msg = FMsg_WM_CLOSE_DELAYED then

    5333. 

  5333.                 WMCloseDelayed(MsgRec)

    5334. 

  5334. //            else if Msg = FMsg_WM_WSOCKET_RELEASE then

    5335. 

  5335. //                WMRelease(MsgRec)

    5336. 

  5336.             else if Msg = FMsg_WM_TRIGGER_EXCEPTION then

    5337. 

  5337.                 { This is useful to check for background exceptions            }

    5338. 

  5338.                 { In your application, use following code to test your handler }

    5339. 

  5339.                 { PostMessage(WSocket1.Handle, WM_TRIGGER_EXCEPTION, 0, 0);    }

    5340. 

  5340.                 raise ESocketException.Create('Test exception in WSocket')

    5341. 

  5341.             else

    5342. 

  5342.                 inherited WndProc(MsgRec);

    5343. 

  5343.                 //Result := DefWindowProc(Handle, Msg, wParam, LParam);

    5344. 

  5344.         end;

    5345. 

  5345.     except

    5346. 

  5346.         on E:Exception do

    5347. 

  5347.             HandleBackGroundException(E);

    5348. 

  5348.     end;

    5349. 

  5349. end;

    5350. 

  5350. 

    5351. 

  5351. 

    5352. 

  5352. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    5353. 

  5353. function TCustomWSocket.MsgHandlersCount : Integer;

    5354. 

  5354. begin

    5355. 

  5355.     Result := 6 + inherited MsgHandlersCount;

    5356. 

  5356. end;

    5357. 

  5357. 

    5358. 

  5358. 

    5359. 

  5359. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    5360. 

  5360. procedure TCustomWSocket.AllocateMsgHandlers;

    5361. 

  5361. begin

    5362. 

  5362.     inherited AllocateMsgHandlers;

    5363. 

  5363.     FMsg_WM_ASYNCSELECT            := FWndHandler.AllocateMsgHandler(Self);

    5364. 

  5364.     FMsg_WM_ASYNCGETHOSTBYNAME     := FWndHandler.AllocateMsgHandler(Self);

    5365. 

  5365.     FMsg_WM_ASYNCGETHOSTBYADDR     := FWndHandler.AllocateMsgHandler(Self);

    5366. 

  5366.     FMsg_WM_CLOSE_DELAYED          := FWndHandler.AllocateMsgHandler(Self);

    5367. 

  5367.     FMsg_WM_TRIGGER_EXCEPTION      := FWndHandler.AllocateMsgHandler(Self);

    5368. 

  5368.     FMsg_WM_TRIGGER_DATA_AVAILABLE := FWndHandler.AllocateMsgHandler(Self);

    5369. 

  5369. //  FMsg_WM_WSOCKET_RELEASE        := FWndHandler.AllocateMsgHandler(Self);

    5370. 

  5370. end;

    5371. 

  5371. 

    5372. 

  5372. 

    5373. 

  5373. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    5374. 

  5374. procedure TCustomWSocket.FreeMsgHandlers;

    5375. 

  5375. begin

    5376. 

  5376.     if Assigned(FWndHandler) then begin

    5377. 

  5377.         FWndHandler.UnregisterMessage(FMsg_WM_ASYNCSELECT);

    5378. 

  5378.         FWndHandler.UnregisterMessage(FMsg_WM_ASYNCGETHOSTBYNAME);

    5379. 

  5379.         FWndHandler.UnregisterMessage(FMsg_WM_ASYNCGETHOSTBYADDR);

    5380. 

  5380.         FWndHandler.UnregisterMessage(FMsg_WM_CLOSE_DELAYED);

    5381. 

  5381.         FWndHandler.UnregisterMessage(FMsg_WM_TRIGGER_EXCEPTION);

    5382. 

  5382.         FWndHandler.UnregisterMessage(FMsg_WM_TRIGGER_DATA_AVAILABLE);

    5383. 

  5383.     end;

    5384. 

  5384.     inherited FreeMsgHandlers;

    5385. 

  5385. end;

    5386. 

  5386. 

    5387. 

  5387. 

    5388. 

  5388. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    5389. 

  5389. procedure TCustomWSocket.AllocateSocketHWnd;

    5390. 

  5390. begin

    5391. 

  5391.     inherited AllocateHWnd;

    5392. 

  5392. end;

    5393. 

  5393. 

    5394. 

  5394. 

    5395. 

  5395. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    5396. 

  5396. procedure TCustomWSocket.DeallocateSocketHWnd;

    5397. 

  5397. begin

    5398. 

  5398.     inherited DeallocateHWnd;

    5399. 

  5399. end;

    5400. 

  5400. 

    5401. 

  5401. 

    5402. 

  5402. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    5403. 

  5403. {$IFDEF COMPILER2_UP}

    5404. 

  5404. procedure TCustomWSocket.ThreadAttach;

    5405. 

  5405. begin

    5406. 

  5406.     inherited ThreadAttach;

    5407. 

  5407.     if FHSocket <> INVALID_SOCKET then

    5408. 

  5408.         WSocket_Synchronized_WSAASyncSelect(FHSocket, Handle,

    5409. 

  5409.                                             FMsg_WM_ASYNCSELECT, FSelectEvent);

    5410. 

  5410. end;

    5411. 

  5411. 

    5412. 

  5412. 

    5413. 

  5413. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    5414. 

  5414. procedure TCustomWSocket.ThreadDetach;

    5415. 

  5415. begin

    5416. 

  5416.     if (_GetCurrentThreadID = DWORD(FThreadID)) and (FHSocket <> INVALID_SOCKET) then

    5417. 

  5417.         WSocket_Synchronized_WSAASyncSelect(FHSocket, Handle, 0, 0);

    5418. 

  5418.     inherited ThreadDetach;

    5419. 

  5419. end;

    5420. 

  5420. {$ENDIF}

    5421. 

  5421. 

    5422. 

  5422. 

    5423. 

  5423. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    5424. 

  5424. constructor TCustomWSocket.Create{$IFDEF VCL}(AOwner: TComponent){$ENDIF};

    5425. 

  5425. begin

    5426. 

  5426.     inherited Create{$IFDEF VCL}(AOwner){$ENDIF};

    5427. 

  5427. 

    5428. 

  5428.     FHSocket            := INVALID_SOCKET;           { FP: 18/01/2007 }

    5429. 

  5429.     AllocateSocketHWnd;

    5430. 

  5430.     FBufHandler         := TIcsBufferHandler.Create(Self);

    5431. 

  5431.     FBufHandler.BufSize := 1460; {1514;}             { Default buffer size }

    5432. 

  5432.     FDnsResultList      := TStringList.Create;

    5433. 

  5433.     FMultiCastIpTTL     := IP_DEFAULT_MULTICAST_TTL;

    5434. 

  5434.     ListenBacklog       := 5;

    5435. 

  5435.     FBufferedByteCount  := 0;  { V5.20 }

    5436. 

  5436.     FMultiCastAddrStr   := '';

    5437. 

  5437.     FAddrStr            := '';

    5438. 

  5438.     FPortStr            := '';

    5439. 

  5439.     FCounterClass       := TWSocketCounter;

    5440. 

  5440.     AssignDefaultValue;

    5441. 

  5441. 

    5442. 

  5442. {$IFDEF COMPILER2_UP}

    5443. 

  5443.     _EnterCriticalSection(GWSockCritSect);

    5444. 

  5444.     try

    5445. 

  5445. {$ENDIF}

    5446. 

  5446.         Inc(WSocketGCount);

    5447. 

  5447. {$IFDEF COMPILER2_UP}

    5448. 

  5448.     finally

    5449. 

  5449.         _LeaveCriticalSection(GWSockCritSect);

    5450. 

  5450.     end;

    5451. 

  5451. {$ENDIF}

    5452. 

  5452. end;

    5453. 

  5453. 

    5454. 

  5454. 

    5455. 

  5455. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    5456. 

  5456. destructor TCustomWSocket.Destroy;

    5457. 

  5457. begin

    5458. 

  5458.     try

    5459. 

  5459.         CancelDnsLookup;             { Cancel any pending dns lookup      }

    5460. 

  5460.     except

    5461. 

  5461.         { Ignore any exception here }

    5462. 

  5462.     end;

    5463. 

  5463. 

    5464. 

  5464.     if FState <> wsInvalidState then begin              { FPiette V7.42 }

    5465. 

  5465.         { wsInvalidState happend when an exception is raised early in the constructor }

    5466. 

  5466.         { Close the socket if not yet closed }

    5467. 

  5467.         if FState <> wsClosed then

    5468. 

  5468.             Close;

    5469. 

  5469. 

    5470. 

  5470. {$IFDEF COMPILER2_UP}

    5471. 

  5471.         _EnterCriticalSection(GWSockCritSect);

    5472. 

  5472.         try

    5473. 

  5473. {$ENDIF}

    5474. 

  5474.             Dec(WSocketGCount);

    5475. 

  5475.             if WSocketGCount <= 0 then begin

    5476. 

  5476.                 WSocketUnloadWinsock;

    5477. 

  5477.     {           WSocketGCount := 0;  // it is set to 0 in WSocketUnloadWinsock }

    5478. 

  5478.             end;

    5479. 

  5479. {$IFDEF COMPILER2_UP}

    5480. 

  5480.         finally

    5481. 

  5481.             _LeaveCriticalSection(GWSockCritSect);

    5482. 

  5482.         end;

    5483. 

  5483. {$ENDIF}

    5484. 

  5484.     end;

    5485. 

  5485. 

    5486. 

  5486.     if Assigned(FBufHandler) then begin

    5487. 

  5487.         FBufHandler.Free;

    5488. 

  5488.         FBufHandler := nil;

    5489. 

  5489.     end;

    5490. 

  5490.     if Assigned(FDnsResultList) then begin

    5491. 

  5491.         FDnsResultList.Free;

    5492. 

  5492.         FDnsResultList := nil;

    5493. 

  5493.     end;

    5494. 

  5494. 

    5495. 

  5495.     if Assigned(FCounter) then begin

    5496. 

  5496.         FCounter.Free;

    5497. 

  5497.         FCounter := nil;

    5498. 

  5498.     end;

    5499. 

  5499. 

    5500. 

  5500.     inherited Destroy;

    5501. 

  5501. end;

    5502. 

  5502. 

    5503. 

  5503. 

    5504. 

  5504. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    5505. 

  5505. procedure TCustomWSocket.CreateCounter;

    5506. 

  5506. begin

    5507. 

  5507.     if Assigned(FCounter) then

    5508. 

  5508.         _FreeAndNil(FCounter);

    5509. 

  5509.     FCounter := FCounterClass.Create;

    5510. 

  5510. end;

    5511. 

  5511. 

    5512. 

  5512. 

    5513. 

  5513. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    5514. 

  5514. procedure TCustomWSocket.DestroyCounter;

    5515. 

  5515. begin

    5516. 

  5516.     _FreeAndNil(FCounter);

    5517. 

  5517. end;

    5518. 

  5518. 

    5519. 

  5519. 

    5520. 

  5520. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    5521. 

  5521. procedure TCustomWSocket.SetCounterClass(const Value: TWSocketCounterClass);

    5522. 

  5522. var

    5523. 

  5523.     NewCounter : TWSocketCounter;

    5524. 

  5524. begin

    5525. 

  5525.     if Value = nil then

    5526. 

  5526.         raise ESocketException.Create('Property CounterClass may not be nil!');

    5527. 

  5527.     if Value <> FCounterClass then begin

    5528. 

  5528.         FCounterClass := Value;

    5529. 

  5529.         if Assigned(FCounter) then begin

    5530. 

  5530.             NewCounter              := FCounterClass.Create;

    5531. 

  5531.             NewCounter.ConnectDT    := FCounter.ConnectDT;

    5532. 

  5532.             NewCounter.ConnectTick  := FCounter.ConnectTick;

    5533. 

  5533.             NewCounter.LastRecvTick := FCounter.LastRecvTick;

    5534. 

  5534.             NewCounter.LastSendTick := FCounter.LastSendTick;

    5535. 

  5535.             FCounter.Free;

    5536. 

  5536.             FCounter := NewCounter;

    5537. 

  5537.         end;

    5538. 

  5538.     end;

    5539. 

  5539. end;

    5540. 

  5540. 

    5541. 

  5541. 

    5542. 

  5542. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    5543. 

  5543. function TCustomWSocket.GetReqVerLow: BYTE;

    5544. 

  5544. begin

    5545. 

  5545.     Result := GReqVerLow;

    5546. 

  5546. end;

    5547. 

  5547. 

    5548. 

  5548. 

    5549. 

  5549. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    5550. 

  5550. procedure TCustomWSocket.SetReqVerLow(const Value: BYTE);

    5551. 

  5551. begin

    5552. 

  5552.     if GReqVerLow <> Value then begin

    5553. 

  5553.         if FDllHandle <> 0 then

    5554. 

  5554.             SocketError('SetReqVerLow: WinSock version can''t be changed now')

    5555. 

  5555.         else

    5556. 

  5556.             GReqVerLow := Value;

    5557. 

  5557.     end;

    5558. 

  5558. end;

    5559. 

  5559. 

    5560. 

  5560. 

    5561. 

  5561. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    5562. 

  5562. function TCustomWSocket.GetReqVerHigh: BYTE;

    5563. 

  5563. begin

    5564. 

  5564.     Result := GReqVerHigh;

    5565. 

  5565. end;

    5566. 

  5566. 

    5567. 

  5567. 

    5568. 

  5568. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    5569. 

  5569. procedure TCustomWSocket.SetReqVerHigh(const Value: BYTE);

    5570. 

  5570. begin

    5571. 

  5571.     if GReqVerHigh <> Value then begin

    5572. 

  5572.         if FDllHandle <> 0 then

    5573. 

  5573.             SocketError('SetReqVerHigh: WinSock version can''t be changed now')

    5574. 

  5574.         else

    5575. 

  5575.             GReqVerHigh := Value;

    5576. 

  5576.     end;

    5577. 

  5577. end;

    5578. 

  5578. 

    5579. 

  5579. 

    5580. 

  5580. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    5581. 

  5581. procedure TCustomWSocket.Dup(NewHSocket : TSocket);

    5582. 

  5582. var

    5583. 

  5583.     iStatus : Integer;

    5584. 

  5584.     optlen  : Integer;

    5585. 

  5585. begin

    5586. 

  5586. {$IFDEF CLR}

    5587. 

  5587.     if DesignMode then begin

    5588. 

  5588.         FHsocket := NewHSocket;

    5589. 

  5589.         Exit;

    5590. 

  5590.     end;

    5591. 

  5591. {$ENDIF}

    5592. 

  5592.     if (NewHSocket = 0) or (NewHSocket = INVALID_SOCKET) then begin

    5593. 

  5593.         WSocket_Synchronized_WSASetLastError(WSAEINVAL);

    5594. 

  5594.         SocketError('Dup');

    5595. 

  5595.         Exit;

    5596. 

  5596.     end;

    5597. 

  5597. 

    5598. 

  5598.     if FState <> wsClosed then begin

    5599. 

  5599.         iStatus := WSocket_Synchronized_closesocket(FHSocket);

    5600. 

  5600.         FHSocket := INVALID_SOCKET;

    5601. 

  5601.         if iStatus <> 0 then begin

    5602. 

  5602.             SocketError('Dup (closesocket)');

    5603. 

  5603.             Exit;

    5604. 

  5604.         end;

    5605. 

  5605. 

    5606. 

  5606.         ChangeState(wsClosed);

    5607. 

  5607.     end;

    5608. 

  5608.     FHsocket := NewHSocket;

    5609. 

  5609. 

    5610. 

  5610.     { Get winsock send buffer size }

    5611. 

  5611.     optlen  := SizeOf(FSocketSndBufSize);

    5612. 

  5612. {$IFDEF CLR}

    5613. 

  5613.     iStatus := WSocket_getsockopt(FHSocket, SOL_SOCKET, SO_SNDBUF,

    5614. 

  5614.                                   FSocketSndBufSize, optlen);

    5615. 

  5615. {$ELSE}

    5616. 

  5616.     iStatus := WSocket_getsockopt(FHSocket, SOL_SOCKET, SO_SNDBUF,

    5617. 

  5617.                                   PAnsiChar(@FSocketSndBufSize), optlen);

    5618. 

  5618. {$ENDIF}

    5619. 

  5619. 

    5620. 

  5620.     if iStatus <> 0 then begin

    5621. 

  5621.         SocketError('getsockopt(SO_SNDBUF)');

    5622. 

  5622.         Exit;

    5623. 

  5623.     end;

    5624. 

  5624. 

    5625. 

  5625.     { Get winsock receive buffer size }

    5626. 

  5626.     optlen  := SizeOf(FSocketRcvBufSize);

    5627. 

  5627. {$IFDEF CLR}

    5628. 

  5628.     iStatus := WSocket_getsockopt(FHSocket, SOL_SOCKET, SO_RCVBUF,

    5629. 

  5629.                                   FSocketRcvBufSize, optlen);

    5630. 

  5630. {$ELSE}

    5631. 

  5631.     iStatus := WSocket_getsockopt(FHSocket, SOL_SOCKET, SO_RCVBUF,

    5632. 

  5632.                                   PAnsiChar(@FSocketRcvBufSize), optlen);

    5633. 

  5633. {$ENDIF}

    5634. 

  5634. 

    5635. 

  5635.     if iStatus <> 0 then begin

    5636. 

  5636.         SocketError('getsockopt(SO_RCVBUF)');

    5637. 

  5637.         Exit;

    5638. 

  5638.     end;

    5639. 

  5639. 

    5640. 

  5640.     if HasOption(FComponentOptions, wsoTcpNoDelay) and { V7.27 }

    5641. 

  5641.                 (not SetTcpNoDelayOption) then

    5642. 

  5642.         Exit;

    5643. 

  5643.     SetLingerOption;

    5644. 

  5644.     SetKeepAliveOption;  // AG { 05/23/07)

    5645. 

  5645. 

    5646. 

  5646.     { FD_CONNECT is not needed for dup(): The socket is already connected }

    5647. 

  5647.     FSelectEvent := FD_READ or FD_WRITE or FD_CLOSE { or FD_CONNECT };

    5648. 

  5648.     iStatus      := WSocket_Synchronized_WSAASyncSelect(FHSocket, Handle,

    5649. 

  5649.                                                         FMsg_WM_ASYNCSELECT,

    5650. 

  5650.                                                         FSelectEvent);

    5651. 

  5651.     if iStatus <> 0 then begin

    5652. 

  5652.         SocketError('WSAAsyncSelect');

    5653. 

  5653.         Exit;

    5654. 

  5654.     end;

    5655. 

  5655.     DupConnected;

    5656. 

  5656. end;

    5657. 

  5657. 

    5658. 

  5658. 

    5659. 

  5659. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    5660. 

  5660. procedure TCustomWSocket.DupConnected;

    5661. 

  5661. begin

    5662. 

  5662.     if Assigned(FCounter) then

    5663. 

  5663.         FCounter.SetConnected;

    5664. 

  5664.     FReadCount  := 0;  { 7.24 }

    5665. 

  5665.     FWriteCount := 0;  { 7.24 }

    5666. 

  5666.     ChangeState(wsConnected);

    5667. 

  5667. end;

    5668. 

  5668. 

    5669. 

  5669. 

    5670. 

  5670. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    5671. 

  5671. procedure TCustomWSocket.SetBufSize(Value : Integer);

    5672. 

  5672. begin

    5673. 

  5673.     FBufHandler.BufSize := Value;

    5674. 

  5674. end;

    5675. 

  5675. 

    5676. 

  5676. 

    5677. 

  5677. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    5678. 

  5678. function TCustomWSocket.GetBufSize: Integer;

    5679. 

  5679. begin

    5680. 

  5680.     Result := FBufHandler.BufSize;

    5681. 

  5681. end;

    5682. 

  5682. 

    5683. 

  5683. 

    5684. 

  5684. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    5685. 

  5685. { Get the number of char received and waiting to be read                    }

    5686. 

  5686. function TCustomWSocket.GetRcvdCount : LongInt;

    5687. 

  5687. var

    5688. 

  5688.     Temp : u_long;

    5689. 

  5689. begin

    5690. 

  5690. {$IFDEF CLR}

    5691. 

  5691.     if DesignMode then begin

    5692. 

  5692. {$ENDIF}

    5693. 

  5693. {$IFDEF WIN32}

    5694. 

  5694.     if csDesigning in ComponentState then begin

    5695. 

  5695. {$ENDIF}

    5696. 

  5696.         Result := -1;

    5697. 

  5697.         Exit;

    5698. 

  5698.     end;

    5699. 

  5699.     if WSocket_Synchronized_ioctlsocket(FHSocket, FIONREAD, Temp) = SOCKET_ERROR then begin

    5700. 

  5700.         Result := -1;

    5701. 

  5701.         SocketError('ioctlSocket');

    5702. 

  5702.         Exit;

    5703. 

  5703.     end;

    5704. 

  5704.     Result := LongInt(Temp);

    5705. 

  5705. end;

    5706. 

  5706. 

    5707. 

  5707. 

    5708. 

  5708. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    5709. 

  5709. procedure TCustomWSocket.ChangeState(NewState : TSocketState);

    5710. 

  5710. var

    5711. 

  5711.     OldState : TSocketState;

    5712. 

  5712. begin

    5713. 

  5713.     OldState := FState;

    5714. 

  5714.     FState   := NewState;

    5715. 

  5715.     if OldState <> NewState then       { 20030226 }

    5716. 

  5716.         TriggerChangeState(OldState, NewState);

    5717. 

  5717. end;

    5718. 

  5718. 

    5719. 

  5719. 

    5720. 

  5720. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    5721. 

  5721. { DoRecv is a simple wrapper around winsock recv function to make it        }

    5722. 

  5722. { a virtual function.                                                       }

    5723. 

  5723. function TCustomWSocket.DoRecv(

    5724. 

  5724.     var Buffer : TWSocketData;

    5725. 

  5725.     BufferSize : Integer;

    5726. 

  5726.     Flags      : Integer) : Integer;

    5727. 

  5727. begin

    5728. 

  5728. { MoulinCnt := (MoulinCnt + 1) and 3; }

    5729. 

  5729. { Write('R', Moulin[MoulinCnt], #13); }

    5730. 

  5730.     Result := WSocket_Synchronized_recv(FHSocket, Buffer, BufferSize, Flags);

    5731. 

  5731. {   FRcvdFlag := (Result > 0);}

    5732. 

  5732.     { If we received the requested size, we may need to receive more }

    5733. 

  5733.     FRcvdFlag := (Result >= BufferSize);

    5734. 

  5734.     if Assigned(FCounter) and (Result > 0) then

    5735. 

  5735.         FCounter.FLastRecvTick := _GetTickCount;

    5736. 

  5736. end;

    5737. 

  5737. 

    5738. 

  5738. 

    5739. 

  5739. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    5740. 

  5740. { The socket is non-blocking, so this routine will only receive as much     }

    5741. 

  5741. { data as it is available.                                                  }

    5742. 

  5742. function TCustomWSocket.Receive(Buffer : TWSocketData; BufferSize: Integer) : Integer;

    5743. 

  5743. begin

    5744. 

  5744.     Result := DoRecv(Buffer, BufferSize, 0);

    5745. 

  5745.     if Result < 0 then

    5746. 

  5746.         FLastError := WSocket_Synchronized_WSAGetLastError

    5747. 

  5747.     else

    5748. 

  5748.         { Here we should check for overflows ! It is well possible to }

    5749. 

  5749.         { receive more than 2GB during a single session.              }

    5750. 

  5750.         { Or we could use an Int64 variable...                        }

    5751. 

  5751.         FReadCount := FReadCount + Result;

    5752. 

  5752. end;

    5753. 

  5753. 

    5754. 

  5754. 

    5755. 

  5755. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    5756. 

  5756. {$IFDEF COMPILER12_UP}

    5757. 

  5757. function TCustomWSocket.ReceiveStrW(ACodePage : LongWord) : UnicodeString;

    5758. 

  5758. begin

    5759. 

  5759.     Result :=  AnsiToUniCode(ReceiveStrA, ACodePage);

    5760. 

  5760. end;

    5761. 

  5761. 

    5762. 

  5762. 

    5763. 

  5763. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    5764. 

  5764. function TCustomWSocket.ReceiveStrW : UnicodeString;

    5765. 

  5765. begin

    5766. 

  5766.     Result := ReceiveStrW(CP_ACP);

    5767. 

  5767. end;

    5768. 

  5768. {$ENDIF}

    5769. 

  5769. 

    5770. 

  5770. 

    5771. 

  5771. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    5772. 

  5772. function TCustomWSocket.ReceiveStrA : AnsiString;

    5773. 

  5773. var

    5774. 

  5774.     lCount : LongInt;

    5775. 

  5775. begin

    5776. 

  5776.     lCount := GetRcvdCount;

    5777. 

  5777. 

    5778. 

  5778.     if lCount < 0 then begin  { GetRcvdCount returned an error }

    5779. 

  5779.         SetLength(Result, 0);

    5780. 

  5780.         Exit;

    5781. 

  5781.     end;

    5782. 

  5782. 

    5783. 

  5783.     if lCount = 0 then        { GetRcvdCount say nothing, will try anyway }

    5784. 

  5784.         LCount := 255;        { some reasonable arbitrary value           }

    5785. 

  5785. 

    5786. 

  5786. {$IFDEF CLR}

    5787. 

  5787.     if Length(FRecvStrBuf) < 1460 then

    5788. 

  5788.         SetLength(FRecvStrBuf, 1460);

    5789. 

  5789.     if Length(FRecvStrBuf) < lCount then

    5790. 

  5790.     SetLength(FRecvStrBuf, lCount);

    5791. 

  5791.     lCount := Receive(FRecvStrBuf, Length(FRecvStrBuf));

    5792. 

  5792.     if lCount <= 0 then

    5793. 

  5793.         Result := ''

    5794. 

  5794.     else begin

    5795. 

  5795.         Result := System.Text.Encoding.Default.GetString(FRecvStrBuf, 0, lCount);

    5796. 

  5796. //        SetLength(Result, lCount);

    5797. 

  5797. //        while lCount > 0 do begin

    5798. 

  5798. //            Dec(lCount);

    5799. 

  5799. //            Result[lCount + 1] := Char(FRecvStrBuf[lCount]);

    5800. 

  5800. //        end;

    5801. 

  5801.     end;

    5802. 

  5802. {$ENDIF}

    5803. 

  5803. {$IFDEF WIN32}

    5804. 

  5804.     SetLength(Result, lCount);

    5805. 

  5805.     lCount := Receive(@Result[1], lCount);

    5806. 

  5806.     if lCount > 0 then

    5807. 

  5807.         SetLength(Result, lCount)

    5808. 

  5808.     else

    5809. 

  5809.         SetLength(Result, 0);

    5810. 

  5810. {$ENDIF}

    5811. 

  5811. end;

    5812. 

  5812. 

    5813. 

  5813. 

    5814. 

  5814. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    5815. 

  5815. { Receive as much data as possible into a string                            }

    5816. 

  5816. { You should avoid this function and use Receive. Using string will be      }

    5817. 

  5817. { much slower because data will be copied several times.                    }

    5818. 

  5818. { ReceiveStr will *NOT* wait for a line to be received. It just read        }

    5819. 

  5819. { already received characters and return them as a string.                  }

    5820. 

  5820. function TCustomWSocket.ReceiveStr : String;

    5821. 

  5821. begin

    5822. 

  5822. {$IFDEF COMPILER12_UP}

    5823. 

  5823.     Result := ReceiveStrW;

    5824. 

  5824. {$ELSE}

    5825. 

  5825.     Result := ReceiveStrA;

    5826. 

  5826. {$ENDIF}

    5827. 

  5827. end;

    5828. 

  5828. 

    5829. 

  5829. 

    5830. 

  5830. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    5831. 

  5831. function TCustomWSocket.DoRecvFrom(

    5832. 

  5832.     FHSocket    : TSocket;

    5833. 

  5833.     var Buffer  : TWSocketData;

    5834. 

  5834.     BufferSize  : Integer;

    5835. 

  5835.     Flags       : Integer;

    5836. 

  5836.     var From    : TSockAddr;

    5837. 

  5837.     var FromLen : Integer) : Integer;

    5838. 

  5838. begin

    5839. 

  5839.     Result := WSocket_Synchronized_recvfrom(FHSocket, Buffer, BufferSize,

    5840. 

  5840.                                             Flags, From, FromLen);

    5841. 

  5841. {   FRcvdFlag := (Result > 0); }

    5842. 

  5842.     FRcvdFlag := (Result >= BufferSize);

    5843. 

  5843. end;

    5844. 

  5844. 

    5845. 

  5845. 

    5846. 

  5846. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    5847. 

  5847. function TCustomWSocket.ReceiveFrom(

    5848. 

  5848.     Buffer      : TWSocketData;

    5849. 

  5849.     BufferSize  : Integer;

    5850. 

  5850.     var From    : TSockAddr;

    5851. 

  5851.     var FromLen : Integer) : Integer;

    5852. 

  5852. begin

    5853. 

  5853.     Result := DoRecvFrom(FHSocket, Buffer, BufferSize, 0, From, FromLen);

    5854. 

  5854.     if Result < 0 then

    5855. 

  5855.         FLastError := WSocket_Synchronized_WSAGetLastError

    5856. 

  5856.     else

    5857. 

  5857.         FReadCount := FReadCount + Result;

    5858. 

  5858. end;

    5859. 

  5859. 

    5860. 

  5860. 

    5861. 

  5861. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    5862. 

  5862. function TCustomWSocket.PeekData(Buffer : TWSocketData; BufferSize: Integer) : Integer;

    5863. 

  5863. begin

    5864. 

  5864.     Result := DoRecv(Buffer, BufferSize, MSG_PEEK);

    5865. 

  5865.     if Result < 0 then

    5866. 

  5866.         FLastError := WSocket_Synchronized_WSAGetLastError;

    5867. 

  5867. end;

    5868. 

  5868. 

    5869. 

  5869. 

    5870. 

  5870. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    5871. 

  5871. {

    5872. 

  5872. function SearchChar(Data : PChar; Len : Integer; Ch : Char) : PChar;

    5873. 

  5873. begin

    5874. 

  5874.     while Len > 0 do begin

    5875. 

  5875.         Len := Len - 1;

    5876. 

  5876.         if Data^ = Ch then begin

    5877. 

  5877.             Result := Data;

    5878. 

  5878.             exit;

    5879. 

  5879.         end;

    5880. 

  5880.         Data := Data + 1;

    5881. 

  5881.     end;

    5882. 

  5882.     Result := nil;

    5883. 

  5883. end;

    5884. 

  5884. }

    5885. 

  5885. 

    5886. 

  5886. 

    5887. 

  5887. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    5888. 

  5888. { This function should be used with UDP only. Use Send for TCP.             }

    5889. 

  5889. function TCustomWSocket.SendTo(

    5890. 

  5890.     Dest       : TSockAddr;

    5891. 

  5891.     DestLen    : Integer;

    5892. 

  5892.     {$IFDEF CLR} const {$ENDIF} Data : TWSocketData;

    5893. 

  5893.     Len        : Integer) : Integer;

    5894. 

  5894. begin

    5895. 

  5895.     Result := WSocket_Synchronized_SendTo(FHSocket, Data, Len, FSendFlags,

    5896. 

  5896.                                           TSockAddr(Dest), DestLen);

    5897. 

  5897.     if Result > 0 then begin

    5898. 

  5898.         FWriteCount := FWriteCount + Result;  { 7.24 }

    5899. 

  5899.         TriggerSendData(Result);

    5900. 

  5900.         { Post FD_WRITE message to have OnDataSent event triggered }

    5901. 

  5901.         if bAllSent and (FType = SOCK_DGRAM) then

    5902. 

  5902.             _PostMessage(Handle,

    5903. 

  5903.                         FMsg_WM_ASYNCSELECT,

    5904. 

  5904.                         FHSocket,

    5905. 

  5905.                         MakeLong(FD_WRITE, 0));

    5906. 

  5906.     end;

    5907. 

  5907. end;

    5908. 

  5908. 

    5909. 

  5909. 

    5910. 

  5910. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    5911. 

  5911. function TCustomWSocket.RealSend(var Data : TWSocketData; Len : Integer) : Integer;

    5912. 

  5912. begin

    5913. 

  5913. { MoulinCnt := (MoulinCnt + 1) and 3; }

    5914. 

  5914. { Write('S', Moulin[MoulinCnt], #13); }

    5915. 

  5915.     if FType = SOCK_DGRAM then

    5916. 

  5916.         Result := WSocket_Synchronized_SendTo(FHSocket, Data, Len, FSendFlags,

    5917. 

  5917.                                               TSockAddr(sin), SizeOf(sin))

    5918. 

  5918.     else

    5919. 

  5919.         Result := WSocket_Synchronized_Send(FHSocket, Data, Len, FSendFlags);

    5920. 

  5920.     if Result > 0 then begin

    5921. 

  5921.         FWriteCount := FWriteCount + Result;  { 7.24 }

    5922. 

  5922.         if Assigned(FCounter) then

    5923. 

  5923.             FCounter.FLastSendTick := _GetTickCount;

    5924. 

  5924.         TriggerSendData(Result);

    5925. 

  5925.     end;

    5926. 

  5926. end;

    5927. 

  5927. 

    5928. 

  5928. 

    5929. 

  5929. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    5930. 

  5930. procedure TCustomWSocket.TryToSend;

    5931. 

  5931. var

    5932. 

  5932.     Len       : Integer;

    5933. 

  5933.     Count     : Integer;

    5934. 

  5934.     Data      : TWSocketData;

    5935. 

  5935.     LastError : Integer;

    5936. 

  5936. begin

    5937. 

  5937.     FBufHandler.Lock;

    5938. 

  5938.     try

    5939. 

  5939.         if (FHSocket = INVALID_SOCKET) or (FBufHandler.IsEmpty) then begin

    5940. 

  5940.             bAllSent := TRUE;

    5941. 

  5941.             Exit;

    5942. 

  5942.         end;

    5943. 

  5943. 

    5944. 

  5944.         while TRUE do begin

    5945. 

  5945.             Len := FBufHandler.Peek(Data);

    5946. 

  5946.             if Len <= 0 then begin

    5947. 

  5947.                 // Buffer is empty, every thing has been sent

    5948. 

  5948.                 bAllSent := TRUE;

    5949. 

  5949.                 break;

    5950. 

  5950.             end;

    5951. 

  5951.             Count := RealSend(Data, Len);

    5952. 

  5952.             if Count > 0 then begin

    5953. 

  5953.                 Dec(FBufferedByteCount, Count);

    5954. 

  5954.                 if FBufferedByteCount < 0 then

    5955. 

  5955.                     FBufferedByteCount := 0;

    5956. 

  5956.             end;

    5957. 

  5957.             if Count = 0 then

    5958. 

  5958.                 break;  // Closed by remote

    5959. 

  5959.             if Count = SOCKET_ERROR then begin

    5960. 

  5960.                 LastError := WSocket_Synchronized_WSAGetLastError;

    5961. 

  5961.                 if (LastError = WSAECONNRESET) or (LastError = WSAENOTSOCK) or

    5962. 

  5962.                    (LastError = WSAENOTCONN)   or (LastError = WSAEINVAL)   or

    5963. 

  5963.                    (LastError = WSAECONNABORTED)     { 07/05/99 }

    5964. 

  5964.                 then begin

    5965. 

  5965. {$IFNDEF NO_DEBUG_LOG}

    5966. 

  5966.                     if CheckLogOptions(loWsockErr) then  { V5.21 } { replaces $IFDEF DEBUG_OUTPUT  }

    5967. 

  5967.                             DebugLog(loWsockErr, Name +

    5968. 

  5968.                                      ' Winsock Send failed - ' +

    5969. 

  5969.                                      GetWinsockErr(LastError));

    5970. 

  5970. {$ENDIF}

    5971. 

  5971.                     FCloseInvoked := TRUE;           { 23/07/98 }

    5972. 

  5972.                     Close;

    5973. 

  5973.                     TriggerSessionClosed(LastError); { 23/07/98 }

    5974. 

  5974.                 end

    5975. 

  5975.                 else if LastError <> WSAEWOULDBLOCK then begin

    5976. 

  5976.                     SocketError('TryToSend failed');

    5977. 

  5977.                     break;

    5978. 

  5978.                 end;

    5979. 

  5979.                 break;

    5980. 

  5980.             end;

    5981. 

  5981.             FBufHandler.Remove(Count);

    5982. 

  5982.             if Count < Len then

    5983. 

  5983.                 break; // Could not write as much as we wanted. Stop sending

    5984. 

  5984.         end;

    5985. 

  5985.     finally

    5986. 

  5986.         FBufHandler.UnLock;

    5987. 

  5987.     end;

    5988. 

  5988. end;

    5989. 

  5989. 

    5990. 

  5990. 

    5991. 

  5991. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    5992. 

  5992. function TCustomWSocket.PutStringInSendBuffer(const Str : RawByteString): Integer;

    5993. 

  5993. {$IFDEF CLR}

    5994. 

  5994. var

    5995. 

  5995.     Data : TBytes;

    5996. 

  5996.     I    : Integer;

    5997. 

  5997. begin

    5998. 

  5998.     SetLength(Data, Length(Str));

    5999. 

  5999.     for I := 1 to Length(Str) do

    6000. 

  6000.         Data[I - 1] := Ord(Str[I]);

    6001. 

  6001.     PutDataInSendBuffer(Data, Length(Str));

    6002. 

  6002. {$ENDIF}

    6003. 

  6003. {$IFDEF WIN32}

    6004. 

  6004. begin

    6005. 

  6005.     Result := Length(Str);

    6006. 

  6006.     if Result > 0 then

    6007. 

  6007.         PutDataInSendBuffer(Pointer(Str), Result);

    6008. 

  6008. {$ENDIF}

    6009. 

  6009. end;

    6010. 

  6010. 

    6011. 

  6011. 

    6012. 

  6012. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    6013. 

  6013. {$IFDEF COMPILER12_UP}                                              

    6014. 

  6014. function TCustomWSocket.PutStringInSendBuffer(const Str : UnicodeString; ACodePage : LongWord): Integer;

    6015. 

  6015. begin

    6016. 

  6016.     Result := PutStringInSendBuffer(UnicodeToAnsi(Str, ACodePage));  // Explicit cast

    6017. 

  6017. end;

    6018. 

  6018. 

    6019. 

  6019. 

    6020. 

  6020. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    6021. 

  6021. function TCustomWSocket.PutStringInSendBuffer(const Str : UnicodeString): Integer;

    6022. 

  6022. begin

    6023. 

  6023.     Result := PutStringInSendBuffer(AnsiString(Str));  // Explicit cast

    6024. 

  6024. end;

    6025. 

  6025. {$ENDIF}

    6026. 

  6026. 

    6027. 

  6027. 

    6028. 

  6028. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    6029. 

  6029. procedure TCustomWSocket.PutDataInSendBuffer(

    6030. 

  6030.     Data : TWSocketData;

    6031. 

  6031.     Len  : Integer);

    6032. 

  6032. begin

    6033. 

  6033.     if (Len <= 0) or (Data = nil) then

    6034. 

  6034.         Exit;

    6035. 

  6035. 

    6036. 

  6036.     FBufHandler.Lock;

    6037. 

  6037.     try

    6038. 

  6038.         FBufHandler.Write(Data, Len);

    6039. 

  6039.         Inc(FBufferedByteCount, Len);

    6040. 

  6040.         bAllSent := FALSE;

    6041. 

  6041.     finally

    6042. 

  6042.         FBufHandler.UnLock;

    6043. 

  6043.     end;

    6044. 

  6044. end;

    6045. 

  6045. 

    6046. 

  6046. 

    6047. 

  6047. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    6048. 

  6048. { Return -1 if error, else return number of byte written                    }

    6049. 

  6049. function TCustomWSocket.Send({$IFDEF CLR} const {$ENDIF} Data : TWSocketData; Len : Integer) : Integer;

    6050. 

  6050. begin

    6051. 

  6051.     if (FState <> wsConnected) and (FState <> wsSocksConnected) then begin

    6052. 

  6052.         WSocket_Synchronized_WSASetLastError(WSAENOTCONN);

    6053. 

  6053.         SocketError('Send');

    6054. 

  6054.         Result := -1;

    6055. 

  6055.         Exit;

    6056. 

  6056.     end;

    6057. 

  6057. 

    6058. 

  6058.     bAllSent := FALSE;

    6059. 

  6059.     if Len <= 0 then

    6060. 

  6060.         Result := 0

    6061. 

  6061.     else begin

    6062. 

  6062.         Result   := Len;

    6063. 

  6063.         PutDataInSendBuffer(Data, Len);

    6064. 

  6064.     end;

    6065. 

  6065. 

    6066. 

  6066.     if bAllSent then

    6067. 

  6067.         Exit;

    6068. 

  6068. 

    6069. 

  6069.     TryToSend;

    6070. 

  6070. 

    6071. 

  6071.     if bAllSent then begin

    6072. 

  6072.         { We post a message to fire the FD_WRITE message wich in turn will }

    6073. 

  6073.         { fire the OnDataSent event. We cannot fire the event ourself      }

    6074. 

  6074.         { because the event handler will eventually call send again.       }

    6075. 

  6075.         { Sending the message prevent recursive call and stack overflow.   }

    6076. 

  6076.         { The PostMessage function posts (places) a message in a window's  }

    6077. 

  6077.         { message queue and then returns without waiting for the           }

    6078. 

  6078.         { corresponding window to process the message. The message will be }

    6079. 

  6079.         { seen and routed by Delphi a litle later, when we will be out of  }

    6080. 

  6080.         { the send function.                                               }

    6081. 

  6081.         _PostMessage(Handle,

    6082. 

  6082.                     FMsg_WM_ASYNCSELECT,

    6083. 

  6083.                     FHSocket,

    6084. 

  6084.                     MakeLong(FD_WRITE, 0));

    6085. 

  6085.     end;

    6086. 

  6086. end;

    6087. 

  6087. 

    6088. 

  6088. 

    6089. 

  6089. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    6090. 

  6090. function TCustomWSocket.Send(DataByte : Byte) : Integer;

    6091. 

  6091. {$IFDEF CLR}

    6092. 

  6092. var

    6093. 

  6093.     Buf : TBytes;

    6094. 

  6094. begin

    6095. 

  6095.     SetLength(Buf, 1);

    6096. 

  6096.     Buf[1] := DataByte;

    6097. 

  6097.     Result := Send(Buf, 1);

    6098. 

  6098.     SetLength(Buf, 0);

    6099. 

  6099. end;

    6100. 

  6100. {$ENDIF}

    6101. 

  6101. {$IFDEF WIN32}

    6102. 

  6102. begin

    6103. 

  6103.     Result := Send(@DataByte, 1);

    6104. 

  6104. end;

    6105. 

  6105. {$ENDIF}

    6106. 

  6106. 

    6107. 

  6107. 

    6108. 

  6108. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    6109. 

  6109. { Return -1 if error, else return number of bytes written }

    6110. 

  6110. {$IFDEF COMPILER12_UP}

    6111. 

  6111. function TCustomWSocket.SendStr(const Str : UnicodeString; ACodePage : LongWord) : Integer;

    6112. 

  6112. begin

    6113. 

  6113.     Result := SendStr(UnicodeToAnsi(Str, ACodePage));

    6114. 

  6114. end;

    6115. 

  6115. 

    6116. 

  6116. 

    6117. 

  6117. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    6118. 

  6118. { Converts UnicodeString to AnsiString using System.DefaultSystemCodePage   }

    6119. 

  6119. function TCustomWSocket.SendStr(const Str : UnicodeString) : Integer;

    6120. 

  6120. begin

    6121. 

  6121.     Result := SendStr(AnsiString(Str)); // RTL convert

    6122. 

  6122. end;

    6123. 

  6123. {$ENDIF}

    6124. 

  6124. 

    6125. 

  6125. 

    6126. 

  6126. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    6127. 

  6127. { Return -1 if error, else return number of byte written                    }

    6128. 

  6128. function TCustomWSocket.SendStr(const Str : RawByteString) : Integer;

    6129. 

  6129. begin

    6130. 

  6130.     Result := Length(Str);

    6131. 

  6131.     if Result > 0 then

    6132. 

  6132.         Result := Send({$IFDEF CLR}

    6133. 

  6133.                        System.Text.Encoding.Default.GetBytes(Str),

    6134. 

  6134.                        {$ENDIF}

    6135. 

  6135.                        {$IFDEF WIN32}

    6136. 

  6136.                        PAnsiChar(Str),

    6137. 

  6137.                        {$ENDIF}

    6138. 

  6138.                        Result);

    6139. 

  6139. end;

    6140. 

  6140. 

    6141. 

  6141. 

    6142. 

  6142. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    6143. 

  6143. procedure TCustomWSocket.SendText(const Str : RawByteString);

    6144. 

  6144. begin

    6145. 

  6145.     SendStr(Str);

    6146. 

  6146. end;

    6147. 

  6147. 

    6148. 

  6148. 

    6149. 

  6149. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    6150. 

  6150. {$IFDEF COMPILER12_UP}

    6151. 

  6151. procedure TCustomWSocket.SendText(const Str : UnicodeString);

    6152. 

  6152. begin

    6153. 

  6153.     SendStr(AnsiString(Str));

    6154. 

  6154. end;

    6155. 

  6155. 

    6156. 

  6156. 

    6157. 

  6157. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    6158. 

  6158. procedure TCustomWSocket.SendText(const Str : UnicodeString; ACodePage : LongWord);

    6159. 

  6159. begin

    6160. 

  6160.     SendStr(Str, ACodePage);

    6161. 

  6161. end;

    6162. 

  6162. {$ENDIF}

    6163. 

  6163. 

    6164. 

  6164. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    6165. 

  6165. function HasOption(

    6166. 

  6166.     OptSet : TWSocketOptions;

    6167. 

  6167.     Opt    : TWSocketOption): Boolean;

    6168. 

  6168. begin

    6169. 

  6169. {$IFDEF CLR}

    6170. 

  6170.     Result := (Ord(OptSet) and Ord(Opt)) <> 0;

    6171. 

  6171. {$ENDIF}

    6172. 

  6172. {$IFDEF WIN32}

    6173. 

  6173.     Result := Opt in OptSet;

    6174. 

  6174. {$ENDIF}

    6175. 

  6175. end;

    6176. 

  6176. 

    6177. 

  6177. 

    6178. 

  6178. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    6179. 

  6179. function AddOptions(Opts: array of TWSocketOption): TWSocketOptions;

    6180. 

  6180. var

    6181. 

  6181.     I : Integer;

    6182. 

  6182. begin

    6183. 

  6183. {$IFDEF CLR}

    6184. 

  6184.     Result := wsoNone;

    6185. 

  6185.     for I := Low(Opts) to High(Opts) do

    6186. 

  6186.         Result := TWSocketOptions(Integer(Result) + Integer(Opts[I]));

    6187. 

  6187. {$ENDIF}

    6188. 

  6188. {$IFDEF WIN32}

    6189. 

  6189.     Result := [];

    6190. 

  6190.     for I := Low(Opts) to High(Opts) do

    6191. 

  6191.         //Result := Result + [Opts[I]];  { Anton Sviridov }

    6192. 

  6192.         Include(Result, Opts[I]);

    6193. 

  6193. {$ENDIF}

    6194. 

  6194. end;

    6195. 

  6195. 

    6196. 

  6196. 

    6197. 

  6197. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    6198. 

  6198. function  RemoveOption(

    6199. 

  6199.     OptSet : TWSocketOptions;

    6200. 

  6200.     Opt    : TWSocketOption) : TWSocketOptions;

    6201. 

  6201. begin

    6202. 

  6202. {$IFDEF CLR}

    6203. 

  6203.     Result := TWSocketOptions(Ord(OptSet) and (not Ord(Opt)));

    6204. 

  6204. {$ENDIF}

    6205. 

  6205. {$IFDEF WIN32}

    6206. 

  6206.     Result := OptSet - [Opt];

    6207. 

  6207. {$ENDIF}

    6208. 

  6208. end;

    6209. 

  6209. 

    6210. 

  6210. 

    6211. 

  6211. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    6212. 

  6212. procedure TCustomWSocket.ASyncReceive(

    6213. 

  6213.     Error           : Word;

    6214. 

  6214.     MySocketOptions : TWSocketOptions);

    6215. 

  6215. var

    6216. 

  6216.     bMore        : Boolean;

    6217. 

  6217.     lCount       : {$IFDEF FPC} LongWord; {$ELSE} u_long; {$ENDIF}

    6218. 

  6218. {$IFDEF WIN32}

    6219. 

  6219.     TrashCanBuf  : array [0..1023] of AnsiChar;  { AG 1/12/08 }

    6220. 

  6220. {$ENDIF}

    6221. 

  6221.     TrashCan     : TWSocketData;

    6222. 

  6222.     TrashCanSize : Integer;

    6223. 

  6223. begin

    6224. 

  6224.     bMore := TRUE;

    6225. 

  6225.     while bMore do begin

    6226. 

  6226.         FLastError := 0;

    6227. 

  6227. 

    6228. 

  6228.         try

    6229. 

  6229.             if not TriggerDataAvailable(Error) then begin

    6230. 

  6230.                 { Nothing wants to receive, we will receive and throw away  23/07/98 }

    6231. 

  6231.                 {$IFDEF CLR}

    6232. 

  6232.                 TrashCanSize := 1024;

    6233. 

  6233.                 SetLength(TrashCan, TrashCanSize);

    6234. 

  6234.                 {$ENDIF}

    6235. 

  6235.                 {$IFDEF WIN32}

    6236. 

  6236.                 TrashCanSize := SizeOf(TrashCan);

    6237. 

  6237.                 TrashCan     := @TrashCanBuf;

    6238. 

  6238.                 {$ENDIF}

    6239. 

  6239.                 if DoRecv(TrashCan, TrashCanSize, 0) = SOCKET_ERROR then begin

    6240. 

  6240.                     FLastError := WSocket_Synchronized_WSAGetLastError;

    6241. 

  6241.                     if FLastError = WSAEWOULDBLOCK then begin

    6242. 

  6242.                         FLastError := 0;

    6243. 

  6243.                         break;

    6244. 

  6244.                     end;

    6245. 

  6245.                 end;

    6246. 

  6246.             end;

    6247. 

  6247. 

    6248. 

  6248.             { DLR Honor the socket options being passed as parameters }

    6249. 

  6249.             if HasOption({FComponentOptions}MySocketOptions, wsoNoReceiveLoop) then  { V6.03 }

    6250. 

  6250.                 break;

    6251. 

  6251. 

    6252. 

  6252.             if FLastError <> 0 then begin

    6253. 

  6253.                 bMore := FALSE;

    6254. 

  6254.                 { -1 value is not a true error but is used to break the loop }

    6255. 

  6255.                 if FLastError = -1 then

    6256. 

  6256.                     FLastError := 0;

    6257. 

  6257.             end

    6258. 

  6258.             { Check if we have something new arrived, if yes, process it }

    6259. 

  6259.             else if WSocket_Synchronized_ioctlsocket(FHSocket, FIONREAD,

    6260. 

  6260.                                                      lCount) = SOCKET_ERROR then begin

    6261. 

  6261.                 FLastError := WSocket_Synchronized_WSAGetLastError;

    6262. 

  6262.                 bMore      := FALSE;

    6263. 

  6263.             end

    6264. 

  6264.             else if lCount = 0 then

    6265. 

  6265.                 bMore := FALSE;

    6266. 

  6266.         except

    6267. 

  6267.             bMore := FALSE;

    6268. 

  6268.         end;

    6269. 

  6269.     end;

    6270. 

  6270. end;

    6271. 

  6271. 

    6272. 

  6272. 

    6273. 

  6273. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    6274. 

  6274. procedure TCustomWSocket.Do_FD_CONNECT(var msg: TMessage);

    6275. 

  6275. begin

    6276. 

  6276.     if FState <> wsConnected then begin

    6277. 

  6277.         ChangeState(wsConnected);

    6278. 

  6278.         TriggerSessionConnectedSpecial(HiWord(msg.LParam));

    6279. 

  6279.         if (HiWord(msg.LParam) <> 0) and (FState <> wsClosed) then

    6280. 

  6280.             Close;

    6281. 

  6281.     end;

    6282. 

  6282. end;

    6283. 

  6283. 

    6284. 

  6284. 

    6285. 

  6285. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    6286. 

  6286. procedure TCustomWSocket.Do_FD_READ(var msg: TMessage);

    6287. 

  6287. begin

    6288. 

  6288.     if FState <> wsConnected then begin

    6289. 

  6289.       ChangeState(wsConnected);

    6290. 

  6290.       TriggerSessionConnectedSpecial(HiWord(msg.LParam));

    6291. 

  6291.     end;

    6292. 

  6292.     ASyncReceive(HiWord(msg.LParam), FComponentOptions);

    6293. 

  6293. end;

    6294. 

  6294. 

    6295. 

  6295. 

    6296. 

  6296. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    6297. 

  6297. procedure TCustomWSocket.Do_FD_WRITE(var msg: TMessage);

    6298. 

  6298. begin

    6299. 

  6299.     TryToSend;

    6300. 

  6300. { If you wants to test background exception, uncomment the next 2 lines. }

    6301. 

  6301. {   if bAllSent then                                                }

    6302. 

  6302. {       raise Exception.Create('Test TWSocket exception');          }

    6303. 

  6303.     if bAllSent then

    6304. 

  6304.         TriggerDataSent(HiWord(msg.LParam));

    6305. 

  6305. end;

    6306. 

  6306. 

    6307. 

  6307. 

    6308. 

  6308. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    6309. 

  6309. procedure TCustomWSocket.Do_FD_CLOSE(var msg: TMessage);

    6310. 

  6310. begin

    6311. 

  6311.     { In some strange situations I found that we receive a FD_CLOSE  }

    6312. 

  6312.     { during the connection phase, breaking the connection early !   }

    6313. 

  6313.     { This occurs for example after a failed FTP transfert Probably  }

    6314. 

  6314.     { something related to bugged winsock. Doesn't hurt with good    }

    6315. 

  6315.     { winsock. So let the code there !                               }

    6316. 

  6316.     if (FState <> wsConnecting) and (FHSocket <> INVALID_SOCKET) then begin

    6317. 

  6317.         { Check if we have something arrived, if yes, process it     }

    6318. 

  6318.         { DLR, since we are closing MAKE SURE WE LOOP in the receive }

    6319. 

  6319.         { function to get ALL remaining data                         }

    6320. 

  6320.         ASyncReceive(0, RemoveOption(FComponentOptions, wsoNoReceiveLoop));

    6321. 

  6321. 

    6322. 

  6322.         if not FCloseInvoked then begin

    6323. 

  6323.             FCloseInvoked := TRUE;

    6324. 

  6324.             TriggerSessionClosed(HiWord(msg.LParam));

    6325. 

  6325.         end;

    6326. 

  6326. 

    6327. 

  6327.         if FState <> wsClosed then

    6328. 

  6328.             Close;

    6329. 

  6329.     end;

    6330. 

  6330. end;

    6331. 

  6331. 

    6332. 

  6332. 

    6333. 

  6333. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    6334. 

  6334. procedure TCustomWSocket.Do_FD_ACCEPT(var msg: TMessage);

    6335. 

  6335. begin

    6336. 

  6336.     TriggerSessionAvailable(HiWord(msg.LParam));

    6337. 

  6337. end;

    6338. 

  6338. 

    6339. 

  6339. 

    6340. 

  6340. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    6341. 

  6341. {$IFNDEF NO_DEBUG_LOG}

    6342. 

  6342. function WinsockMsgToString(var msg: TMessage) : String;

    6343. 

  6343. begin

    6344. 

  6344.     Result := '';

    6345. 

  6345.     if (msg.lParam and FD_CONNECT) <> 0 then

    6346. 

  6346.         Result := Result + ' FD_CONNECT';

    6347. 

  6347.     if (msg.lParam and FD_READ) <> 0 then

    6348. 

  6348.         Result := Result + ' FD_READ';

    6349. 

  6349.     if (msg.lParam and FD_WRITE) <> 0 then

    6350. 

  6350.         Result := Result + ' FD_WRITE';

    6351. 

  6351.     if (msg.lParam and FD_CLOSE) <> 0 then

    6352. 

  6352.         Result := Result + ' FD_CLOSE';

    6353. 

  6353.     if (msg.lParam and FD_ACCEPT) <> 0 then

    6354. 

  6354.         Result := Result + ' FD_ACCEPT';

    6355. 

  6355. end;

    6356. 

  6356. {$ENDIF}

    6357. 

  6357. 

    6358. 

  6358. 

    6359. 

  6359. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    6360. 

  6360. procedure TCustomWSocket.WMASyncSelect(var msg: TMessage);

    6361. 

  6361. var

    6362. 

  6362.     Check   : Word;

    6363. 

  6363.     ParamLo : Word;

    6364. 

  6364. const

    6365. 

  6365.     TTTCount : Integer = 0;

    6366. 

  6366. begin

    6367. 

  6367. {TriggerDisplay('AsyncSelect ' + IntToStr(msg.wParam) + ', ' + IntToStr(msg.LParamLo));}

    6368. 

  6368.     { Verify that the socket handle is ours handle }

    6369. 

  6369.     if msg.wParam <> FHSocket then

    6370. 

  6370.         Exit;

    6371. 

  6371. 

    6372. 

  6372.     if FPaused then

    6373. 

  6373.         exit;

    6374. 

  6374. 

    6375. 

  6375.     ParamLo := LoWord(msg.lParam);

    6376. 

  6376. 

    6377. 

  6377.     Check := ParamLo and FD_CONNECT;

    6378. 

  6378.     if Check <> 0 then begin

    6379. 

  6379.         FSelectMessage := FD_CONNECT;

    6380. 

  6380.         Do_FD_CONNECT(msg);

    6381. 

  6381.     end;

    6382. 

  6382. 

    6383. 

  6383.     Check := ParamLo and FD_READ;

    6384. 

  6384.     if Check <> 0 then begin

    6385. 

  6385.         FSelectMessage := FD_READ;

    6386. 

  6386.         Do_FD_READ(msg);

    6387. 

  6387.     end;

    6388. 

  6388. 

    6389. 

  6389.     Check := ParamLo and FD_WRITE;

    6390. 

  6390.     if Check <> 0 then begin

    6391. 

  6391.         FSelectMessage := FD_WRITE;

    6392. 

  6392.         Do_FD_WRITE(msg);

    6393. 

  6393.     end;

    6394. 

  6394. 

    6395. 

  6395.     Check := ParamLo and FD_ACCEPT;

    6396. 

  6396.     if Check <> 0 then begin

    6397. 

  6397.         FSelectMessage := FD_ACCEPT;

    6398. 

  6398.         Do_FD_ACCEPT(msg);

    6399. 

  6399.     end;

    6400. 

  6400. 

    6401. 

  6401.     Check := ParamLo and FD_CLOSE;

    6402. 

  6402.     if Check <> 0 then begin

    6403. 

  6403.         FSelectMessage := FD_CLOSE;

    6404. 

  6404.         {WriteLn('FD_CLOSE ', FHSocket);}

    6405. 

  6405.         Do_FD_CLOSE(msg);

    6406. 

  6406.     end;

    6407. 

  6407.     FSelectMessage := 0;

    6408. 

  6408. end;

    6409. 

  6409. 

    6410. 

  6410. 

    6411. 

  6411. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    6412. 

  6412. {$IFDEF CLR}

    6413. 

  6413. procedure GetIPList(HostEntry : THostEnt; ToList : TStrings);

    6414. 

  6414. var

    6415. 

  6415.     AddrList   : IntPtr;

    6416. 

  6416.     AddrItem   : IntPtr;

    6417. 

  6417.     Addr       : Integer;

    6418. 

  6418.     I          : Integer;

    6419. 

  6419. begin

    6420. 

  6420.     ToList.Clear;

    6421. 

  6421.     I := 0;

    6422. 

  6422.     AddrList := Marshal.ReadIntPtr(HostEntry.h_addr_list);

    6423. 

  6423.     while TRUE do begin

    6424. 

  6424.         AddrItem  := Marshal.ReadIntPtr(HostEntry.h_addr_list, I);

    6425. 

  6425.         if AddrItem = IntPtr.Zero then

    6426. 

  6426.             break;

    6427. 

  6427.         Addr := Marshal.ReadInt32(AddrItem);

    6428. 

  6428.         ToList.Add(IntToStr((Addr and $FF)) + '.' +

    6429. 

  6429.                    IntToStr((Addr shr 8) and $FF) + '.' +

    6430. 

  6430.                    IntToStr((Addr shr 16) and $FF) + '.' +

    6431. 

  6431.                    IntToStr((Addr shr 24) and $FF));

    6432. 

  6432.         Inc(I, 4);

    6433. 

  6433.     end;

    6434. 

  6434. end;

    6435. 

  6435. 

    6436. 

  6436. 

    6437. 

  6437. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    6438. 

  6438. procedure GetAliasList(HostEntry : THostEnt; ToList : TStrings);

    6439. 

  6439. var

    6440. 

  6440.     AddrItem : IntPtr;

    6441. 

  6441.     I        : Integer;

    6442. 

  6442. begin

    6443. 

  6443.     I := 0;

    6444. 

  6444.     while TRUE do begin

    6445. 

  6445.         AddrItem  := Marshal.ReadIntPtr(HostEntry.h_aliases, I);

    6446. 

  6446.         if AddrItem = IntPtr.Zero then

    6447. 

  6447.             break;

    6448. 

  6448.         ToList.Add(Marshal.PtrToStringAnsi(AddrItem));

    6449. 

  6449.         Inc(I);

    6450. 

  6450.     end;

    6451. 

  6451. end;

    6452. 

  6452. {$ENDIF}

    6453. 

  6453. {$IFDEF WIN32}

    6454. 

  6454. procedure GetIPList(phe  : PHostEnt; ToList : TStrings);

    6455. 

  6455. type

    6456. 

  6456.     TaPInAddr = array [0..255] of PInAddr;

    6457. 

  6457.     PaPInAddr = ^TaPInAddr;

    6458. 

  6458. var

    6459. 

  6459.     pptr : PaPInAddr;

    6460. 

  6460.     I    : Integer;

    6461. 

  6461. begin

    6462. 

  6462.     pptr := PaPInAddr(Phe^.h_addr_list);

    6463. 

  6463. 

    6464. 

  6464.     I := 0;

    6465. 

  6465.     while pptr^[I] <> nil do begin

    6466. 

  6466.         ToList.Add(String(WSocket_inet_ntoa(pptr^[I]^)));

    6467. 

  6467.         Inc(I);

    6468. 

  6468.     end;

    6469. 

  6469. end;

    6470. 

  6470. 

    6471. 

  6471. 

    6472. 

  6472. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    6473. 

  6473. procedure GetAliasList(phe : PHostEnt; ToList : TStrings);

    6474. 

  6474. type

    6475. 

  6475.     TaPAnsiChar = array [0..255] of PAnsiChar;

    6476. 

  6476.     PaPAnsiChar = ^TaPAnsiChar;

    6477. 

  6477. var

    6478. 

  6478.     pptr : PaPAnsiChar;

    6479. 

  6479.     I    : Integer;

    6480. 

  6480. begin

    6481. 

  6481.     pptr := PaPAnsiChar(Phe^.h_aliases);

    6482. 

  6482.     I    := 0;

    6483. 

  6483.     while pptr^[I] <> nil do begin

    6484. 

  6484.         ToList.Add(String(pptr^[I]));

    6485. 

  6485.         Inc(I);

    6486. 

  6486.     end;

    6487. 

  6487. end;

    6488. 

  6488. {$ENDIF}

    6489. 

  6489. 

    6490. 

  6490. 

    6491. 

  6491. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    6492. 

  6492. procedure TCustomWSocket.WMAsyncGetHostByName(var msg: TMessage);

    6493. 

  6493. var

    6494. 

  6494.     ErrCode : Word;

    6495. 

  6495. {$IFDEF CLR}

    6496. 

  6496.     HostEntry : THostEnt;

    6497. 

  6497. {$ENDIF}

    6498. 

  6498. {$IFDEF WIN32}

    6499. 

  6499.     Phe     : Phostent;

    6500. 

  6500. {$ENDIF}

    6501. 

  6501. begin

    6502. 

  6502.     if FDnsLookupHandle = 0 then begin

    6503. 

  6503.         { We are still executing WSAAsyncGetHostByName and FDnsLookupHandle }

    6504. 

  6504.         { has not been assigned yet ! We should proceed later.              }

    6505. 

  6505.         FDnsLookupTempMsg  := msg;

    6506. 

  6506.         FDnsLookupCheckMsg := TRUE;

    6507. 

  6507.         Exit;

    6508. 

  6508.     end

    6509. 

  6509.     else if msg.wParam <> WPARAM(FDnsLookupHandle) then

    6510. 

  6510.         Exit;

    6511. 

  6511. 

    6512. 

  6512.     FDnsLookupHandle := 0;

    6513. 

  6513.     ErrCode := HiWord(Msg.LParam);

    6514. 

  6514. {$IFDEF CLR}

    6515. 

  6515.     if ErrCode = 0 then begin

    6516. 

  6516.         HostEntry := THostEnt(Marshal.PtrToStructure(FDnsLookupIntPtr, TypeOf(THostEnt)));

    6517. 

  6517.         GetIpList(HostEntry, FDnsResultList);

    6518. 

  6518.         if FDnsResultList.Count > 0 then

    6519. 

  6519.             FDnsResult := FDnsResultList.Strings[0];

    6520. 

  6520.     end;

    6521. 

  6521.     FDnsLookupGCH.Free;

    6522. 

  6522. {$ENDIF}

    6523. 

  6523. {$IFDEF WIN32}

    6524. 

  6524.     if ErrCode = 0 then begin

    6525. 

  6525.         Phe := PHostent(@FDnsLookupBuffer);

    6526. 

  6526.         if phe <> nil then begin

    6527. 

  6527.             GetIpList(Phe, FDnsResultList);

    6528. 

  6528.             FDnsResult := FDnsResultList.Strings[0];

    6529. 

  6529.         end;

    6530. 

  6530.     end;

    6531. 

  6531. {$ENDIF}

    6532. 

  6532.     TriggerDnsLookupDone(ErrCode);

    6533. 

  6533. end;

    6534. 

  6534. 

    6535. 

  6535. 

    6536. 

  6536. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    6537. 

  6537. procedure TCustomWSocket.WMAsyncGetHostByAddr(var msg: TMessage);

    6538. 

  6538. var

    6539. 

  6539. {$IFDEF CLR}

    6540. 

  6540.     HostEntry : THostEnt;

    6541. 

  6541. {$ENDIF}

    6542. 

  6542. {$IFDEF WIN32}

    6543. 

  6543.     Phe     : Phostent;

    6544. 

  6544. {$ENDIF}

    6545. 

  6545.     ErrCode : Word;

    6546. 

  6546. begin

    6547. 

  6547.     if msg.wParam <> WPARAM(FDnsLookupHandle) then

    6548. 

  6548.         Exit;

    6549. 

  6549.     FDnsLookupHandle := 0;

    6550. 

  6550.     ErrCode          := HiWord(Msg.LParam);

    6551. 

  6551.     if ErrCode = 0 then begin

    6552. 

  6552. {$IFDEF CLR}

    6553. 

  6553.         if FDnsLookupIntPtr <> IntPtr.Zero then begin

    6554. 

  6554.             HostEntry  := THostEnt(Marshal.PtrToStructure(FDnsLookupIntPtr, TypeOf(THostEnt)));

    6555. 

  6555.             FDnsResult := Marshal.PtrToStringAnsi(HostEntry.h_name);

    6556. 

  6556. {$ENDIF}

    6557. 

  6557. {$IFDEF WIN32}

    6558. 

  6558.         Phe := PHostent(@FDnsLookupBuffer);

    6559. 

  6559.         if phe <> nil then begin

    6560. 

  6560.             //SetLength(FDnsResult, _StrLen(Phe^.h_name));

    6561. 

  6561.             //_StrCopy(PAnsiChar(FDnsResult), Phe^.h_name);

    6562. 

  6562.             FDnsResult := String(_StrPas(Phe^.h_name));

    6563. 

  6563. {$ENDIF}

    6564. 

  6564.             FDnsResultList.Clear;

    6565. 

  6565.             FDnsResultList.Add(FDnsResult);

    6566. 

  6566. {$IFDEF CLR}

    6567. 

  6567.             GetAliasList(HostEntry, FDnsResultList);

    6568. 

  6568. {$ENDIF}

    6569. 

  6569. {$IFDEF WIN32}

    6570. 

  6570.             GetAliasList(Phe, FDnsResultList);  {AG 03/03/06}

    6571. 

  6571. {$ENDIF}

    6572. 

  6572.         end;

    6573. 

  6573.     end;

    6574. 

  6574.     TriggerDnsLookupDone(ErrCode);

    6575. 

  6575. end;

    6576. 

  6576. 

    6577. 

  6577. 

    6578. 

  6578. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    6579. 

  6579. procedure TCustomWSocket.SetProto(sProto : String);

    6580. 

  6580. begin

    6581. 

  6581.     if FProtoAssigned and (sProto = FProtoStr) then

    6582. 

  6582.         Exit;

    6583. 

  6583. 

    6584. 

  6584.     if FState <> wsClosed then begin

    6585. 

  6585.         RaiseException('Cannot change Proto if not closed');

    6586. 

  6586.         Exit;

    6587. 

  6587.     end;

    6588. 

  6588. 

    6589. 

  6589.     FProtoStr := _Trim(sProto);

    6590. 

  6590. 

    6591. 

  6591.     if Length(FProtoStr) = 0 then begin

    6592. 

  6592.         FProtoAssigned := FALSE;

    6593. 

  6593.         Exit;

    6594. 

  6594.     end;

    6595. 

  6595. 

    6596. 

  6596.     FProtoResolved := FALSE;

    6597. 

  6597.     FProtoAssigned := TRUE;

    6598. 

  6598. end;

    6599. 

  6599. 

    6600. 

  6600. 

    6601. 

  6601. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    6602. 

  6602. procedure TCustomWSocket.SetRemotePort(sPort : String);

    6603. 

  6603. begin

    6604. 

  6604.     if FPortAssigned and (FPortStr = sPort) then

    6605. 

  6605.         Exit;

    6606. 

  6606. 

    6607. 

  6607.     if FState <> wsClosed then begin

    6608. 

  6608.         RaiseException('Cannot change Port if not closed');

    6609. 

  6609.         Exit;

    6610. 

  6610.     end;

    6611. 

  6611. 

    6612. 

  6612.     FPortStr := _Trim(sPort);

    6613. 

  6613. 

    6614. 

  6614.     if Length(FPortStr) = 0 then begin

    6615. 

  6615.         FPortAssigned := FALSE;

    6616. 

  6616.         Exit;

    6617. 

  6617.     end;

    6618. 

  6618. 

    6619. 

  6619.     FPortResolved := FALSE;

    6620. 

  6620.     FPortAssigned := TRUE;

    6621. 

  6621. end;

    6622. 

  6622. 

    6623. 

  6623. 

    6624. 

  6624. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    6625. 

  6625. 

    6626. 

  6626. function TCustomWSocket.GetRemotePort : String;

    6627. 

  6627. begin

    6628. 

  6628.     Result := FPortStr;

    6629. 

  6629. end;

    6630. 

  6630. 

    6631. 

  6631. 

    6632. 

  6632. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    6633. 

  6633. procedure TCustomWSocket.SetLocalPort(const sLocalPort : String);

    6634. 

  6634. begin

    6635. 

  6635.     if FState <> wsClosed then begin

    6636. 

  6636.         RaiseException('Cannot change LocalPort if not closed');

    6637. 

  6637.         Exit;

    6638. 

  6638.     end;

    6639. 

  6639. 

    6640. 

  6640.     FLocalPortStr      := sLocalPort;

    6641. 

  6641.     FLocalPortResolved := FALSE;

    6642. 

  6642. end;

    6643. 

  6643. 

    6644. 

  6644. 

    6645. 

  6645. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    6646. 

  6646. procedure TCustomWSocket.SetLocalAddr(sLocalAddr : String);

    6647. 

  6647. {var

    6648. 

  6648.     IPAddr  : TInAddr;}

    6649. 

  6649. begin

    6650. 

  6650.     if FState <> wsClosed then begin

    6651. 

  6651.         RaiseException('Cannot change LocalAddr if not closed');

    6652. 

  6652.         Exit;

    6653. 

  6653.     end;

    6654. 

  6654. 

    6655. 

  6655.     if Length(sLocalAddr) = 0 then

    6656. 

  6656.         sLocalAddr := '0.0.0.0';

    6657. 

  6657. {$IFDEF NEVER}

    6658. 

  6658. {$IFDEF DELPHI1}

    6659. 

  6659.     sLocalAddr := sLocalAddr + #0;

    6660. 

  6660. {$ENDIF}

    6661. 

  6661.     IPAddr.S_addr := WSocket_Synchronized_inet_addr(sLocalAddr);

    6662. 

  6662.     if IPAddr.S_addr = u_long(INADDR_NONE) then

    6663. 

  6663.         RaiseException('SetLocalAddr(): Invalid IP address');

    6664. 

  6664.     FLocalAddr := StrPas(WSocket_Synchronized_inet_ntoa(IPAddr));

    6665. 

  6665. {$ELSE}

    6666. 

  6666.     FLocalAddr := sLocalAddr;

    6667. 

  6667. {$ENDIF}

    6668. 

  6668. end;

    6669. 

  6669. 

    6670. 

  6670. 

    6671. 

  6671. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    6672. 

  6672. function TCustomWSocket.GetXPort: String;

    6673. 

  6673. var

    6674. 

  6674.     saddr    : TSockAddrIn;

    6675. 

  6675.     saddrlen : Integer;

    6676. 

  6676.     port     : Integer;

    6677. 

  6677. begin

    6678. 

  6678.     Result := 'error';

    6679. 

  6679.     if FState in [wsConnected, wsBound, wsListening] then begin

    6680. 

  6680.         saddrlen := sizeof(saddr);

    6681. 

  6681.         if WSocket_Synchronized_GetSockName(FHSocket, TSockAddr(saddr), saddrlen) = 0 then begin

    6682. 

  6682.             port     := WSocket_Synchronized_ntohs(saddr.sin_port);

    6683. 

  6683.             Result   := _IntToStr(port);

    6684. 

  6684.         end;

    6685. 

  6685.     end;

    6686. 

  6686. end;

    6687. 

  6687. 

    6688. 

  6688. 

    6689. 

  6689. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    6690. 

  6690. function TCustomWSocket.GetXAddr: String;

    6691. 

  6691. var

    6692. 

  6692.     saddr    : TSockAddrIn;

    6693. 

  6693.     saddrlen : Integer;

    6694. 

  6694. begin

    6695. 

  6695.     Result := 'error';

    6696. 

  6696.     if FState in [wsConnected, wsBound, wsListening] then begin

    6697. 

  6697.         saddrlen := sizeof(saddr);

    6698. 

  6698.         if WSocket_Synchronized_GetSockName(FHSocket, TSockAddr(saddr), saddrlen) = 0 then

    6699. 

  6699.             Result := String(WSocket_Synchronized_inet_ntoa(saddr.sin_addr));

    6700. 

  6700.      end;

    6701. 

  6701. end;

    6702. 

  6702. 

    6703. 

  6703. 

    6704. 

  6704. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    6705. 

  6705. procedure TCustomWSocket.SetAddr(InAddr : String);

    6706. 

  6706. begin

    6707. 

  6707.     if FAddrAssigned and (FAddrStr = InAddr) then

    6708. 

  6708.         Exit;

    6709. 

  6709. 

    6710. 

  6710.     if FState <> wsClosed then begin

    6711. 

  6711.         RaiseException('Cannot change Addr if not closed');

    6712. 

  6712.         Exit;

    6713. 

  6713.     end;

    6714. 

  6714. 

    6715. 

  6715.     FAddrStr := _Trim(InAddr);

    6716. 

  6716. 

    6717. 

  6717.     if Length(FAddrStr) = 0 then begin

    6718. 

  6718.         FAddrAssigned := FALSE;

    6719. 

  6719.         Exit;

    6720. 

  6720.     end;

    6721. 

  6721. 

    6722. 

  6722.     FAddrResolved       := FALSE;

    6723. 

  6723.     FAddrAssigned       := TRUE;

    6724. 

  6724. end;

    6725. 

  6725. 

    6726. 

  6726. 

    6727. 

  6727. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    6728. 

  6728. function WSocket_Synchronized_ResolveHost(InAddr : AnsiString) : TInAddr;

    6729. 

  6729. var

    6730. 

  6730. {$IFDEF CLR}

    6731. 

  6731.     Phe       : IntPtr;

    6732. 

  6732.     HostEntry : THostEnt;

    6733. 

  6733.     AddrList  : IntPtr;

    6734. 

  6734.     AddrItem  : IntPtr;

    6735. 

  6735. {$ENDIF}

    6736. 

  6736. {$IFDEF WIN32}

    6737. 

  6737.     Phe     : Phostent;

    6738. 

  6738. {$ENDIF}

    6739. 

  6739.     IPAddr  : u_long;

    6740. 

  6740. begin

    6741. 

  6741.     if InAddr = '' then

    6742. 

  6742.       {  raise ESocketException.Create('WSocketResolveHost: ''' + InAddr + ''' Invalid Hostname.'); }

    6743. 

  6743.         raise ESocketException.Create('Winsock Resolve Host: ''' + String(InAddr) + ''' Invalid Hostname.');   { V5.26 }

    6744. 

  6744. 

    6745. 

  6745. 

    6746. 

  6746.     if WSocketIsDottedIP(InAddr) then begin

    6747. 

  6747.         { Address is a dotted numeric address like 192.161.124.32 }

    6748. 

  6748.         IPAddr := WSocket_Synchronized_inet_addr(InAddr);

    6749. 

  6749. {$IFDEF DELPHI1}

    6750. 

  6750.         { With Trumpet Winsock 2B and 30D (win 3.11), inet_addr returns faulty }

    6751. 

  6751.         { results for 0.0.0.0                                                  }

    6752. 

  6752.         if (IPAddr = INADDR_NONE) and (InAddr = '0.0.0.0') then begin

    6753. 

  6753.             Result.s_addr := 0;

    6754. 

  6754.             Exit;

    6755. 

  6755.         end;

    6756. 

  6756. {$ENDIF}

    6757. 

  6757.         if IPAddr = u_long(INADDR_NONE) then begin

    6758. 

  6758.             if InAddr = '255.255.255.255' then begin

    6759. 

  6759.                 Result.s_addr := u_long(INADDR_BROADCAST);

    6760. 

  6760.                 Exit;

    6761. 

  6761.             end;

    6762. 

  6762.        {     raise ESocketException.Create('WSocketResolveHost: ''' + InAddr + ''' Invalid IP address.');  }

    6763. 

  6763.             raise ESocketException.Create('Winsock Resolve Host: ''' + String(InAddr) +

    6764. 

  6764.                                          ''' Invalid IP address.');   { V5.26 }

    6765. 

  6765.         end;

    6766. 

  6766.         Result.s_addr := IPAddr;

    6767. 

  6767.         Exit;

    6768. 

  6768.     end;

    6769. 

  6769. 

    6770. 

  6770. {$IFDEF CLR}

    6771. 

  6771.     Phe := OverByteIcsWinsock.GetHostByName(InAddr);

    6772. 

  6772.     if Phe = IntPtr.Zero then

    6773. 

  6773.         raise ESocketException.Create(

    6774. 

  6774.          { 'WSocketResolveHost: Cannot convert host address ''' + InAddr +

    6775. 

  6775.            ''', Error #' + IntToStr(WSAGetLastError)); }

    6776. 

  6776.            'Winsocket Resolve Host: Cannot convert host address ''' + InAddr +

    6777. 

  6777.            ''', Error #' + IntToStr(WSAGetLastError));

    6778. 

  6778.     HostEntry     := THostEnt(Marshal.PtrToStructure(Phe, TypeOf(THostEnt)));

    6779. 

  6779.     AddrList      := Marshal.ReadIntPtr(HostEntry.h_addr_list);

    6780. 

  6780.     AddrItem      := Marshal.ReadIntPtr(HostEntry.h_addr_list);

    6781. 

  6781.     Result.s_addr := Marshal.ReadInt32(AddrItem);

    6782. 

  6782. {$ENDIF}

    6783. 

  6783. {$IFDEF WIN32}

    6784. 

  6784.     { Address is a hostname }

    6785. 

  6785.     Phe := WSocket_Synchronized_GetHostByName(PAnsiChar(InAddr));

    6786. 

  6786.     if Phe = nil then

    6787. 

  6787.         raise ESocketException.Create(

    6788. 

  6788.                  'Winsock Resolve Host: Cannot convert host address ''' +

    6789. 

  6789.                  String(InAddr) + ''' - ' +

    6790. 

  6790.                  GetWinsockErr(WSocket_Synchronized_WSAGetLastError));

    6791. 

  6791.     Result.s_addr := PInAddr(Phe^.h_addr_list^)^.s_addr;

    6792. 

  6792. {$ENDIF}

    6793. 

  6793. end;

    6794. 

  6794. 

    6795. 

  6795. 

    6796. 

  6796. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    6797. 

  6797. function WSocketResolveHost(InAddr : AnsiString) : TInAddr;

    6798. 

  6798. begin

    6799. 

  6799. {$IFNDEF NO_ADV_MT}

    6800. 

  6800.     SafeIncrementCount;

    6801. 

  6801.     try

    6802. 

  6802. {$ENDIF}

    6803. 

  6803.         Result := WSocket_Synchronized_ResolveHost(InAddr);

    6804. 

  6804. {$IFNDEF NO_ADV_MT}

    6805. 

  6805.     finally

    6806. 

  6806.         SafeDecrementCount;

    6807. 

  6807.     end;

    6808. 

  6808. {$ENDIF}

    6809. 

  6809. end;

    6810. 

  6810. 

    6811. 

  6811. 

    6812. 

  6812. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    6813. 

  6813. { Convert port name or number to number in host order (ftp -> 21)           }

    6814. 

  6814. function WSocket_Synchronized_ResolvePort(Port : AnsiString; Proto : AnsiString) : WORD;

    6815. 

  6815. {$IFDEF CLR}

    6816. 

  6816. var

    6817. 

  6817.     Pse       : IntPtr;

    6818. 

  6818.     ServEntry : TServEnt;

    6819. 

  6819. begin

    6820. 

  6820.     if Port = '' then

    6821. 

  6821.       {  raise ESocketException.Create('WSocketResolvePort: Invalid Port.'); }

    6822. 

  6822.         raise ESocketException.Create('Winsock Resolve Port: Invalid Port.');    { V5.26 }

    6823. 

  6823. 

    6824. 

  6824. 

    6825. 

  6825.     if IsDigit(Port[1]) then

    6826. 

  6826.         Result := atoi(Port)

    6827. 

  6827.     else begin

    6828. 

  6828.         if not GWSAStartupCalled then

    6829. 

  6829.             WSocket_Synchronized_WSAStartup(MAKEWORD(GReqVerLow, GReqVerHigh), GInitData);

    6830. 

  6830.         if Proto = '' then

    6831. 

  6831.             Pse := OverByteIcsWinsock.GetServByName(Port, '')

    6832. 

  6832.         else

    6833. 

  6833.             Pse := OverByteIcsWinsock.GetServByName(Port, Proto);

    6834. 

  6834.         if Pse = IntPtr.Zero then

    6835. 

  6835.             raise ESocketException.Create(

    6836. 

  6836.                      'Winsock Resolve Port: Cannot convert port ''' +

    6837. 

  6837.                      Port + ''' - ' +

    6838. 

  6838.                      GetWinsockErr(OverByteIcsWinsock.WSAGetLastError)); { V5.26 }

    6839. 

  6839.         ServEntry := TServEnt(Marshal.PtrToStructure(Pse, TypeOf(TServEnt)));

    6840. 

  6840.         Result    := OverByteIcsWinsock.ntohs(ServEntry.s_port);

    6841. 

  6841.     end;

    6842. 

  6842. end;

    6843. 

  6843. {$ENDIF}

    6844. 

  6844. {$IFDEF WIN32}

    6845. 

  6845. var

    6846. 

  6846.     Pse      : Pservent;

    6847. 

  6847. begin

    6848. 

  6848.     if Port = '' then

    6849. 

  6849.       { raise ESocketException.Create('WSocketResolvePort: Invalid Port.'); }

    6850. 

  6850.         raise ESocketException.Create('Winsock Resolve Port: Invalid Port.');

    6851. 

  6851. 

    6852. 

  6852.     if Proto = '' then

    6853. 

  6853.         raise ESocketException.Create('Winsock Resolve Port: Invalid Proto.');

    6854. 

  6854. 

    6855. 

  6855.     if IsDigit(Port[1]) then

    6856. 

  6856.         Result := atoi(Port)

    6857. 

  6857.     else begin

    6858. 

  6858.         Pse := WSocket_Synchronized_GetServByName(PAnsiChar(Port), PAnsiChar(Proto));

    6859. 

  6859.         if Pse = nil then

    6860. 

  6860.             raise ESocketException.Create(

    6861. 

  6861.                       'Winsock Resolve Port: Cannot convert port ''' +

    6862. 

  6862.                       String(Port) + ''' - ' +

    6863. 

  6863.                       GetWinsockErr(WSocket_Synchronized_WSAGetLastError)); { V5.26 }

    6864. 

  6864.         Result := WSocket_Synchronized_ntohs(Pse^.s_port);

    6865. 

  6865.     end;

    6866. 

  6866. end;

    6867. 

  6867. {$ENDIF}

    6868. 

  6868. 

    6869. 

  6869. 

    6870. 

  6870. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    6871. 

  6871. { Convert port name or number to number in host order (ftp -> 21)           }

    6872. 

  6872. function WSocketResolvePort(Port : AnsiString; Proto : AnsiString) : Word;

    6873. 

  6873. begin

    6874. 

  6874. {$IFNDEF NO_ADV_MT}

    6875. 

  6875.     SafeIncrementCount;

    6876. 

  6876.     try

    6877. 

  6877. {$ENDIF}

    6878. 

  6878.         Result := WSocket_Synchronized_ResolvePort(Port, Proto);

    6879. 

  6879. {$IFNDEF NO_ADV_MT}

    6880. 

  6880.     finally

    6881. 

  6881.         SafeDecrementCount;

    6882. 

  6882.     end;

    6883. 

  6883. {$ENDIF}

    6884. 

  6884. end;

    6885. 

  6885. 

    6886. 

  6886. 

    6887. 

  6887. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    6888. 

  6888. function WSocket_Synchronized_ResolveProto(sProto : AnsiString) : Integer;

    6889. 

  6889. var

    6890. 

  6890. {$IFDEF CLR}

    6891. 

  6891.     Ppe        : IntPtr;

    6892. 

  6892.     ProtoEntry : TProtoEnt;

    6893. 

  6893. {$ENDIF}

    6894. 

  6894. {$IFDEF WIN32}

    6895. 

  6895.     Ppe     : Pprotoent;

    6896. 

  6896. {$ENDIF}

    6897. 

  6897. begin

    6898. 

  6898.     if sProto = '' then

    6899. 

  6899.       {  raise ESocketException.Create('WSocketResolveProto: Invalid Protocol.');  }

    6900. 

  6900.         raise ESocketException.Create('Winsock Resolve Proto: Invalid Protocol.');  { V5.26 }

    6901. 

  6901. 

    6902. 

  6902.     if IsDigit(sProto[1]) then

    6903. 

  6903.         Result := atoi(sProto)

    6904. 

  6904.     else begin

    6905. 

  6905.         sProto := _LowerCase(_Trim(sProto));

    6906. 

  6906.         if sProto = 'tcp' then

    6907. 

  6907.             Result := IPPROTO_TCP

    6908. 

  6908.         else if sProto = 'udp' then

    6909. 

  6909.             Result := IPPROTO_UDP

    6910. 

  6910.         else if sProto = 'raw' then

    6911. 

  6911.             Result := IPPROTO_RAW

    6912. 

  6912.         else begin

    6913. 

  6913. {$IFDEF CLR}

    6914. 

  6914.         ppe := OverByteIcsWinsock.getprotobyname(sProto);

    6915. 

  6915.         if Ppe = IntPtr.Zero then

    6916. 

  6916.             raise ESocketException.Create(

    6917. 

  6917.                       'Winsock Resolve Proto: Cannot convert protocol ''' +

    6918. 

  6918.                       sProto + '''- ' +

    6919. 

  6919.                       GetWinsockErr(OverByteIcsWinsock.WSAGetLastError)); { V5.26 }

    6920. 

  6920.         ProtoEntry := TProtoEnt(Marshal.PtrToStructure(Ppe, TypeOf(TProtoEnt)));

    6921. 

  6921.         Result     := ProtoEntry.p_proto;

    6922. 

  6922. {$ENDIF}

    6923. 

  6923. {$IFDEF WIN32}

    6924. 

  6924.             ppe := WSocket_Synchronized_getprotobyname(sProto);

    6925. 

  6925.             if Ppe = nil then

    6926. 

  6926.                 raise ESocketException.Create(

    6927. 

  6927.                           'Winsock Resolve Proto: Cannot convert protocol ''' +

    6928. 

  6928.                           String(sProto) + ''' - ' +

    6929. 

  6929.                           GetWinsockErr(WSocket_Synchronized_WSAGetLastError));    { V5.26 }

    6930. 

  6930.             Result := ppe^.p_proto;

    6931. 

  6931. {$ENDIF}

    6932. 

  6932.         end;

    6933. 

  6933.     end;

    6934. 

  6934. end;

    6935. 

  6935. 

    6936. 

  6936. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    6937. 

  6937. function WSocketResolveProto(sProto : AnsiString) : Integer;

    6938. 

  6938. begin

    6939. 

  6939. {$IFNDEF NO_ADV_MT}

    6940. 

  6940.     SafeIncrementCount;

    6941. 

  6941.     try

    6942. 

  6942. {$ENDIF}

    6943. 

  6943.         Result := WSocket_Synchronized_ResolveProto(sProto);

    6944. 

  6944. {$IFNDEF NO_ADV_MT}

    6945. 

  6945.     finally

    6946. 

  6946.         SafeDecrementCount;

    6947. 

  6947.     end;

    6948. 

  6948. {$ENDIF}

    6949. 

  6949. end;

    6950. 

  6950. 

    6951. 

  6951. 

    6952. 

  6952. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    6953. 

  6953. function TCustomWSocket.GetSockName(var saddr : TSockAddrIn; var saddrlen : Integer) : Integer;

    6954. 

  6954. begin

    6955. 

  6955.     Result := WSocket_Synchronized_GetSockName(FHSocket, TSockAddr(saddr), saddrlen);

    6956. 

  6956. end;

    6957. 

  6957. 

    6958. 

  6958. 

    6959. 

  6959. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    6960. 

  6960. function TCustomWSocket.GetPeerAddr: String;

    6961. 

  6961. var

    6962. 

  6962.     saddr    : TSockAddrIn;

    6963. 

  6963.     saddrlen : Integer;

    6964. 

  6964. begin

    6965. 

  6965. {$IFDEF CLR}

    6966. 

  6966.     if DesignMode then begin

    6967. 

  6967.         Result := '';

    6968. 

  6968.         Exit;

    6969. 

  6969.     end;

    6970. 

  6970. {$ENDIF}

    6971. 

  6971.     Result := 'error';

    6972. 

  6972.     if FState = wsConnected then begin

    6973. 

  6973.         saddrlen := sizeof(saddr);

    6974. 

  6974.         if WSocket_Synchronized_GetPeerName(FHSocket, TSockAddr(saddr), saddrlen) = 0 then

    6975. 

  6975.             Result := String(WSocket_Synchronized_inet_ntoa(saddr.sin_addr))

    6976. 

  6976.         else begin

    6977. 

  6977.             SocketError('GetPeerName');

    6978. 

  6978.             Exit;

    6979. 

  6979.         end;

    6980. 

  6980.     end;

    6981. 

  6981. end;

    6982. 

  6982. 

    6983. 

  6983. 

    6984. 

  6984. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    6985. 

  6985. function TCustomWSocket.GetPeerPort: String;

    6986. 

  6986. var

    6987. 

  6987.     saddr    : TSockAddrIn;

    6988. 

  6988.     saddrlen : Integer;

    6989. 

  6989. begin

    6990. 

  6990. {$IFDEF CLR}

    6991. 

  6991.     if DesignMode then begin

    6992. 

  6992.         Result := '';

    6993. 

  6993.         Exit;

    6994. 

  6994.     end;

    6995. 

  6995. {$ENDIF}

    6996. 

  6996.     Result := 'error';

    6997. 

  6997.     if FState = wsConnected then begin

    6998. 

  6998.         saddrlen := sizeof(saddr);

    6999. 

  6999.         if WSocket_Synchronized_GetPeerName(FHSocket, TSockAddr(saddr), saddrlen) = 0 then

    7000. 

  7000.             Result := _IntToStr(WSocket_Synchronized_ntohs(saddr.sin_port))

    7001. 

  7001.         else begin

    7002. 

  7002.             SocketError('GetPeerPort');

    7003. 

  7003.             Exit;

    7004. 

  7004.         end;

    7005. 

  7005.     end;

    7006. 

  7006. end;

    7007. 

  7007. 

    7008. 

  7008. 

    7009. 

  7009. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    7010. 

  7010. function TCustomWSocket.GetPeerName(var Name : TSockAddrIn; NameLen : Integer) : Integer;

    7011. 

  7011. begin

    7012. 

  7012. {$IFDEF CLR}

    7013. 

  7013.     if DesignMode then begin

    7014. 

  7014.         Result := SOCKET_ERROR;

    7015. 

  7015.         Exit;

    7016. 

  7016.     end;

    7017. 

  7017. {$ENDIF}

    7018. 

  7018.     if FState = wsConnected then

    7019. 

  7019.         Result := WSocket_Synchronized_GetPeerName(FHSocket, TSockAddr(Name), NameLen)

    7020. 

  7020.     else

    7021. 

  7021.         Result := SOCKET_ERROR;

    7022. 

  7022. end;

    7023. 

  7023. 

    7024. 

  7024. 

    7025. 

  7025. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    7026. 

  7026. procedure TCustomWSocket.CancelDnsLookup;

    7027. 

  7027. begin

    7028. 

  7028.     if FDnsLookupHandle = 0 then

    7029. 

  7029.         Exit;

    7030. 

  7030.     if WSocket_Synchronized_WSACancelAsyncRequest(FDnsLookupHandle) <> 0 then begin

    7031. 

  7031.         FDnsLookupHandle := 0;

    7032. 

  7032.         SocketError('WSACancelAsyncRequest');

    7033. 

  7033.         Exit;

    7034. 

  7034.     end;

    7035. 

  7035.     FDnsLookupHandle := 0;

    7036. 

  7036. 

    7037. 

  7037. {$IFDEF WIN32}

    7038. 

  7038.     if not (csDestroying in ComponentState) then

    7039. 

  7039. {$ENDIF}

    7040. 

  7040.         TriggerDnsLookupDone(WSAEINTR);

    7041. 

  7041. end;

    7042. 

  7042. 

    7043. 

  7043. 

    7044. 

  7044. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    7045. 

  7045. procedure TCustomWSocket.DnsLookup(const AHostName : String);

    7046. 

  7046. var

    7047. 

  7047.     IPAddr   : TInAddr;

    7048. 

  7048.     HostName : AnsiString;

    7049. 

  7049. begin

    7050. 

  7050.     if AHostName = '' then begin

    7051. 

  7051.         RaiseException('DNS lookup: invalid host name.');

    7052. 

  7052.         TriggerDnsLookupDone(WSAEINVAL);

    7053. 

  7053.         Exit;

    7054. 

  7054.     end;

    7055. 

  7055. 

    7056. 

  7056.     { Cancel any pending lookup }

    7057. 

  7057.     if FDnsLookupHandle <> 0 then begin

    7058. 

  7058.         WSocket_Synchronized_WSACancelAsyncRequest(FDnsLookupHandle);

    7059. 

  7059.         FDnsLookupHandle := 0;

    7060. 

  7060.     end;

    7061. 

  7061. 

    7062. 

  7062.     FDnsResult := '';

    7063. 

  7063.     FDnsResultList.Clear;

    7064. 

  7064. 

    7065. 

  7065. {$IFDEF DELPHI1}

    7066. 

  7066.     { Delphi 1 do not automatically add a terminating nul char }

    7067. 

  7067.     HostName := AHostName + #0;

    7068. 

  7068. {$ELSE}

    7069. 

  7069.     HostName := AnsiString(AHostName);

    7070. 

  7070. {$ENDIF}

    7071. 

  7071.     if WSocketIsDottedIP(Hostname) then begin   { 28/09/2002 }

    7072. 

  7072.         IPAddr.S_addr := WSocket_Synchronized_inet_addr(HostName);

    7073. 

  7073.         if IPAddr.S_addr <> u_long(INADDR_NONE) then begin

    7074. 

  7074.             FDnsResult := String(WSocket_Synchronized_inet_ntoa(IPAddr));

    7075. 

  7075.             FDnsResultList.Add(FDnsResult);     { 28/09/2002 }{ 12/02/2003 }

    7076. 

  7076.             TriggerDnsLookupDone(0);

    7077. 

  7077.             Exit;

    7078. 

  7078.         end;

    7079. 

  7079.     end;

    7080. 

  7080. 

    7081. 

  7081.     if FWindowHandle = 0 then

    7082. 

  7082.         RaiseException('DnsLookup: Window not assigned');

    7083. 

  7083. 

    7084. 

  7084.     { John Goodwin found a case where winsock dispatch WM_ASYNCGETHOSTBYNAME }

    7085. 

  7085.     { message before returning from WSAAsyncGetHostByName call. Because of   }

    7086. 

  7086.     { that, FDnsLookupHandle is not yet assigned when execution comes in     }

    7087. 

  7087.     { WMAsyncGetHostByName. John use a flag to check this situation.         }

    7088. 

  7088.     FDnsLookupCheckMsg := FALSE;

    7089. 

  7089. {$IFDEF CLR}

    7090. 

  7090.     SetLength(FDnsLookupBuffer, MAXGETHOSTSTRUCT);

    7091. 

  7091.     FDnsLookupGCH    := GCHandle.Alloc(FDnsLookupBuffer, GCHandleType.Pinned);

    7092. 

  7092.     FDnsLookupIntPtr := FDnsLookupGCH.AddrOfPinnedObject;

    7093. 

  7093.     FDnsLookupHandle := WSocket_WSAAsyncGetHostByName(

    7094. 

  7094.                               FWindowHandle,

    7095. 

  7095.                               FMsg_WM_ASYNCGETHOSTBYNAME,

    7096. 

  7096.                               HostName,

    7097. 

  7097.                               FDnsLookupIntPtr,

    7098. 

  7098.                               MAXGETHOSTSTRUCT);

    7099. 

  7099.     if FDnsLookupHandle = 0 then begin

    7100. 

  7100.         FDnsLookupGCH.Free;

    7101. 

  7101.         RaiseException(HostName +

    7102. 

  7102.                        ': can''t start DNS lookup - ' +

    7103. 

  7103.                        GetWinsockErr(WSocket_WSAGetLastError));   { V5.26 }

    7104. 

  7104.         Exit;

    7105. 

  7105.     end;

    7106. 

  7106. {$ENDIF}

    7107. 

  7107. {$IFDEF WIN32}

    7108. 

  7108.     FDnsLookupHandle   := WSocket_Synchronized_WSAAsyncGetHostByName(

    7109. 

  7109.                               FWindowHandle,

    7110. 

  7110.                               FMsg_WM_ASYNCGETHOSTBYNAME,

    7111. 

  7111.                               @HostName[1],

    7112. 

  7112.                               @FDnsLookupBuffer,

    7113. 

  7113.                               SizeOf(FDnsLookupBuffer));

    7114. 

  7114.     if FDnsLookupHandle = 0 then begin

    7115. 

  7115.         RaiseException(String(HostName) + ': can''t start DNS lookup - ' +

    7116. 

  7116.                        GetWinsockErr(WSocket_Synchronized_WSAGetLastError));  { V5.26 }

    7117. 

  7117.         Exit;

    7118. 

  7118.     end;

    7119. 

  7119. {$ENDIF}

    7120. 

  7120.     if FDnsLookupCheckMsg then begin

    7121. 

  7121.         FDnsLookupCheckMsg := FALSE;

    7122. 

  7122.         WMAsyncGetHostByName(FDnsLookupTempMsg);

    7123. 

  7123.     end;

    7124. 

  7124. end;

    7125. 

  7125. 

    7126. 

  7126. 

    7127. 

  7127. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    7128. 

  7128. procedure TCustomWSocket.ReverseDnsLookup(const HostAddr: String);

    7129. 

  7129. var

    7130. 

  7130.     lAddr  : u_long;

    7131. 

  7131. begin

    7132. 

  7132.     if HostAddr = '' then begin

    7133. 

  7133.         RaiseException('Reverse DNS Lookup: Invalid host name.'); { V5.26 }

    7134. 

  7134.         TriggerDnsLookupDone(WSAEINVAL);

    7135. 

  7135.         Exit;

    7136. 

  7136.     end;

    7137. 

  7137.     { Cancel any pending lookup }

    7138. 

  7138.     if FDnsLookupHandle <> 0 then

    7139. 

  7139.         WSocket_Synchronized_WSACancelAsyncRequest(FDnsLookupHandle);

    7140. 

  7140. 

    7141. 

  7141.     FDnsResult := '';

    7142. 

  7142.     FDnsResultList.Clear;

    7143. 

  7143. 

    7144. 

  7144.     lAddr := WSocket_Synchronized_inet_addr(AnsiString(HostAddr));

    7145. 

  7145. 

    7146. 

  7146.     if FWindowHandle = 0 then

    7147. 

  7147.         RaiseException('Reverse DNS Lookup: Window not assigned');  { V5.26 }

    7148. 

  7148. 

    7149. 

  7149. {$IFDEF CLR}

    7150. 

  7150.     SetLength(FDnsLookupBuffer, MAXGETHOSTSTRUCT);

    7151. 

  7151.     FDnsLookupGCH    := GCHandle.Alloc(FDnsLookupBuffer, GCHandleType.Pinned);

    7152. 

  7152.     FDnsLookupIntPtr := FDnsLookupGCH.AddrOfPinnedObject;

    7153. 

  7153.     FDnsLookupHandle := WSocket_WSAAsyncGetHostByAddr(

    7154. 

  7154.                             FWindowHandle,

    7155. 

  7155.                             FMsg_WM_ASYNCGETHOSTBYADDR,

    7156. 

  7156.                             lAddr, 4, PF_INET,

    7157. 

  7157.                             FDnsLookupIntPtr,

    7158. 

  7158.                             MAXGETHOSTSTRUCT);

    7159. 

  7159.     if FDnsLookupHandle = 0 then begin

    7160. 

  7160.         FDnsLookupGCH.Free;

    7161. 

  7161.         RaiseException(HostAddr + ': can''t start DNS lookup - ' +

    7162. 

  7162.                        GetWinsockErr(WSocket_WSAGetLastError));   { V5.26 }

    7163. 

  7163.     end;

    7164. 

  7164. {$ENDIF}

    7165. 

  7165. {$IFDEF WIN32}

    7166. 

  7166.     FDnsLookupHandle := WSocket_Synchronized_WSAAsyncGetHostByAddr(

    7167. 

  7167.                             FWindowHandle,

    7168. 

  7168.                             FMsg_WM_ASYNCGETHOSTBYADDR,

    7169. 

  7169.                             PAnsiChar(@lAddr), 4, PF_INET,

    7170. 

  7170.                             @FDnsLookupBuffer,

    7171. 

  7171.                             SizeOf(FDnsLookupBuffer));

    7172. 

  7172.     if FDnsLookupHandle = 0 then

    7173. 

  7173.         RaiseException(HostAddr + ': can''t start reverse DNS lookup - ' +

    7174. 

  7174.                        GetWinsockErr(WSocket_Synchronized_WSAGetLastError));  { V5.26 }

    7175. 

  7175. {$ENDIF}

    7176. 

  7176. end;

    7177. 

  7177. 

    7178. 

  7178. 

    7179. 

  7179. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    7180. 

  7180. {$IFDEF CLR}

    7181. 

  7181. procedure TCustomWSocket.ReverseDnsLookupSync(const HostAddr: String);

    7182. 

  7182. var

    7183. 

  7183.     lAddr  : u_long;

    7184. 

  7184.     Phe    : IntPtr;

    7185. 

  7185.     HostEntry    : THostEnt;

    7186. 

  7186. begin

    7187. 

  7187.     if Length(HostAddr) = 0 then begin

    7188. 

  7188.         RaiseException('ReverseDnsLookup: Invalid host name.');

    7189. 

  7189.         TriggerDnsLookupDone(WSAEINVAL);

    7190. 

  7190.         Exit;

    7191. 

  7191.     end;

    7192. 

  7192.     // Cancel any pending lookup

    7193. 

  7193.     if FDnsLookupHandle <> 0 then

    7194. 

  7194.         WSocket_WSACancelAsyncRequest(FDnsLookupHandle);

    7195. 

  7195. 

    7196. 

  7196.     FDnsResult := '';

    7197. 

  7197.     FDnsResultList.Clear;

    7198. 

  7198. 

    7199. 

  7199.     lAddr := WSocket_Synchronized_inet_addr(HostAddr);

    7200. 

  7200.     Phe   := WSocket_Synchronized_gethostbyaddr(lAddr, 4, AF_INET);

    7201. 

  7201.     if Phe = IntPtr.Zero then

    7202. 

  7202.         TriggerDnsLookupDone(WSocket_Synchronized_WSAGetLastError)

    7203. 

  7203.     else begin

    7204. 

  7204.         HostEntry  := THostEnt(Marshal.PtrToStructure(Phe,

    7205. 

  7205.                                                         TypeOf(THostEnt)));

    7206. 

  7206.         FDnsResult := Marshal.PtrToStringAnsi(HostEntry.h_name);

    7207. 

  7207.         FDnsResultList.Add(FDnsResult);

    7208. 

  7208.         GetAliasList(HostEntry, FDnsResultList);

    7209. 

  7209.         TriggerDnsLookupDone(0);

    7210. 

  7210.     end;

    7211. 

  7211. end;

    7212. 

  7212. {$ENDIF}

    7213. 

  7213. {$IFDEF WIN32}

    7214. 

  7214. procedure TCustomWSocket.ReverseDnsLookupSync(const HostAddr: String); {AG 03/03/06}

    7215. 

  7215. var

    7216. 

  7216.     szAddr : array [0..256] of AnsiChar;

    7217. 

  7217.     lAddr  : u_long;

    7218. 

  7218.     Phe    : Phostent;

    7219. 

  7219. begin

    7220. 

  7220.     if (Length(HostAddr) = 0) or (Length(HostAddr) >= SizeOf(szAddr)) then begin

    7221. 

  7221.         RaiseException('Reverse DNS Lookup: Invalid host name.');   { V5.26 }

    7222. 

  7222.         TriggerDnsLookupDone(WSAEINVAL);

    7223. 

  7223.         Exit;

    7224. 

  7224.     end;

    7225. 

  7225.     { Cancel any pending lookup }

    7226. 

  7226.     if FDnsLookupHandle <> 0 then

    7227. 

  7227.         WSocket_Synchronized_WSACancelAsyncRequest(FDnsLookupHandle);

    7228. 

  7228. 

    7229. 

  7229.     FDnsResult := '';

    7230. 

  7230.     FDnsResultList.Clear;

    7231. 

  7231. 

    7232. 

  7232.     _StrPCopy(szAddr, AnsiString(HostAddr)); { Length already checked above }

    7233. 

  7233. 

    7234. 

  7234.     lAddr := WSocket_Synchronized_inet_addr(szAddr);

    7235. 

  7235. 

    7236. 

  7236.     Phe := WSocket_Synchronized_gethostbyaddr(PAnsiChar(@lAddr), 4, AF_INET);

    7237. 

  7237.     if Phe = nil then

    7238. 

  7238.         TriggerDnsLookupDone(WSocket_Synchronized_WSAGetLastError)

    7239. 

  7239.     else begin

    7240. 

  7240.         //SetLength(FDnsResult, _StrLen(Phe^.h_name));

    7241. 

  7241.         //_StrCopy(@FDnsResult[1], Phe^.h_name);

    7242. 

  7242.         FDnsResult := String(_StrPas(Phe^.h_name));

    7243. 

  7243.         FDnsResultList.Add(FDnsResult);

    7244. 

  7244.         GetAliasList(Phe, FDnsResultList);

    7245. 

  7245.         TriggerDnsLookupDone(0);

    7246. 

  7246.     end;

    7247. 

  7247. end;

    7248. 

  7248. {$ENDIF}

    7249. 

  7249. 

    7250. 

  7250. 

    7251. 

  7251. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    7252. 

  7252. procedure TCustomWSocket.BindSocket;

    7253. 

  7253. var

    7254. 

  7254.     SockName      : TSockAddr;

    7255. 

  7255.     SockNamelen   : Integer;

    7256. 

  7256.     LocalSockName : TSockAddrIn;

    7257. 

  7257. {$IFDEF CLR}

    7258. 

  7258.     I             : Integer;

    7259. 

  7259. begin

    7260. 

  7260.     for I := Low(LocalSockName.sin_zero) to High(LocalSockName.sin_zero) do

    7261. 

  7261.         LocalSockName.sin_zero[0] := #0;

    7262. 

  7262. {$ENDIF}

    7263. 

  7263. {$IFDEF WIN32}

    7264. 

  7264. begin

    7265. 

  7265.     FillChar(LocalSockName, Sizeof(LocalSockName), 0);

    7266. 

  7266. {$ENDIF}

    7267. 

  7267.     SockNamelen                   := SizeOf(LocalSockName);

    7268. 

  7268.     LocalSockName.sin_family      := AF_INET;

    7269. 

  7269.     LocalSockName.sin_port        := WSocket_Synchronized_htons(FLocalPortNum);

    7270. 

  7270.     LocalSockName.sin_addr.s_addr := WSocket_Synchronized_ResolveHost(AnsiString(FLocalAddr)).s_addr;

    7271. 

  7271. 

    7272. 

  7272.     if WSocket_Synchronized_bind(HSocket, LocalSockName, SockNamelen) <> 0 then begin

    7273. 

  7273.         RaiseException('Bind socket failed - ' +

    7274. 

  7274.                        GetWinsockErr(WSocket_Synchronized_WSAGetLastError));  { V5.26 }

    7275. 

  7275.         Exit;

    7276. 

  7276.     end;

    7277. 

  7277.     SockNamelen := sizeof(SockName);

    7278. 

  7278.     if WSocket_Synchronized_getsockname(FHSocket, SockName, SockNamelen) <> 0 then begin

    7279. 

  7279.         RaiseException('Winsock get socket name failed - ' +

    7280. 

  7280.                        GetWinsockErr(WSocket_Synchronized_WSAGetLastError));  { V5.26 }

    7281. 

  7281.         Exit;

    7282. 

  7282.     end;

    7283. 

  7283.     FLocalPortNum := WSocket_Synchronized_ntohs(SockName.sin_port);

    7284. 

  7284.     FLocalPortStr := _IntToStr(FLocalPortNum);

    7285. 

  7285. end;

    7286. 

  7286. 

    7287. 

  7287. 

    7288. 

  7288. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    7289. 

  7289. {$IFDEF CLR}

    7290. 

  7290. procedure TCustomWSocket.SetKeepAliveOption;

    7291. 

  7291. begin

    7292. 

  7292.     // Not implemented !

    7293. 

  7293. end;

    7294. 

  7294. {$ENDIF}

    7295. 

  7295. {$IFDEF WIN32}

    7296. 

  7296. procedure TCustomWSocket.SetKeepAliveOption;

    7297. 

  7297. var

    7298. 

  7298.     OptVal        : Integer;

    7299. 

  7299.     Status        : Integer;

    7300. 

  7300.     KeepAliveIn   : TTcpKeepAlive;

    7301. 

  7301.     KeepAliveOut  : TTcpKeepAlive;

    7302. 

  7302. {$IFDEF DELPHI3}

    7303. 

  7303.     BytesReturned : DWORD;

    7304. 

  7304. {$ELSE}

    7305. 

  7305.     BytesReturned : Cardinal;

    7306. 

  7306. {$ENDIF}

    7307. 

  7307. begin

    7308. 

  7308.     if FKeepAliveOnOff = wsKeepAliveOff then

    7309. 

  7309.         Exit;

    7310. 

  7310.     Assert(FHSocket <> INVALID_SOCKET); { V7.27 }

    7311. 

  7311.     if FKeepAliveOnOff = wsKeepAliveOnSystem then begin

    7312. 

  7312.         OptVal := 1;

    7313. 

  7313.         Status := WSocket_Synchronized_setsockopt(FHSocket, SOL_SOCKET,

    7314. 

  7314.                                                   SO_KEEPALIVE, @OptVal,

    7315. 

  7315.                                                   SizeOf(OptVal));

    7316. 

  7316. 

    7317. 

  7317.         if Status <> 0 then

    7318. 

  7318.             SocketError('setsockopt(SO_KEEPALIVE)');

    7319. 

  7319.         Exit;

    7320. 

  7320.     end;

    7321. 

  7321. {$IFNDEF DELPHI1}

    7322. 

  7322.     FillChar(KeepAliveIn, SizeOf(KeepAliveIn), 0);

    7323. 

  7323.     FillChar(KeepAliveOut, SizeOf(KeepAliveOut), 0);

    7324. 

  7324.     BytesReturned := 0;

    7325. 

  7325. 

    7326. 

  7326.     KeepAliveIn.OnOff             := 1;

    7327. 

  7327.     KeepAliveIn.KeepAliveInterval := FKeepAliveInterval;

    7328. 

  7328.     KeepAliveIn.KeepAliveTime     := FKeepAliveTime;

    7329. 

  7329.     Status := WSocket_WSAIoctl(FHSocket,      SIO_KEEPALIVE_VALS,

    7330. 

  7330.                                @KeepAliveIn,  SizeOf(KeepAliveIn),

    7331. 

  7331.                                @KeepAliveOut, SizeOf(KeepAliveOut),

    7332. 

  7332.                                BytesReturned, nil, nil);

    7333. 

  7333.     if Status <> 0 then begin

    7334. 

  7334.         SocketError('WSocket_WSAIoctl(SIO_KEEPALIVE_VALS)');

    7335. 

  7335.         Exit;

    7336. 

  7336.     end;

    7337. 

  7337. {$ENDIF}

    7338. 

  7338. end;

    7339. 

  7339. {$ENDIF}

    7340. 

  7340. 

    7341. 

  7341. 

    7342. 

  7342. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    7343. 

  7343. procedure TCustomWSocket.SetLingerOption;

    7344. 

  7344. var

    7345. 

  7345.     iStatus : Integer;

    7346. 

  7346.     li      : TLinger;

    7347. 

  7347. begin

    7348. 

  7348.     if FLingerOnOff = wsLingerNoSet then

    7349. 

  7349.         Exit;                            { Option set is disabled, ignore }

    7350. 

  7350. 

    7351. 

  7351.     if FHSocket = INVALID_SOCKET then begin

    7352. 

  7352.         RaiseException('Cannot set linger option at this time');

    7353. 

  7353.         Exit;

    7354. 

  7354.     end;

    7355. 

  7355. 

    7356. 

  7356.     li.l_onoff  := Ord(FLingerOnOff);    { 0/1 = disable/enable linger }

    7357. 

  7357.     li.l_linger := FLingerTimeout;       { timeout in seconds          }

    7358. 

  7358.     iStatus     := WSocket_Synchronized_setsockopt(FHSocket, SOL_SOCKET,

    7359. 

  7359.                                       SO_LINGER, li, SizeOf(li));

    7360. 

  7360. 

    7361. 

  7361.     if iStatus <> 0 then begin

    7362. 

  7362.         SocketError('setsockopt(SO_LINGER)');

    7363. 

  7363.         Exit;

    7364. 

  7364.     end;

    7365. 

  7365. end;

    7366. 

  7366. 

    7367. 

  7367. 

    7368. 

  7368. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    7369. 

  7369. function TCustomWSocket.SetTcpNoDelayOption: Boolean; { V7.27 }

    7370. 

  7370. var

    7371. 

  7371.     optval  : Integer;

    7372. 

  7372. begin

    7373. 

  7373.     Assert(FHSocket <> INVALID_SOCKET);

    7374. 

  7374.     if HasOption(FComponentOptions, wsoTcpNoDelay) then

    7375. 

  7375.         optval := -1 { true }

    7376. 

  7376.     else

    7377. 

  7377.         optval := 0; { false }

    7378. 

  7378.     Result := WSocket_Synchronized_setsockopt(FHSocket, IPPROTO_TCP,

    7379. 

  7379.                                               TCP_NODELAY,

    7380. 

  7380.                                               optval, SizeOf(optval)) = 0;

    7381. 

  7381.     if not Result then

    7382. 

  7382.         SocketError('setsockopt(IPPROTO_TCP, TCP_NODELAY)');

    7383. 

  7383. end;

    7384. 

  7384. 

    7385. 

  7385. 

    7386. 

  7386. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    7387. 

  7387. procedure TCustomWSocket.Connect;

    7388. 

  7388. var

    7389. 

  7389.     iStatus : Integer;

    7390. 

  7390.     optval  : Integer;

    7391. 

  7391.     optlen  : Integer;

    7392. 

  7392.     lAddr   : TInAddr;

    7393. 

  7393. begin

    7394. 

  7394.     if (FHSocket <> INVALID_SOCKET) and (FState <> wsClosed) then begin

    7395. 

  7395.         RaiseException('Connect: Socket already in use');

    7396. 

  7396.         Exit;

    7397. 

  7397.     end;

    7398. 

  7398. 

    7399. 

  7399.     if  not FPortAssigned then begin

    7400. 

  7400.         RaiseException('Connect: No Port Specified');

    7401. 

  7401.         Exit;

    7402. 

  7402.     end;

    7403. 

  7403. 

    7404. 

  7404.     if not FAddrAssigned then begin

    7405. 

  7405.         RaiseException('Connect: No IP Address Specified');

    7406. 

  7406.         Exit;

    7407. 

  7407.     end;

    7408. 

  7408. 

    7409. 

  7409.     if not FProtoAssigned then begin

    7410. 

  7410.         RaiseException('Connect: No Protocol Specified');

    7411. 

  7411.         Exit;

    7412. 

  7412.     end;

    7413. 

  7413. 

    7414. 

  7414.     try

    7415. 

  7415.         if not FProtoResolved then begin

    7416. 

  7416.             { The next line will trigger an exception in case of failure }

    7417. 

  7417.             FProto := WSocket_Synchronized_ResolveProto(AnsiString(FProtoStr));

    7418. 

  7418.             case FProto of

    7419. 

  7419.             IPPROTO_UDP: FType := SOCK_DGRAM;

    7420. 

  7420.             IPPROTO_TCP: FType := SOCK_STREAM;

    7421. 

  7421.             IPPROTO_RAW: FType := SOCK_RAW;

    7422. 

  7422.             else

    7423. 

  7423.                          FType := SOCK_RAW;

    7424. 

  7424.             end;

    7425. 

  7425.             FProtoResolved := TRUE;

    7426. 

  7426.         end;

    7427. 

  7427. 

    7428. 

  7428.         if not FPortResolved then begin

    7429. 

  7429.             { The next line will trigger an exception in case of failure }

    7430. 

  7430.             FPortNum      := WSocket_Synchronized_ResolvePort(AnsiString(FPortStr), AnsiString(FProtoStr));

    7431. 

  7431.             sin.sin_port  := WSocket_Synchronized_htons(FPortNum);

    7432. 

  7432.             FPortResolved := TRUE;

    7433. 

  7433.         end;

    7434. 

  7434. 

    7435. 

  7435.         if not FLocalPortResolved then begin

    7436. 

  7436.             { The next line will trigger an exception in case of failure }

    7437. 

  7437.             FLocalPortNum      := WSocket_Synchronized_ResolvePort(AnsiString(FLocalPortStr), AnsiString(FProtoStr));

    7438. 

  7438.             FLocalPortResolved := TRUE;

    7439. 

  7439.         end;

    7440. 

  7440. 

    7441. 

  7441.         if not FAddrResolved then begin

    7442. 

  7442.             { The next line will trigger an exception in case of failure }

    7443. 

  7443.             sin.sin_addr.s_addr := WSocket_Synchronized_ResolveHost(AnsiString(FAddrStr)).s_addr;

    7444. 

  7444.             FAddrResolved := TRUE;

    7445. 

  7445.         end;

    7446. 

  7446.     except

    7447. 

  7447.         on E:Exception do begin

    7448. 

  7448.             RaiseException('connect: ' + E.Message);

    7449. 

  7449.             Exit;

    7450. 

  7450.         end;

    7451. 

  7451.     end;

    7452. 

  7452. 

    7453. 

  7453.     { Remove any data from the internal output buffer }

    7454. 

  7454.     { (should already be empty !)                     }

    7455. 

  7455.     DeleteBufferedData;

    7456. 

  7456. 

    7457. 

  7457.     { Open the socket }

    7458. 

  7458.     FHSocket := WSocket_Synchronized_socket(FAddrFormat, FType, FProto);

    7459. 

  7459.     if FHSocket = INVALID_SOCKET then begin

    7460. 

  7460.         SocketError('Connect (socket)');

    7461. 

  7461.         Exit;

    7462. 

  7462.     end;

    7463. 

  7463. 

    7464. 

  7464.     { Get winsock send buffer size }

    7465. 

  7465.     optlen  := SizeOf(FSocketSndBufSize);

    7466. 

  7466. {$IFDEF CLR}

    7467. 

  7467.     iStatus := WSocket_getsockopt(FHSocket, SOL_SOCKET, SO_SNDBUF,

    7468. 

  7468.                                   FSocketSndBufSize, optlen);

    7469. 

  7469. {$ELSE}

    7470. 

  7470.     iStatus := WSocket_getsockopt(FHSocket, SOL_SOCKET, SO_SNDBUF,

    7471. 

  7471.                                   PAnsiChar(@FSocketSndBufSize), optlen);

    7472. 

  7472. {$ENDIF}

    7473. 

  7473.     if iStatus <> 0 then begin

    7474. 

  7474.         SocketError('getsockopt(SO_SNDBUF)');

    7475. 

  7475.         Exit;

    7476. 

  7476.     end;

    7477. 

  7477. 

    7478. 

  7478.     { Get winsock receive buffer size }

    7479. 

  7479.     optlen  := SizeOf(FSocketRcvBufSize);

    7480. 

  7480. {$IFDEF CLR}

    7481. 

  7481.     iStatus := WSocket_getsockopt(FHSocket, SOL_SOCKET, SO_RCVBUF,

    7482. 

  7482.                                   FSocketRcvBufSize, optlen);

    7483. 

  7483. {$ELSE}

    7484. 

  7484.     iStatus := WSocket_getsockopt(FHSocket, SOL_SOCKET, SO_RCVBUF,

    7485. 

  7485.                                   PAnsiChar(@FSocketRcvBufSize), optlen);

    7486. 

  7486. {$ENDIF}

    7487. 

  7487.     if iStatus <> 0 then begin

    7488. 

  7488.         SocketError('getsockopt(SO_RCVBUF)');

    7489. 

  7489.         Exit;

    7490. 

  7490.     end;

    7491. 

  7491. 

    7492. 

  7492.     { Trigger OnChangeState event }

    7493. 

  7493.     ChangeState(wsOpened);

    7494. 

  7494. 

    7495. 

  7495.     if FState <> wsOpened then begin  { 07/07/02 }

    7496. 

  7496.         { Socket has been closed in the OnChangeState event ! }

    7497. 

  7497.         WSocket_Synchronized_WSASetLastError(WSAEINVAL);

    7498. 

  7498.         SocketError('Connect (Invalid operation in OnChangeState)');

    7499. 

  7499.         Exit;

    7500. 

  7500.     end;

    7501. 

  7501. 

    7502. 

  7502.     if FType = SOCK_DGRAM then begin

    7503. 

  7503.         BindSocket;

    7504. 

  7504.         if FMultiCast then begin

    7505. 

  7505.             if FMultiCastIpTTL <> IP_DEFAULT_MULTICAST_TTL then begin

    7506. 

  7506.                 optval  := FMultiCastIpTTL; { set time-to-live for multicast }

    7507. 

  7507.                 iStatus := WSocket_Synchronized_SetSockOpt(FHSocket, IPPROTO_IP,

    7508. 

  7508.                                                            IP_MULTICAST_TTL,

    7509. 

  7509.                                                            optval,

    7510. 

  7510.                                                            SizeOf(optval));

    7511. 

  7511.                 if iStatus <> 0 then begin

    7512. 

  7512.                         SocketError('setsockopt(IP_MULTICAST_TTL)');

    7513. 

  7513.                         Exit;

    7514. 

  7514.                 end;

    7515. 

  7515.             end;

    7516. 

  7516.             if FLocalAddr <> '0.0.0.0' then begin                      { RK }

    7517. 

  7517.                 laddr.s_addr := WSocket_Synchronized_ResolveHost(AnsiString(FLocalAddr)).s_addr;

    7518. 

  7518.                 iStatus      := WSocket_Synchronized_SetSockOpt(FHSocket, IPPROTO_IP,

    7519. 

  7519.                                                                 IP_MULTICAST_IF,

    7520. 

  7520.                                                                 laddr,

    7521. 

  7521.                                                                 SizeOf(laddr));

    7522. 

  7522.                 if iStatus <> 0 then begin

    7523. 

  7523.                     SocketError('setsockopt(IP_MULTICAST_IF)');

    7524. 

  7524.                     Exit;

    7525. 

  7525.                 end;

    7526. 

  7526.             end;                                                       { /RK }

    7527. 

  7527.         end;

    7528. 

  7528. 

    7529. 

  7529.         if sin.sin_addr.S_addr = u_long(INADDR_BROADCAST) then begin

    7530. 

  7530.             OptVal  := 1;

    7531. 

  7531.             iStatus := WSocket_Synchronized_setsockopt(FHSocket, SOL_SOCKET, SO_BROADCAST,

    7532. 

  7532.                                                        OptVal, SizeOf(OptVal));

    7533. 

  7533.             if iStatus <> 0 then begin

    7534. 

  7534.                 SocketError('setsockopt(SO_BROADCAST)');

    7535. 

  7535.                 Exit;

    7536. 

  7536.             end;

    7537. 

  7537.         end;

    7538. 

  7538.     end

    7539. 

  7539.     else begin

    7540. 

  7540.         { Socket type is SOCK_STREAM }

    7541. 

  7541.         optval  := -1;

    7542. 

  7542.         iStatus := WSocket_Synchronized_setsockopt(FHSocket, SOL_SOCKET,

    7543. 

  7543.                                                    SO_REUSEADDR, optval, SizeOf(optval));

    7544. 

  7544. 

    7545. 

  7545.         if iStatus <> 0 then begin

    7546. 

  7546.             SocketError('setsockopt(SO_REUSEADDR)');

    7547. 

  7547.             Exit;

    7548. 

  7548.         end;

    7549. 

  7549. 

    7550. 

  7550.         if HasOption(FComponentOptions, wsoTcpNoDelay) and { V7.27 }

    7551. 

  7551.                     (not SetTcpNoDelayOption) then

    7552. 

  7552.             Exit;

    7553. 

  7553.         SetLingerOption;

    7554. 

  7554.         SetKeepAliveOption;

    7555. 

  7555. 

    7556. 

  7556.         if (FLocalPortNum <> 0) or (FLocalAddr <> '0.0.0.0') then

    7557. 

  7557.             BindSocket;

    7558. 

  7558.     end;

    7559. 

  7559. 

    7560. 

  7560.     FSelectEvent := FD_READ or FD_WRITE or FD_CLOSE or

    7561. 

  7561.                     {FD_ACCEPT or} FD_CONNECT;  { FD_ACCEPT not needed } {AG 29.03.08}

    7562. 

  7562.     iStatus       := WSocket_Synchronized_WSAASyncSelect(FHSocket, Handle,

    7563. 

  7563.                                                          FMsg_WM_ASYNCSELECT,

    7564. 

  7564.                                                          FSelectEvent);

    7565. 

  7565.     if iStatus <> 0 then begin

    7566. 

  7566.         SocketError('WSAAsyncSelect');

    7567. 

  7567.         Exit;

    7568. 

  7568.     end;

    7569. 

  7569. 

    7570. 

  7570.     if FType = SOCK_DGRAM then begin

    7571. 

  7571.         ChangeState(wsConnected);

    7572. 

  7572.         TriggerSessionConnectedSpecial(0);

    7573. 

  7573.     end

    7574. 

  7574.     else begin

    7575. 

  7575. {$IFNDEF NO_DEBUG_LOG}

    7576. 

  7576.        if CheckLogOptions(loWsockInfo) then  { V5.21 } { replaces $IFDEF DEBUG_OUTPUT  }

    7577. 

  7577.             DebugLog(loWsockInfo, 'TWSocket will connect to ' +

    7578. 

  7578.                   WSocket_Synchronized_inet_ntoa(sin.sin_addr) + ':' +

    7579. 

  7579.                   _IntToStr(WSocket_Synchronized_ntohs(sin.sin_port)));

    7580. 

  7580. {$ENDIF}

    7581. 

  7581.         iStatus := WSocket_Synchronized_connect(FHSocket, TSockAddr(sin), sizeof(sin));

    7582. 

  7582.         if iStatus = 0 then

    7583. 

  7583.             ChangeState(wsConnecting)

    7584. 

  7584.         else begin

    7585. 

  7585.             iStatus := WSocket_Synchronized_WSAGetLastError;

    7586. 

  7586.             if iStatus = WSAEWOULDBLOCK then

    7587. 

  7587.                 ChangeState(wsConnecting)

    7588. 

  7588.             else begin

    7589. 

  7589.                 FLastError := WSocket_Synchronized_WSAGetLastError;

    7590. 

  7590.                 SocketError('Connect');

    7591. 

  7591.                 Exit;

    7592. 

  7592.             end;

    7593. 

  7593.         end;

    7594. 

  7594.     end;

    7595. 

  7595. end;

    7596. 

  7596. 

    7597. 

  7597. 

    7598. 

  7598. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    7599. 

  7599. procedure TCustomWSocket.Listen;

    7600. 

  7600. var

    7601. 

  7601.     iStatus        : Integer;

    7602. 

  7602.     optval         : Integer;

    7603. 

  7603.     mreq           : ip_mreq;

    7604. 

  7604. {$IFDEF WIN32}

    7605. 

  7605.     dwBufferInLen  : DWORD;

    7606. 

  7606.     dwBufferOutLen : DWORD;

    7607. 

  7607.     dwDummy        : DWORD;

    7608. 

  7608. {$ENDIF}

    7609. 

  7609. begin

    7610. 

  7610.     if not FPortAssigned then begin

    7611. 

  7611.         WSocket_Synchronized_WSASetLastError(WSAEINVAL);

    7612. 

  7612.         SocketError('listen: port not assigned');

    7613. 

  7613.         Exit;

    7614. 

  7614.     end;

    7615. 

  7615. 

    7616. 

  7616.     if not FProtoAssigned then begin

    7617. 

  7617.         WSocket_Synchronized_WSASetLastError(WSAEINVAL);

    7618. 

  7618.         SocketError('listen: protocol not assigned');

    7619. 

  7619.         Exit;

    7620. 

  7620.     end;

    7621. 

  7621. 

    7622. 

  7622.     if not FAddrAssigned then begin

    7623. 

  7623.         WSocket_Synchronized_WSASetLastError(WSAEINVAL);

    7624. 

  7624.         SocketError('listen: address not assigned');

    7625. 

  7625.         Exit;

    7626. 

  7626.     end;

    7627. 

  7627. 

    7628. 

  7628.     try

    7629. 

  7629.         if not FProtoResolved then begin

    7630. 

  7630.             { The next line will trigger an exception in case of failure }

    7631. 

  7631.             if _CompareText(Copy(FProtoStr, 1, 4), 'raw_') = 0 then begin

    7632. 

  7632.                 FType  := SOCK_RAW;

    7633. 

  7633.                 FProto := WSocket_Synchronized_ResolveProto(AnsiString(Copy(FProtoStr, 5, 10)));

    7634. 

  7634.             end

    7635. 

  7635.             else begin

    7636. 

  7636.                 FProto := WSocket_Synchronized_ResolveProto(AnsiString(FProtoStr));

    7637. 

  7637.                 if FProto = IPPROTO_UDP then

    7638. 

  7638.                     FType := SOCK_DGRAM

    7639. 

  7639.                 else

    7640. 

  7640.                     FType := SOCK_STREAM;

    7641. 

  7641.             end;

    7642. 

  7642.             FProtoResolved := TRUE;

    7643. 

  7643.         end;

    7644. 

  7644. 

    7645. 

  7645.         if not FPortResolved then begin

    7646. 

  7646.             { The next line will trigger an exception in case of failure }

    7647. 

  7647.             FPortNum      := WSocket_Synchronized_ResolvePort(AnsiString(FPortStr), AnsiString(FProtoStr));

    7648. 

  7648.             sin.sin_port  := WSocket_Synchronized_htons(FPortNum);

    7649. 

  7649.             FPortResolved := TRUE;

    7650. 

  7650.         end;

    7651. 

  7651. 

    7652. 

  7652.         if not FAddrResolved then begin

    7653. 

  7653.             { The next line will trigger an exception in case of failure }

    7654. 

  7654.             sin.sin_addr.s_addr := WSocket_Synchronized_ResolveHost(AnsiString(FAddrStr)).s_addr;

    7655. 

  7655.             FAddrResolved       := TRUE;

    7656. 

  7656.         end;

    7657. 

  7657.     except

    7658. 

  7658.         on E:Exception do begin

    7659. 

  7659.             RaiseException('listen: ' + E.Message);

    7660. 

  7660.             Exit;

    7661. 

  7661.         end;

    7662. 

  7662.     end;

    7663. 

  7663. 

    7664. 

  7664.     { Remove any data from the internal output buffer }

    7665. 

  7665.     { (should already be empty !)                     }

    7666. 

  7666.     DeleteBufferedData;

    7667. 

  7667. 

    7668. 

  7668.     FHSocket := WSocket_Synchronized_socket(FAddrFormat, FType, FProto);

    7669. 

  7669. 

    7670. 

  7670.     if FHSocket = INVALID_SOCKET then begin

    7671. 

  7671.         SocketError('socket');

    7672. 

  7672.         exit;

    7673. 

  7673.     end;

    7674. 

  7674. 

    7675. 

  7675.     if FType = SOCK_DGRAM then begin

    7676. 

  7676.         if FReuseAddr then begin

    7677. 

  7677.         { Enable multiple tasks to listen on duplicate address and port }

    7678. 

  7678.             optval  := -1;

    7679. 

  7679.             iStatus := WSocket_Synchronized_SetSockOpt(FHSocket, SOL_SOCKET,

    7680. 

  7680.                                                        SO_REUSEADDR,

    7681. 

  7681.                                                        optval, SizeOf(optval));

    7682. 

  7682. 

    7683. 

  7683.             if iStatus <> 0 then begin

    7684. 

  7684.                 SocketError('setsockopt(SO_REUSEADDR)');

    7685. 

  7685.                 Close;

    7686. 

  7686.                 Exit;

    7687. 

  7687.             end;

    7688. 

  7688.         end;

    7689. 

  7689.     end;

    7690. 

  7690. 

    7691. 

  7691.     iStatus := WSocket_Synchronized_bind(FHSocket, TSockAddr(sin), sizeof(sin));

    7692. 

  7692.     if iStatus = 0 then

    7693. 

  7693.         ChangeState(wsBound)

    7694. 

  7694.     else begin

    7695. 

  7695.         SocketError('Bind');

    7696. 

  7696.         Close;

    7697. 

  7697.         Exit;

    7698. 

  7698.     end;

    7699. 

  7699. 

    7700. 

  7700.     case FType of

    7701. 

  7701. {$IFDEF WIN32}

    7702. 

  7702. {$IFDEF COMPILER2_UP}

    7703. 

  7703.     SOCK_RAW :

    7704. 

  7704.         begin

    7705. 

  7705.             if HasOption(FComponentOptions, wsoSIO_RCVALL) then begin

    7706. 

  7706.                 dwBufferInLen  := 1;

    7707. 

  7707.                 dwBufferOutLen := 0;

    7708. 

  7708.                 iStatus := WSocket_Synchronized_WSAIoctl(FHSocket, SIO_RCVALL,

    7709. 

  7709.                     @dwBufferInLen,  SizeOf(dwBufferInLen),

    7710. 

  7710.                     @dwBufferOutLen, SizeOf(dwBufferOutLen),

    7711. 

  7711.                     dwDummy, nil, nil);

    7712. 

  7712. 

    7713. 

  7713.                 if iStatus = SOCKET_ERROR then begin

    7714. 

  7714.                     SocketError('WSAIoctl(SIO_RCVALL)');

    7715. 

  7715.                     Close;

    7716. 

  7716.                     Exit;

    7717. 

  7717.                 end;

    7718. 

  7718.             end;

    7719. 

  7719.             ChangeState(wsListening);

    7720. 

  7720.             ChangeState(wsConnected);

    7721. 

  7721.             TriggerSessionConnectedSpecial(0);

    7722. 

  7722.         end;

    7723. 

  7723. {$ENDIF}

    7724. 

  7724. {$ENDIF}

    7725. 

  7725.     SOCK_DGRAM :

    7726. 

  7726.         begin

    7727. 

  7727.             if FMultiCast then begin

    7728. 

  7728.                  { Use setsockopt() to join a multicast group }

    7729. 

  7729.                  { mreq.imr_multiaddr.s_addr := WSocket_inet_addr('225.0.0.37');}

    7730. 

  7730.                  { mreq.imr_multiaddr.s_addr := sin.sin_addr.s_addr;}

    7731. 

  7731.                  { mreq.imr_multiaddr.s_addr := WSocket_inet_addr(FAddrStr);}

    7732. 

  7732.                  mreq.imr_multiaddr.s_addr := WSocket_Synchronized_inet_addr(AnsiString(FMultiCastAddrStr));

    7733. 

  7733.                  { mreq.imr_interface.s_addr := htonl(INADDR_ANY);} { RK}

    7734. 

  7734.                  mreq.imr_interface.s_addr := WSocket_Synchronized_ResolveHost(AnsiString(FAddrStr)).s_addr;

    7735. 

  7735.                  iStatus := WSocket_Synchronized_SetSockOpt(FHSocket, IPPROTO_IP,

    7736. 

  7736.                                                             IP_ADD_MEMBERSHIP,

    7737. 

  7737.                                                             mreq, SizeOf(mreq));

    7738. 

  7738. 

    7739. 

  7739.                  if iStatus <> 0 then begin

    7740. 

  7740.                     SocketError('setsockopt(IP_ADD_MEMBERSHIP)');

    7741. 

  7741.                     Exit;

    7742. 

  7742.                  end;

    7743. 

  7743.             end;

    7744. 

  7744.             ChangeState(wsListening);

    7745. 

  7745.             ChangeState(wsConnected);

    7746. 

  7746.             TriggerSessionConnectedSpecial(0);

    7747. 

  7747.         end;

    7748. 

  7748.     SOCK_STREAM :

    7749. 

  7749.         begin

    7750. 

  7750.             iStatus := WSocket_Synchronized_listen(FHSocket, FListenBacklog);

    7751. 

  7751.             if iStatus = 0 then

    7752. 

  7752.                 ChangeState(wsListening)

    7753. 

  7753.             else begin

    7754. 

  7754.                 SocketError('Listen');

    7755. 

  7755.                 Exit;

    7756. 

  7756.             end;

    7757. 

  7757.         end;

    7758. 

  7758.     else

    7759. 

  7759.         SocketError('Listen: unexpected protocol.');

    7760. 

  7760.         Exit;

    7761. 

  7761.     end;

    7762. 

  7762. 

    7763. 

  7763.     { FP:26/09/06 Are FD_READ and FD_WRITE really necessary ? Probably not ! }

    7764. 

  7764.     { Lodewijk Ellen reported a problem with W2K3SP1 triggering an AV in     }

    7765. 

  7765.     { accept. Keeping only FD_ACCEPT and FD_CLOSE solved the problem.        }

    7766. 

  7766.     { Anyway, a listening socket doesn't send nor receive any data so those  }

    7767. 

  7767.     { notification are useless.                                              }

    7768. 

  7768.     FSelectEvent := FD_ACCEPT or FD_CLOSE;

    7769. 

  7769.     if FType <> SOCK_STREAM then

    7770. 

  7770.         FSelectEvent := FSelectEvent or FD_READ or FD_WRITE;

    7771. 

  7771.     iStatus      := WSocket_Synchronized_WSAASyncSelect(FHSocket, Handle,

    7772. 

  7772.                                                         FMsg_WM_ASYNCSELECT,

    7773. 

  7773.                                                         FSelectEvent);

    7774. 

  7774.     if iStatus <> 0 then begin

    7775. 

  7775.         SocketError('WSAASyncSelect');

    7776. 

  7776.         exit;

    7777. 

  7777.     end;

    7778. 

  7778. end;

    7779. 

  7779. 

    7780. 

  7780. 

    7781. 

  7781. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    7782. 

  7782. function TCustomWSocket.Accept: TSocket;

    7783. 

  7783. var

    7784. 

  7784.    len     : Integer;

    7785. 

  7785. begin

    7786. 

  7786.     if FState <> wsListening then begin

    7787. 

  7787.         WSocket_Synchronized_WSASetLastError(WSAEINVAL);

    7788. 

  7788.         SocketError('not a listening socket');

    7789. 

  7789.         Result := INVALID_SOCKET;

    7790. 

  7790.         Exit;

    7791. 

  7791.     end;

    7792. 

  7792. 

    7793. 

  7793.     len := sizeof(sin);

    7794. 

  7794. {$IFDEF DELPHI1} { Delphi 1 }

    7795. 

  7795.     FASocket := WSocket_Synchronized_accept(FHSocket, TSockAddr(sin), len);

    7796. 

  7796. {$ELSE}

    7797. 

  7797. {$IFDEF VER90} { Delphi 2}

    7798. 

  7798.     FASocket := WSocket_Synchronized_accept(FHSocket, TSockAddr(sin), len);

    7799. 

  7799. {$ELSE}

    7800. 

  7800. {$IFDEF CLR}

    7801. 

  7801.     FASocket := WSocket_Synchronized_accept(FHSocket, sin, len);

    7802. 

  7802. {$ELSE}

    7803. 

  7803.     { Delphi 3/4, Bcb 1/3/4 use pointers instead of var parameters }

    7804. 

  7804.     FASocket := WSocket_Synchronized_accept(FHSocket, @sin, @len);

    7805. 

  7805. {$ENDIF}

    7806. 

  7806. {$ENDIF}

    7807. 

  7807. {$ENDIF}

    7808. 

  7808. 

    7809. 

  7809.     if FASocket = INVALID_SOCKET then begin

    7810. 

  7810.         SocketError('Accept');

    7811. 

  7811.         Result := INVALID_SOCKET;

    7812. 

  7812.         Exit;

    7813. 

  7813.     end

    7814. 

  7814.     else

    7815. 

  7815.         Result := FASocket;

    7816. 

  7816. end;

    7817. 

  7817. 

    7818. 

  7818. 

    7819. 

  7819. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    7820. 

  7820. procedure TCustomWSocket.Pause;

    7821. 

  7821. begin

    7822. 

  7822.     FPaused := TRUE;

    7823. 

  7823.     WSocket_Synchronized_WSAASyncSelect(FHSocket, Handle, 0, 0);

    7824. 

  7824. end;

    7825. 

  7825. 

    7826. 

  7826. 

    7827. 

  7827. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    7828. 

  7828. procedure TCustomWSocket.Resume;

    7829. 

  7829. begin

    7830. 

  7830.     FPaused := FALSE;

    7831. 

  7831.     WSocket_Synchronized_WSAASyncSelect(FHSocket, Handle,

    7832. 

  7832.                                         FMsg_WM_ASYNCSELECT, FSelectEvent);

    7833. 

  7833. end;

    7834. 

  7834. 

    7835. 

  7835. 

    7836. 

  7836. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    7837. 

  7837. procedure TCustomWSocket.Shutdown(How : Integer);

    7838. 

  7838. begin

    7839. 

  7839. {$IFNDEF NO_DEBUG_LOG}

    7840. 

  7840.     if CheckLogOptions(loWsockInfo) then  { V5.21 } { replaces $IFDEF DEBUG_OUTPUT  }

    7841. 

  7841.       DebugLog(loWsockInfo, {$IFNDEF CLR}_IntToHex(INT_PTR(Self), SizeOf(Pointer) * 2) + ' ' +{$ENDIF}

    7842. 

  7842.                'TCustomWSocket.Shutdown ' + _IntToStr(How) + ' ' + _IntToStr(FHSocket));

    7843. 

  7843. {$ENDIF}

    7844. 

  7844.     if FHSocket <> INVALID_SOCKET then

    7845. 

  7845.         WSocket_Synchronized_shutdown(FHSocket, How);

    7846. 

  7846. end;

    7847. 

  7847. 

    7848. 

  7848. 

    7849. 

  7849. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    7850. 

  7850. procedure TCustomWSocket.DeleteBufferedData;

    7851. 

  7851. begin

    7852. 

  7852.     if Assigned(FBufHandler) then begin

    7853. 

  7853.         FBufHandler.Lock;

    7854. 

  7854.         try

    7855. 

  7855.             FBufHandler.DeleteAllData;

    7856. 

  7856.             FBufferedByteCount := 0;

    7857. 

  7857.         finally

    7858. 

  7858.             FBufHandler.UnLock;

    7859. 

  7859.         end;

    7860. 

  7860.     end;

    7861. 

  7861. end;

    7862. 

  7862. 

    7863. 

  7863. 

    7864. 

  7864. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    7865. 

  7865. procedure TCustomWSocket.Abort;

    7866. 

  7866. begin

    7867. 

  7867.     InternalAbort(0);

    7868. 

  7868. end;

    7869. 

  7869. 

    7870. 

  7870. 

    7871. 

  7871. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    7872. 

  7872. procedure TCustomWSocket.InternalAbort(ErrCode : Word);

    7873. 

  7873. begin

    7874. 

  7874.     CancelDnsLookup;

    7875. 

  7875.     DeleteBufferedData;

    7876. 

  7876.     { Be sure to close as fast as possible (abortive close) }

    7877. 

  7877.     if (State = wsConnected) and (FProto = IPPROTO_TCP) then begin

    7878. 

  7878.         LingerOnOff := wsLingerOff;

    7879. 

  7879.         SetLingerOption;

    7880. 

  7880.     end;

    7881. 

  7881.     InternalClose(FALSE, ErrCode);

    7882. 

  7882. end;

    7883. 

  7883. 

    7884. 

  7884. 

    7885. 

  7885. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    7886. 

  7886. procedure TCustomWSocket.Close;

    7887. 

  7887. begin

    7888. 

  7888.     InternalClose(TRUE, 0);

    7889. 

  7889. end;

    7890. 

  7890. 

    7891. 

  7891. 

    7892. 

  7892. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    7893. 

  7893. procedure TCustomWSocket.CloseDelayed;

    7894. 

  7894. begin

    7895. 

  7895.     _PostMessage(Handle, FMsg_WM_CLOSE_DELAYED, 0, 0);

    7896. 

  7896. end;

    7897. 

  7897. 

    7898. 

  7898. 

    7899. 

  7899. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    7900. 

  7900. //procedure TCustomWSocket.Release;

    7901. 

  7901. //begin

    7902. 

  7902. //    PostMessage(Handle, FMsg_WM_WSOCKET_RELEASE, 0, 0);

    7903. 

  7903. //end;

    7904. 

  7904. 

    7905. 

  7905. 

    7906. 

  7906. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    7907. 

  7907. procedure TCustomWSocket.WMCloseDelayed(var msg: TMessage);

    7908. 

  7908. begin

    7909. 

  7909.     Close;

    7910. 

  7910. end;

    7911. 

  7911. 

    7912. 

  7912. 

    7913. 

  7913. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    7914. 

  7914. //procedure TCustomWSocket.WMRelease(var msg: TMessage);

    7915. 

  7915. //begin

    7916. 

  7916. //    Destroy;

    7917. 

  7917. //end;

    7918. 

  7918. 

    7919. 

  7919. 

    7920. 

  7920. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    7921. 

  7921. procedure TCustomWSocket.Flush;

    7922. 

  7922. begin

    7923. 

  7923.     while (FHSocket <> INVALID_SOCKET) and     { No more socket   }

    7924. 

  7924.           (not bAllSent) do begin              { Nothing to send  }

    7925. 

  7925.             { Break; }

    7926. 

  7926.         TryToSend;

    7927. 

  7927.         MessagePump;

    7928. 

  7928.     end;

    7929. 

  7929. end;

    7930. 

  7930. 

    7931. 

  7931. 

    7932. 

  7932. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    7933. 

  7933. procedure TCustomWSocket.InternalClose(bShut : Boolean; Error : Word);

    7934. 

  7934. var

    7935. 

  7935.     iStatus : Integer;

    7936. 

  7936. {    Buffer  : array [0..127] of Char; }

    7937. 

  7937. begin

    7938. 

  7938.     if FHSocket = INVALID_SOCKET then begin

    7939. 

  7939.         if FState <> wsClosed then begin

    7940. 

  7940.             ChangeState(wsClosed);

    7941. 

  7941.             AssignDefaultValue;

    7942. 

  7942.         end;

    7943. 

  7943.         Exit;

    7944. 

  7944.     end;

    7945. 

  7945. 

    7946. 

  7946.     if FState = wsClosed then

    7947. 

  7947.         Exit;

    7948. 

  7948. 

    7949. 

  7949. { 11/10/98 called shutdown(1) instead of shutdown(2). This disables only    }

    7950. 

  7950. { sends. Disabling receives as well produced data lost is some cases.       }

    7951. 

  7951. { Manifest constants for Shutdown                                           }

    7952. 

  7952. {  SD_RECEIVE = 0;   disables receives                                      }

    7953. 

  7953. {  SD_SEND    = 1;   disables sends, *Use this one for graceful close*      }

    7954. 

  7954. {  SD_BOTH    = 2;   disables both sends and receives                       }

    7955. 

  7955. 

    7956. 

  7956.     if bShut then

    7957. 

  7957.         ShutDown(1);

    7958. 

  7958. 

    7959. 

  7959.     if FHSocket <> INVALID_SOCKET then begin

    7960. 

  7960.         repeat

    7961. 

  7961.             { Close the socket }

    7962. 

  7962.             iStatus := WSocket_Synchronized_closesocket(FHSocket);

    7963. 

  7963.             if iStatus <> 0 then begin

    7964. 

  7964.                 FLastError := WSocket_Synchronized_WSAGetLastError;

    7965. 

  7965.                 if FLastError <> WSAEWOULDBLOCK then begin

    7966. 

  7966.                     FHSocket := INVALID_SOCKET;

    7967. 

  7967.                     { Ignore the error occuring when winsock DLL not      }

    7968. 

  7968.                     { initialized (occurs when using TWSocket from a DLL) }

    7969. 

  7969.                     if FLastError = WSANOTINITIALISED then

    7970. 

  7970.                         break;

    7971. 

  7971.                     SocketError('Disconnect (closesocket)');

    7972. 

  7972.                     Exit;

    7973. 

  7973.                 end;

    7974. 

  7974.                 MessagePump;

    7975. 

  7975.             end;

    7976. 

  7976.         until iStatus = 0;

    7977. 

  7977.         FHSocket := INVALID_SOCKET;

    7978. 

  7978.     end;

    7979. 

  7979. 

    7980. 

  7980.     ChangeState(wsClosed);

    7981. 

  7981.     if {$IFDEF WIN32}(not (csDestroying in ComponentState)) and {$ENDIF}

    7982. 

  7982.        (not FCloseInvoked) {and Assigned(FOnSessionClosed)} then begin

    7983. 

  7983.         FCloseInvoked := TRUE;

    7984. 

  7984.         TriggerSessionClosed(Error);

    7985. 

  7985.     end;

    7986. 

  7986.     { 29/09/98 Protect AssignDefaultValue because SessionClosed event handler }

    7987. 

  7987.     { may have destroyed the component.                                       }

    7988. 

  7988.     try

    7989. 

  7989.         AssignDefaultValue;

    7990. 

  7990.     except

    7991. 

  7991.     end;

    7992. 

  7992. end;

    7993. 

  7993. 

    7994. 

  7994. 

    7995. 

  7995. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    7996. 

  7996. procedure TCustomWSocket.WaitForClose;

    7997. 

  7997. var

    7998. 

  7998.     lCount    : {$IFDEF FPC} LongWord; {$ELSE} u_long; {$ENDIF}

    7999. 

  7999.     Status    : Integer;

    8000. 

  8000.     DataBuf   : TWSocketData;

    8001. 

  8001. {$IFDEF WIN32}

    8002. 

  8002.     Ch        : Char;

    8003. 

  8003. {$ENDIF}

    8004. 

  8004. begin

    8005. 

  8005.     while (FHSocket <> INVALID_SOCKET) and (FState <> wsClosed) do begin

    8006. 

  8006.         MessagePump;

    8007. 

  8007. 

    8008. 

  8008.         if WSocket_Synchronized_ioctlsocket(FHSocket, FIONREAD, lCount) = SOCKET_ERROR then

    8009. 

  8009.             break;

    8010. 

  8010.         if lCount > 0 then

    8011. 

  8011.             TriggerDataAvailable(0);

    8012. 

  8012. 

    8013. 

  8013. {$IFDEF CLR}

    8014. 

  8014.         SetLength(DataBuf, 1);

    8015. 

  8015. {$ENDIF}

    8016. 

  8016. {$IFDEF WIN32}

    8017. 

  8017.         DataBuf := @Ch;

    8018. 

  8018. {$ENDIF}

    8019. 

  8019.         Status := DoRecv(DataBuf, 1, 0);

    8020. 

  8020.         if Status <= 0 then begin

    8021. 

  8021.             FLastError := WSocket_Synchronized_WSAGetLastError;

    8022. 

  8022.             if FLastError <> WSAEWOULDBLOCK then

    8023. 

  8023.                 break;

    8024. 

  8024.         end;

    8025. 

  8025.         MessagePump;

    8026. 

  8026.     end;

    8027. 

  8027. end;

    8028. 

  8028. 

    8029. 

  8029. 

    8030. 

  8030. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    8031. 

  8031. {$IFDEF CLR}

    8032. 

  8032. function WSocketGetHostByAddr(const Addr : String) : IntPtr;

    8033. 

  8033. var

    8034. 

  8034.     lAddr        : u_long;

    8035. 

  8035.     LookupIntPtr : IntPtr;

    8036. 

  8036. begin

    8037. 

  8037.     if Length(Addr) = 0 then

    8038. 

  8038.         raise ESocketException.Create('Winsock Get Host Addr: Invalid address.');   { V5.26 }

    8039. 

  8039. 

    8040. 

  8040.     lAddr        := WSocket_inet_addr(Addr);

    8041. 

  8041.     LookupIntPtr := WSocket_gethostbyaddr(lAddr, 4, PF_INET);

    8042. 

  8042.     Result       := LookupIntPtr;

    8043. 

  8043. end;

    8044. 

  8044. {$ENDIF}

    8045. 

  8045. {$IFDEF WIN32}

    8046. 

  8046. function WSocketGetHostByAddr(Addr : AnsiString) : PHostEnt;

    8047. 

  8047. var

    8048. 

  8048.     szAddr : array[0..256] of AnsiChar;

    8049. 

  8049.     lAddr  : u_long;

    8050. 

  8050. begin

    8051. 

  8051.     if (Length(Addr) = 0) or (Length(Addr) >= SizeOf(szAddr)) then

    8052. 

  8052.         raise ESocketException.Create('Winsock Get Host Addr: Invalid address.');   { V5.26 }

    8053. 

  8053. 

    8054. 

  8054.     _StrPCopy(szAddr, Addr); { Length already checked above }

    8055. 

  8055.     lAddr  := WSocket_inet_addr(szAddr);

    8056. 

  8056.     Result := WSocket_gethostbyaddr(PAnsiChar(@lAddr), 4, PF_INET);

    8057. 

  8057. end;

    8058. 

  8058. {$ENDIF}

    8059. 

  8059. 

    8060. 

  8060. 

    8061. 

  8061. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    8062. 

  8062. function WSocketResolveIp(IpAddr : AnsiString) : AnsiString;

    8063. 

  8063. {$IFDEF CLR}

    8064. 

  8064. var

    8065. 

  8065.     HostEntry    : THostEnt;

    8066. 

  8066.     LookupIntPtr : IntPtr;

    8067. 

  8067. begin

    8068. 

  8068.     LookupIntPtr := WSocketGetHostByAddr(IpAddr);

    8069. 

  8069.     if LookupIntPtr = IntPtr.Zero then

    8070. 

  8070.         Result := ''

    8071. 

  8071.     else begin

    8072. 

  8072.         HostEntry    := THostEnt(Marshal.PtrToStructure(LookupIntPtr,

    8073. 

  8073.                                                         TypeOf(THostEnt)));

    8074. 

  8074.         Result    := Marshal.PtrToStringAnsi(HostEntry.h_name);

    8075. 

  8075.     end;

    8076. 

  8076. end;

    8077. 

  8077. {$ENDIF}

    8078. 

  8078. {$IFDEF WIN32}

    8079. 

  8079. var

    8080. 

  8080.     Phe : PHostEnt;

    8081. 

  8081. begin

    8082. 

  8082.     phe := WSocketGetHostByAddr(IpAddr);

    8083. 

  8083.     if Phe = nil then

    8084. 

  8084.         Result := ''

    8085. 

  8085.     else begin

    8086. 

  8086.         SetLength(Result, _StrLen(Phe^.h_name));

    8087. 

  8087.         _StrCopy(@Result[1], Phe^.h_name);

    8088. 

  8088.     end;

    8089. 

  8089. end;

    8090. 

  8090. {$ENDIF}

    8091. 

  8091. 

    8092. 

  8092. 

    8093. 

  8093. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    8094. 

  8094. {$IFDEF CLR}

    8095. 

  8095. function WSocketGetHostByName(const Name : String) : IntPtr;

    8096. 

  8096. begin

    8097. 

  8097.     if Length(Name) = 0 then

    8098. 

  8098.         raise ESocketException.Create('Winsock Get Host Name: Invalid Hostname.');   { V5.26 }

    8099. 

  8099. 

    8100. 

  8100.     Result := WSocket_gethostbyname(Name);

    8101. 

  8101. end;

    8102. 

  8102. {$ENDIF}

    8103. 

  8103. {$IFDEF WIN32}

    8104. 

  8104. function WSocketGetHostByName(Name : AnsiString) : PHostEnt;

    8105. 

  8105. var

    8106. 

  8106.     szName : array[0..256] of AnsiChar;

    8107. 

  8107. begin

    8108. 

  8108.     if (Length(Name) = 0) or (Length(Name) >= SizeOf(szName)) then

    8109. 

  8109.         raise ESocketException.Create('Winsock Get Host Name: Invalid Hostname.');   { V5.26 }

    8110. 

  8110. 

    8111. 

  8111.     _StrPCopy(szName, Name);

    8112. 

  8112.     Result := WSocket_gethostbyname(szName);

    8113. 

  8113. end;

    8114. 

  8114. {$ENDIF}

    8115. 

  8115. 

    8116. 

  8116. 

    8117. 

  8117. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    8118. 

  8118. function LocalIPList : TStrings;

    8119. 

  8119. {$IFDEF CLR}

    8120. 

  8120. var

    8121. 

  8121.     HostEntry    : THostEnt;

    8122. 

  8122.     LookupIntPtr : IntPtr;

    8123. 

  8123. begin

    8124. 

  8124.     IPList.Clear;

    8125. 

  8125.     Result := IPList;

    8126. 

  8126. 

    8127. 

  8127.     LookupIntPtr := WSocketGetHostByName(LocalHostName);

    8128. 

  8128.     if LookupIntPtr <> IntPtr.Zero then begin

    8129. 

  8129.         HostEntry := THostEnt(Marshal.PtrToStructure(LookupIntPtr,

    8130. 

  8130.                                                      TypeOf(THostEnt)));

    8131. 

  8131.         GetIpList(HostEntry, IPList);

    8132. 

  8132.     end;

    8133. 

  8133. end;

    8134. 

  8134. {$ENDIF}

    8135. 

  8135. {$IFDEF WIN32}

    8136. 

  8136. var

    8137. 

  8137.     phe  : PHostEnt;

    8138. 

  8138. begin

    8139. 

  8139.     IPList.Clear;

    8140. 

  8140.     Result := IPList;

    8141. 

  8141. 

    8142. 

  8142.     phe  := WSocketGetHostByName(LocalHostName);

    8143. 

  8143.     if phe <> nil then

    8144. 

  8144.         GetIpList(Phe, IPList);

    8145. 

  8145. end;

    8146. 

  8146. {$ENDIF}

    8147. 

  8147. 

    8148. 

  8148. 

    8149. 

  8149. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    8150. 

  8150. function LocalHostName : AnsiString;

    8151. 

  8151. begin

    8152. 

  8152.     if WSocket_gethostname(Result) <> 0 then

    8153. 

  8153.         raise ESocketException.Create('Winsock Get Host Name failed');

    8154. 

  8154. 

    8155. 

  8155. end;

    8156. 

  8156. 

    8157. 

  8157. 

    8158. 

  8158. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    8159. 

  8159. function TCustomWSocket.TimerIsSet(var tvp : TTimeVal) : Boolean;

    8160. 

  8160. begin

    8161. 

  8161.     Result := (tvp.tv_sec <> 0) or (tvp.tv_usec <> 0);

    8162. 

  8162. end;

    8163. 

  8163. 

    8164. 

  8164. 

    8165. 

  8165. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    8166. 

  8166. function TCustomWSocket.TimerCmp(var tvp : TTimeVal; var uvp : TTimeVal; IsEqual : Boolean) : Boolean;

    8167. 

  8167. begin

    8168. 

  8168.     Result := (tvp.tv_sec = uvp.tv_sec) and (tvp.tv_usec = uvp.tv_usec);

    8169. 

  8169.     if not IsEqual then

    8170. 

  8170.         Result := not Result;

    8171. 

  8171. end;

    8172. 

  8172. 

    8173. 

  8173. 

    8174. 

  8174. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    8175. 

  8175. procedure TCustomWSocket.TimerClear(var tvp : TTimeVal);

    8176. 

  8176. begin

    8177. 

  8177.    tvp.tv_sec  := 0;

    8178. 

  8178.    tvp.tv_usec := 0;

    8179. 

  8179. end;

    8180. 

  8180. 

    8181. 

  8181. 

    8182. 

  8182. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    8183. 

  8183. procedure TCustomWSocket.SetSendFlags(newValue : TSocketSendFlags);

    8184. 

  8184. begin

    8185. 

  8185.     case newValue of

    8186. 

  8186.     wsSendNormal: FSendFlags := 0;

    8187. 

  8187.     wsSendUrgent: FSendFlags := MSG_OOB;

    8188. 

  8188.     else

    8189. 

  8189.         RaiseException('Invalid SendFlags');

    8190. 

  8190.     end;

    8191. 

  8191. end;

    8192. 

  8192. 

    8193. 

  8193. 

    8194. 

  8194. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    8195. 

  8195. function TCustomWSocket.GetSendFlags : TSocketSendFlags;

    8196. 

  8196. begin

    8197. 

  8197.     case FSendFlags of

    8198. 

  8198.     0       : Result := wsSendNormal;

    8199. 

  8199.     MSG_OOB : Result := wsSendUrgent;

    8200. 

  8200.     else

    8201. 

  8201.         RaiseException('Invalid internal SendFlags');

    8202. 

  8202.         Result := wsSendNormal;

    8203. 

  8203.     end;

    8204. 

  8204. end;

    8205. 

  8205. 

    8206. 

  8206. 

    8207. 

  8207. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    8208. 

  8208. procedure TCustomWSocket.TriggerDebugDisplay(Msg : String);

    8209. 

  8209. begin

    8210. 

  8210.     if Assigned(FOnDebugDisplay) then

    8211. 

  8211.         FOnDebugDisplay(Self, Msg);

    8212. 

  8212. end;

    8213. 

  8213. 

    8214. 

  8214. 

    8215. 

  8215. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    8216. 

  8216. procedure TCustomWSocket.TriggerSendData(BytesSent : Integer);

    8217. 

  8217. begin

    8218. 

  8218.     if Assigned(FOnSendData) then

    8219. 

  8219.         FOnSendData(Self, BytesSent);

    8220. 

  8220. end;

    8221. 

  8221. 

    8222. 

  8222. 

    8223. 

  8223. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    8224. 

  8224. procedure TCustomWSocket.TriggerSessionAvailable(Error : Word);

    8225. 

  8225. begin

    8226. 

  8226.     if Assigned(FOnSessionAvailable) then

    8227. 

  8227.         FOnSessionAvailable(Self, Error);

    8228. 

  8228. end;

    8229. 

  8229. 

    8230. 

  8230. 

    8231. 

  8231. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    8232. 

  8232. procedure TCustomWSocket.TriggerSessionConnectedSpecial(Error : Word);

    8233. 

  8233. begin

    8234. 

  8234.     if Assigned(FCounter) and (FType = SOCK_STREAM) and (Error = 0) then

    8235. 

  8235.         FCounter.SetConnected;

    8236. 

  8236.     TriggerSessionConnected(Error);

    8237. 

  8237. end;

    8238. 

  8238. 

    8239. 

  8239. 

    8240. 

  8240. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    8241. 

  8241. procedure TCustomWSocket.TriggerSessionConnected(Error : Word);

    8242. 

  8242. begin

    8243. 

  8243.     FReadCount  := 0;  { 7.24 }

    8244. 

  8244.     FWriteCount := 0;  { 7.24 }

    8245. 

  8245.     if Assigned(FOnSessionConnected) then

    8246. 

  8246.         FOnSessionConnected(Self, Error);

    8247. 

  8247. end;

    8248. 

  8248. 

    8249. 

  8249. 

    8250. 

  8250. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    8251. 

  8251. procedure TCustomWSocket.TriggerSessionClosed(Error : Word);

    8252. 

  8252. begin

    8253. 

  8253.     if Assigned(FOnSessionClosed) then

    8254. 

  8254.         FOnSessionClosed(Self, Error);

    8255. 

  8255. end;

    8256. 

  8256. 

    8257. 

  8257. 

    8258. 

  8258. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    8259. 

  8259. function TCustomWSocket.TriggerDataAvailable(Error : Word) : Boolean;

    8260. 

  8260. begin

    8261. 

  8261.     Result := Assigned(FOnDataAvailable);

    8262. 

  8262.     if not Result then

    8263. 

  8263.         Exit;

    8264. 

  8264. {$IFDEF TOMASEK}                    { 23/01/99 }

    8265. 

  8265.     { Do not allow FD_READ messages, this will prevent reentering the }

    8266. 

  8266.     { OnDataAvailable event handler.                                  }

    8267. 

  8267.     FSelectEvent := FD_WRITE or FD_CLOSE or FD_CONNECT;

    8268. 

  8268.     WSocket_Synchronized_WSAASyncSelect(FHSocket, Handle, WM_ASYNCSELECT, FSelectEvent);

    8269. 

  8269.     try

    8270. 

  8270.         FRcvdFlag := TRUE;

    8271. 

  8271.         while Result and FRcvdFlag do begin

    8272. 

  8272.             { Trigger user code. This will normally call DoRecv which will }

    8273. 

  8273.             { update FRcvdFlag.                                            }

    8274. 

  8274.             { If user code is wrong, we'll loop forever !                  }

    8275. 

  8275.             FOnDataAvailable(Self, Error);

    8276. 

  8276.             Result := Assigned(FOnDataAvailable);

    8277. 

  8277.         end;

    8278. 

  8278.     finally

    8279. 

  8279.         { Allow all events now }

    8280. 

  8280.         FSelectEvent := FD_READ or FD_WRITE or FD_CLOSE or FD_CONNECT;

    8281. 

  8281.         WSocket_Synchronized_WSAASyncSelect(FHSocket, Handle, WM_ASYNCSELECT, FSelectEvent);

    8282. 

  8282.     end;

    8283. 

  8283. {$ELSE}                             { 23/01/99 }

    8284. 

  8284.     FOnDataAvailable(Self, Error);  { 23/01/99 }

    8285. 

  8285. {$ENDIF}                            { 23/01/99 }

    8286. 

  8286. end;

    8287. 

  8287. 

    8288. 

  8288. 

    8289. 

  8289. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    8290. 

  8290. procedure TCustomWSocket.TriggerDataSent(Error : Word);

    8291. 

  8291. begin

    8292. 

  8292. {$IFNDEF NO_DEBUG_LOG}

    8293. 

  8293.     if CheckLogOptions(loWsockDump) then  { V5.21 } { replaces $IFDEF DEBUG_OUTPUT  }

    8294. 

  8294.         DebugLog(loWsockDump,

    8295. 

  8295.                 {$IFNDEF CLR}

    8296. 

  8296.                 _IntToHex(INT_PTR(Self), SizeOf(Pointer) * 2) + ' ' +

    8297. 

  8297.                 {$ENDIF}

    8298. 

  8298.                 'TriggerDataSent ' + _IntToStr(FHSocket));

    8299. 

  8299. {$ENDIF}

    8300. 

  8300.     if Assigned(FOnDataSent) then

    8301. 

  8301.         FOnDataSent(Self, Error);

    8302. 

  8302. end;

    8303. 

  8303. 

    8304. 

  8304. 

    8305. 

  8305. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    8306. 

  8306. procedure TCustomWSocket.TriggerError;

    8307. 

  8307. begin

    8308. 

  8308.     if Assigned(FOnError) then

    8309. 

  8309.         FOnError(Self);

    8310. 

  8310. end;

    8311. 

  8311. 

    8312. 

  8312. 

    8313. 

  8313. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    8314. 

  8314. procedure TCustomWSocket.TriggerDNSLookupDone(Error : Word);

    8315. 

  8315. begin

    8316. 

  8316.     if Assigned(FOnDNSLookupDone) then

    8317. 

  8317.         FOnDNSLookupDone(Self, Error);

    8318. 

  8318. end;

    8319. 

  8319. 

    8320. 

  8320. 

    8321. 

  8321. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    8322. 

  8322. procedure TCustomWSocket.TriggerChangeState(OldState, NewState : TSocketState);

    8323. 

  8323. begin

    8324. 

  8324.     if Assigned(FOnChangeState) then

    8325. 

  8325.         FOnChangeState(Self, OldState, NewState);

    8326. 

  8326. end;

    8327. 

  8327. 

    8328. 

  8328. 

    8329. 

  8329. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    8330. 

  8330. procedure TCustomWSocket.SocketError(sockfunc: String);

    8331. 

  8331. var

    8332. 

  8332.     Error  : Integer;

    8333. 

  8333.     Line   : String;

    8334. 

  8334. begin

    8335. 

  8335.     Error := WSocket_Synchronized_WSAGetLastError;

    8336. 

  8336. {    Line  := 'Error '+ IntToStr(Error) + ' in function ' + sockfunc +

    8337. 

  8337.              #13#10 + WSocketErrorDesc(Error);  }

    8338. 

  8338.     Line  := WSocketErrorDesc(Error) + ' (#' + _IntToStr(Error) +

    8339. 

  8339.                                          ' in ' + sockfunc + ')' ;   { V5.26 }

    8340. 

  8340. 

    8341. 

  8341.     if (Error = WSAECONNRESET) or

    8342. 

  8342.        (Error = WSAENOTCONN)   then begin

    8343. 

  8343.         WSocket_Synchronized_closesocket(FHSocket);

    8344. 

  8344.         FHSocket := INVALID_SOCKET;

    8345. 

  8345.         if FState <> wsClosed then

    8346. 

  8346.            TriggerSessionClosed(Error);

    8347. 

  8347.         ChangeState(wsClosed);

    8348. 

  8348.     end;

    8349. 

  8349. 

    8350. 

  8350.     FLastError := Error;

    8351. 

  8351.     RaiseException(Line);

    8352. 

  8352. end;

    8353. 

  8353. 

    8354. 

  8354. 

    8355. 

  8355. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} { V5.21 }

    8356. 

  8356. {$IFNDEF NO_DEBUG_LOG}

    8357. 

  8357. function TCustomWSocket.CheckLogOptions(const LogOption: TLogOption): Boolean;

    8358. 

  8358. begin

    8359. 

  8359.     Result := Assigned(FIcsLogger) and (LogOption in FIcsLogger.LogOptions);

    8360. 

  8360. end;

    8361. 

  8361. 

    8362. 

  8362. 

    8363. 

  8363. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    8364. 

  8364. procedure TCustomWSocket.DebugLog(LogOption: TLogOption; const Msg: String);  { V5.21 }

    8365. 

  8365. begin

    8366. 

  8366.     if Assigned(FIcsLogger) then

    8367. 

  8367.         FIcsLogger.DoDebugLog(Self, LogOption, Msg);

    8368. 

  8368. end;

    8369. 

  8369. 

    8370. 

  8370. 

    8371. 

  8371. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *} { V5.21 }

    8372. 

  8372. procedure TCustomWSocket.SetIcsLogger(const Value: TIcsLogger);

    8373. 

  8373. begin

    8374. 

  8374.     FIcsLogger := Value;

    8375. 

  8375.     if Value <> nil then

    8376. 

  8376.         Value.FreeNotification(Self);

    8377. 

  8377. end;

    8378. 

  8378. {$ENDIF}

    8379. 

  8379. 

    8380. 

  8380. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    8381. 

  8381. procedure TCustomWSocket.SetSocketRcvBufSize(BufSize : Integer);

    8382. 

  8382. var

    8383. 

  8383.     iStatus : Integer;

    8384. 

  8384.     optlen  : Integer;

    8385. 

  8385. begin

    8386. 

  8386.     optlen  := SizeOf(BufSize);

    8387. 

  8387. {$IFDEF CLR}

    8388. 

  8388.     iStatus := WSocket_setsockopt(FHSocket, SOL_SOCKET, SO_RCVBUF,

    8389. 

  8389.                                   BufSize, optlen);

    8390. 

  8390. {$ELSE}

    8391. 

  8391.     iStatus := WSocket_setsockopt(FHSocket, SOL_SOCKET, SO_RCVBUF,

    8392. 

  8392.                                   PAnsiChar(@BufSize), optlen);

    8393. 

  8393. {$ENDIF}

    8394. 

  8394.     if iStatus = 0 then

    8395. 

  8395.         FSocketSndBufSize := BufSize

    8396. 

  8396.     else

    8397. 

  8397.         SocketError('setsockopt(SO_RCVBUF)');

    8398. 

  8398. end;

    8399. 

  8399. 

    8400. 

  8400. 

    8401. 

  8401. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    8402. 

  8402. procedure TCustomWSocket.SetSocketSndBufSize(BufSize : Integer);

    8403. 

  8403. var

    8404. 

  8404.     iStatus : Integer;

    8405. 

  8405.     optlen  : Integer;

    8406. 

  8406. begin

    8407. 

  8407.     optlen  := SizeOf(BufSize);

    8408. 

  8408. {$IFDEF CLR}

    8409. 

  8409.     iStatus := WSocket_setsockopt(FHSocket, SOL_SOCKET, SO_SNDBUF,

    8410. 

  8410.                                   BufSize, optlen);

    8411. 

  8411. {$ELSE}

    8412. 

  8412.     iStatus := WSocket_setsockopt(FHSocket, SOL_SOCKET, SO_SNDBUF,

    8413. 

  8413.                                   PAnsiChar(@BufSize), optlen);

    8414. 

  8414. {$ENDIF}

    8415. 

  8415.     if iStatus = 0 then

    8416. 

  8416.         FSocketSndBufSize := BufSize

    8417. 

  8417.     else

    8418. 

  8418.         SocketError('setsockopt(SO_SNDBUF)');

    8419. 

  8419. end;

    8420. 

  8420. 

    8421. 

  8421. 

    8422. 

  8422. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    8423. 

  8423. function WSocketErrorDesc(ErrCode : Integer) : String;

    8424. 

  8424. begin

    8425. 

  8425.     case ErrCode of

    8426. 

  8426.     0:

    8427. 

  8427.       WSocketErrorDesc := 'No Error';

    8428. 

  8428.     WSAEINTR:

    8429. 

  8429.       WSocketErrorDesc := 'Interrupted system call';

    8430. 

  8430.     WSAEBADF:

    8431. 

  8431.       WSocketErrorDesc := 'Bad file number';

    8432. 

  8432.     WSAEACCES:

    8433. 

  8433.       WSocketErrorDesc := 'Permission denied';

    8434. 

  8434.     WSAEFAULT:

    8435. 

  8435.       WSocketErrorDesc := 'Bad address';

    8436. 

  8436.     WSAEINVAL:

    8437. 

  8437.       WSocketErrorDesc := 'Invalid argument';

    8438. 

  8438.     WSAEMFILE:

    8439. 

  8439.       WSocketErrorDesc := 'Too many open files';

    8440. 

  8440.     WSAEWOULDBLOCK:

    8441. 

  8441.       WSocketErrorDesc := 'Operation would block';

    8442. 

  8442.     WSAEINPROGRESS:

    8443. 

  8443.       WSocketErrorDesc := 'Operation now in progress';

    8444. 

  8444.     WSAEALREADY:

    8445. 

  8445.       WSocketErrorDesc := 'Operation already in progress';

    8446. 

  8446.     WSAENOTSOCK:

    8447. 

  8447.       WSocketErrorDesc := 'Socket operation on non-socket';

    8448. 

  8448.     WSAEDESTADDRREQ:

    8449. 

  8449.       WSocketErrorDesc := 'Destination address required';

    8450. 

  8450.     WSAEMSGSIZE:

    8451. 

  8451.       WSocketErrorDesc := 'Message too long';

    8452. 

  8452.     WSAEPROTOTYPE:

    8453. 

  8453.       WSocketErrorDesc := 'Protocol wrong type for socket';

    8454. 

  8454.     WSAENOPROTOOPT:

    8455. 

  8455.       WSocketErrorDesc := 'Protocol not available';

    8456. 

  8456.     WSAEPROTONOSUPPORT:

    8457. 

  8457.       WSocketErrorDesc := 'Protocol not supported';

    8458. 

  8458.     WSAESOCKTNOSUPPORT:

    8459. 

  8459.       WSocketErrorDesc := 'Socket type not supported';

    8460. 

  8460.     WSAEOPNOTSUPP:

    8461. 

  8461.       WSocketErrorDesc := 'Operation not supported on socket';

    8462. 

  8462.     WSAEPFNOSUPPORT:

    8463. 

  8463.       WSocketErrorDesc := 'Protocol family not supported';

    8464. 

  8464.     WSAEAFNOSUPPORT:

    8465. 

  8465.       WSocketErrorDesc := 'Address family not supported by protocol family';

    8466. 

  8466.     WSAEADDRINUSE:

    8467. 

  8467.       WSocketErrorDesc := 'Address already in use';

    8468. 

  8468.     WSAEADDRNOTAVAIL:

    8469. 

  8469.       WSocketErrorDesc := 'Address not available';

    8470. 

  8470.     WSAENETDOWN:

    8471. 

  8471.       WSocketErrorDesc := 'Network is down';

    8472. 

  8472.     WSAENETUNREACH:

    8473. 

  8473.       WSocketErrorDesc := 'Network is unreachable';

    8474. 

  8474.     WSAENETRESET:

    8475. 

  8475.       WSocketErrorDesc := 'Network dropped connection on reset';

    8476. 

  8476.     WSAECONNABORTED:

    8477. 

  8477.       WSocketErrorDesc := 'Connection aborted';

    8478. 

  8478.     WSAECONNRESET:

    8479. 

  8479.       WSocketErrorDesc := 'Connection reset by peer';

    8480. 

  8480.     WSAENOBUFS:

    8481. 

  8481.       WSocketErrorDesc := 'No buffer space available';

    8482. 

  8482.     WSAEISCONN:

    8483. 

  8483.       WSocketErrorDesc := 'Socket is already connected';

    8484. 

  8484.     WSAENOTCONN:

    8485. 

  8485.       WSocketErrorDesc := 'Socket is not connected';

    8486. 

  8486.     WSAESHUTDOWN:

    8487. 

  8487.       WSocketErrorDesc := 'Can''t send after socket shutdown';

    8488. 

  8488.     WSAETOOMANYREFS:

    8489. 

  8489.       WSocketErrorDesc := 'Too many references: can''t splice';

    8490. 

  8490.     WSAETIMEDOUT:

    8491. 

  8491.       WSocketErrorDesc := 'Connection timed out';

    8492. 

  8492.     WSAECONNREFUSED:

    8493. 

  8493.       WSocketErrorDesc := 'Connection refused';

    8494. 

  8494.     WSAELOOP:

    8495. 

  8495.       WSocketErrorDesc := 'Too many levels of symbolic links';

    8496. 

  8496.     WSAENAMETOOLONG:

    8497. 

  8497.       WSocketErrorDesc := 'File name too long';

    8498. 

  8498.     WSAEHOSTDOWN:

    8499. 

  8499.       WSocketErrorDesc := 'Host is down';

    8500. 

  8500.     WSAEHOSTUNREACH:

    8501. 

  8501.       WSocketErrorDesc := 'No route to host';

    8502. 

  8502.     WSAENOTEMPTY:

    8503. 

  8503.       WSocketErrorDesc := 'Directory not empty';

    8504. 

  8504.     WSAEPROCLIM:

    8505. 

  8505.       WSocketErrorDesc := 'Too many processes';

    8506. 

  8506.     WSAEUSERS:

    8507. 

  8507.       WSocketErrorDesc := 'Too many users';

    8508. 

  8508.     WSAEDQUOT:

    8509. 

  8509.       WSocketErrorDesc := 'Disc quota exceeded';

    8510. 

  8510.     WSAESTALE:

    8511. 

  8511.       WSocketErrorDesc := 'Stale NFS file handle';

    8512. 

  8512.     WSAEREMOTE:

    8513. 

  8513.       WSocketErrorDesc := 'Too many levels of remote in path';

    8514. 

  8514.     WSASYSNOTREADY:

    8515. 

  8515.       WSocketErrorDesc := 'Network sub-system is unusable';

    8516. 

  8516.     WSAVERNOTSUPPORTED:

    8517. 

  8517.       WSocketErrorDesc := 'WinSock DLL cannot support this application';

    8518. 

  8518.     WSANOTINITIALISED:

    8519. 

  8519.       WSocketErrorDesc := 'WinSock not initialized';

    8520. 

  8520.     WSAHOST_NOT_FOUND:

    8521. 

  8521.       WSocketErrorDesc := 'Host not found';

    8522. 

  8522.     WSATRY_AGAIN:

    8523. 

  8523.       WSocketErrorDesc := 'Non-authoritative host not found';

    8524. 

  8524.     WSANO_RECOVERY:

    8525. 

  8525.       WSocketErrorDesc := 'Non-recoverable error';

    8526. 

  8526.     WSANO_DATA:

    8527. 

  8527.       WSocketErrorDesc := 'No Data';

    8528. 

  8528.     else

    8529. 

  8529.       WSocketErrorDesc := 'Not a WinSock error';

    8530. 

  8530.     end;

    8531. 

  8531. end;

    8532. 

  8532. 

    8533. 

  8533. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    8534. 

  8534. function GetWinsockErr(ErrCode: Integer): String ;    { V5.26 }

    8535. 

  8535. begin

    8536. 

  8536.     Result := WSocketErrorDesc(ErrCode) + ' (#' + _IntToStr(ErrCode) + ')' ;

    8537. 

  8537. end;

    8538. 

  8538. 

    8539. 

  8539. 

    8540. 

  8540. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    8541. 

  8541. function GetWindowsErr(ErrCode: Integer): String ;    { V5.26 }

    8542. 

  8542. begin

    8543. 

  8543.     Result := _SysErrorMessage(ErrCode) + ' (#' + _IntToStr(ErrCode) + ')' ;

    8544. 

  8544. end;

    8545. 

  8545. 

    8546. 

  8546. 

    8547. 

  8547. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

    8548. 

  8548. 

    8549. 

  8549.          X X        X X        X X       X      X      X X      X X X X

    8550. 

  8550.        X     X    X     X    X     X     X     X     X     X    X

    8551. 

  8551.        X          X     X    X           X   X       X          X

    8552. 

  8552.          X X      X     X    X           X X           X X        X X

    8553. 

  8553.              X    X     X    X           X   X             X          X

    8554. 

  8554.        X     X    X     X    X     X     X     X     X     X    X     X

    8555. 

  8555.          X X        X X        X X       X      X      X  X       X X

    8556. 

  8556. 

    8557. 

  8557.  * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    8558. 

  8558. constructor TCustomSocksWSocket.Create{$IFDEF VCL}(AOwner: TComponent){$ENDIF};

    8559. 

  8559. begin

    8560. 

  8560.     inherited Create{$IFDEF VCL}(AOwner){$ENDIF};

    8561. 

  8561.     FSocksUsercode := '';

    8562. 

  8562.     FSocksPassword := '';

    8563. 

  8563. end;

    8564. 

  8564. 

    8565. 

  8565. 

    8566. 

  8566. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    8567. 

  8567. procedure TCustomSocksWSocket.AssignDefaultValue;

    8568. 

  8568. begin

    8569. 

  8569.     inherited AssignDefaultValue;

    8570. 

  8570.     FSocksState          := socksData;

    8571. 

  8571.     FSocksServer         := '';

    8572. 

  8572.     FSocksPort           := '';

    8573. 

  8573.     FSocksLevel          := '5';

    8574. 

  8574.     FSocksRcvdCnt        := 0;

    8575. 

  8575.     FSocksPortAssigned   := FALSE;

    8576. 

  8576.     FSocksServerAssigned := FALSE;

    8577. 

  8577. end;

    8578. 

  8578. 

    8579. 

  8579. 

    8580. 

  8580. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    8581. 

  8581. procedure TCustomSocksWSocket.SetSocksLevel(newValue : String);

    8582. 

  8582. begin

    8583. 

  8583.     if State <> wsClosed then begin

    8584. 

  8584.         RaiseException('Can''t change socks level if not closed');

    8585. 

  8585.         Exit;

    8586. 

  8586.     end;

    8587. 

  8587.     if (newValue <> '4')  and (newValue <> '5') and

    8588. 

  8588.        (newValue <> '4A') and (newValue <> '4a') then begin

    8589. 

  8589.         RaiseException('Invalid socks level. Must be 4, 4A or 5.');

    8590. 

  8590.         Exit;

    8591. 

  8591.     end;

    8592. 

  8592.     FSocksLevel := _UpperCase(newValue);

    8593. 

  8593. end;

    8594. 

  8594. 

    8595. 

  8595. 

    8596. 

  8596. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    8597. 

  8597. function TCustomSocksWSocket.GetSocksPort: String;

    8598. 

  8598. begin

    8599. 

  8599.     Result := FSocksPort;

    8600. 

  8600. end;

    8601. 

  8601. 

    8602. 

  8602. 

    8603. 

  8603. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    8604. 

  8604. procedure TCustomSocksWSocket.SetSocksPort(sPort : String);

    8605. 

  8605. begin

    8606. 

  8606.     if State <> wsClosed then begin

    8607. 

  8607.         RaiseException('Can''t change socks port if not closed');

    8608. 

  8608.         Exit;

    8609. 

  8609.     end;

    8610. 

  8610. 

    8611. 

  8611.     FSocksPort := _Trim(sPort);

    8612. 

  8612. 

    8613. 

  8613.     if Length(FSocksPort) = 0 then begin

    8614. 

  8614.         FSocksPortAssigned := FALSE;

    8615. 

  8615.         Exit;

    8616. 

  8616.     end;

    8617. 

  8617.     FSocksPortAssigned := TRUE;

    8618. 

  8618. end;

    8619. 

  8619. 

    8620. 

  8620. 

    8621. 

  8621. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    8622. 

  8622. function TCustomSocksWSocket.GetSocksServer: String;

    8623. 

  8623. begin

    8624. 

  8624.     Result := FSocksServer;

    8625. 

  8625. end;

    8626. 

  8626. 

    8627. 

  8627. 

    8628. 

  8628. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    8629. 

  8629. procedure TCustomSocksWSocket.SetSocksServer(sServer : String);

    8630. 

  8630. begin

    8631. 

  8631.     if State <> wsClosed then begin

    8632. 

  8632.         RaiseException('Can''t change socks server if not closed');

    8633. 

  8633.         Exit;

    8634. 

  8634.     end;

    8635. 

  8635. 

    8636. 

  8636.     FSocksServer := _Trim(sServer);

    8637. 

  8637. 

    8638. 

  8638.     if Length(FSocksServer) = 0 then begin

    8639. 

  8639.         FSocksServerAssigned := FALSE;

    8640. 

  8640.         Exit;

    8641. 

  8641.     end;

    8642. 

  8642.     FSocksServerAssigned := TRUE;

    8643. 

  8643. end;

    8644. 

  8644. 

    8645. 

  8645. 

    8646. 

  8646. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    8647. 

  8647. procedure TCustomSocksWSocket.Listen;

    8648. 

  8648. begin

    8649. 

  8649.     { Check if we really wants to use socks server }

    8650. 

  8650.     if not FSocksServerAssigned then begin

    8651. 

  8651.         { No socks server assigned, Listen as usual }

    8652. 

  8652.         inherited Listen;

    8653. 

  8653.         Exit;

    8654. 

  8654.     end;

    8655. 

  8655.     RaiseException('Listening is not supported thru socks server');

    8656. 

  8656. end;

    8657. 

  8657. 

    8658. 

  8658. 

    8659. 

  8659. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    8660. 

  8660. procedure TCustomSocksWSocket.Connect;

    8661. 

  8661. begin

    8662. 

  8662.     { Check if we really wants to use socks server }

    8663. 

  8663.     if not FSocksServerAssigned then begin

    8664. 

  8664.         { No socks server assigned, connect as usual }

    8665. 

  8665.         inherited Connect;

    8666. 

  8666.         Exit;

    8667. 

  8667.     end;

    8668. 

  8668. 

    8669. 

  8669.     if (_LowerCase(FProtoStr) <> 'tcp') and (_Trim(FProtoStr) <> '6') then begin

    8670. 

  8670.         RaiseException('TCP is the only protocol supported thru socks server'); { V5.26 }

    8671. 

  8671.         Exit;

    8672. 

  8672.     end;

    8673. 

  8673. 

    8674. 

  8674.     try

    8675. 

  8675.         if not FPortResolved then begin

    8676. 

  8676.             { The next line will trigger an exception in case of failure }

    8677. 

  8677.             sin.sin_port  := WSocket_Synchronized_htons(WSocket_Synchronized_ResolvePort(AnsiString(FSocksPort), AnsiString(FProtoStr)));

    8678. 

  8678.             FPortResolved := TRUE;

    8679. 

  8679.         end;

    8680. 

  8680. 

    8681. 

  8681.         if not FAddrResolved then begin

    8682. 

  8682.             { The next line will trigger an exception in case of failure }

    8683. 

  8683.             sin.sin_addr.s_addr := WSocket_Synchronized_ResolveHost(AnsiString(FSocksServer)).s_addr;

    8684. 

  8684.             FAddrResolved       := TRUE;

    8685. 

  8685.         end;

    8686. 

  8686.         { The next line will trigger an exception in case of failure }

    8687. 

  8687.         FPortNum := WSocket_Synchronized_ResolvePort(AnsiString(FPortStr), AnsiString(FProtoStr));

    8688. 

  8688.     except

    8689. 

  8689.         on E:Exception do begin

    8690. 

  8690.             RaiseException('Connect: ' + E.Message);  { V5.26 }

    8691. 

  8691.             Exit;

    8692. 

  8692.         end;

    8693. 

  8693.     end;

    8694. 

  8694. 

    8695. 

  8695.     FSocksState := socksNegociateMethods;

    8696. 

  8696.     FRcvCnt     := 0;

    8697. 

  8697.     inherited Connect;

    8698. 

  8698. end;

    8699. 

  8699. 

    8700. 

  8700. 

    8701. 

  8701. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    8702. 

  8702. {function BufToStr(Buf : PChar; Cnt : Integer) : String;

    8703. 

  8703. begin

    8704. 

  8704.     Result := '';

    8705. 

  8705.     while Cnt > 0 do begin

    8706. 

  8706.         if Buf^ in [#32..#126] then

    8707. 

  8707.             Result := Result + Buf^

    8708. 

  8708.         else

    8709. 

  8709.             Result := Result + '#' + Format('%2.2d', [ord(Buf^)]);

    8710. 

  8710.         Inc(Buf);

    8711. 

  8711.         Dec(Cnt);

    8712. 

  8712.     end;

    8713. 

  8713. end;}

    8714. 

  8714. 

    8715. 

  8715. 

    8716. 

  8716. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    8717. 

  8717. procedure TCustomSocksWSocket.TriggerSessionConnectedSpecial(Error : Word);

    8718. 

  8718. var

    8719. 

  8719.     Buf : {$IFDEF CLR}TBytes;{$ELSE}array [0..2] of AnsiChar;{$ENDIF}

    8720. 

  8720. begin

    8721. 

  8721.     if FSocksState = socksNegociateMethods then begin

    8722. 

  8722.         {ChangeState(wsSocksConnected);}

    8723. 

  8723.         TriggerSocksConnected(Error);

    8724. 

  8724.         if Error <> 0 then begin

    8725. 

  8725.             inherited TriggerSessionConnectedSpecial(Error);

    8726. 

  8726.             Exit;

    8727. 

  8727.         end;

    8728. 

  8728.         if FSocksLevel[1] = '4' then

    8729. 

  8729.             SocksDoConnect

    8730. 

  8730.         else begin

    8731. 

  8731.             if FSocksAuthentication = socksNoAuthentication then

    8732. 

  8732.                 FSocksAuthNumber := #$00        { No authentification }

    8733. 

  8733.             else

    8734. 

  8734.                 FSocksAuthNumber := #$02;       { Usercode/Password   }

    8735. 

  8735. 

    8736. 

  8736.             {$IFDEF CLR}

    8737. 

  8737.             SetLength(Buf, 3);

    8738. 

  8738.             Buf[0] := $05;                      { Version number      }

    8739. 

  8739.             Buf[1] := $01;                      { Number of methods   }

    8740. 

  8740.             Buf[2] := Ord(FSocksAuthNumber);    { Method identifier   }

    8741. 

  8741.             Send(Buf, 3);

    8742. 

  8742.             {$ELSE}

    8743. 

  8743.             Buf[0] := #$05;                     { Version number      }

    8744. 

  8744.             Buf[1] := #$01;                     { Number of methods   }

    8745. 

  8745.             Buf[2] := FSocksAuthNumber;         { Method identifier   }

    8746. 

  8746.             Send(@Buf, 3);

    8747. 

  8747.             {$ENDIF}

    8748. 

  8748.         end;

    8749. 

  8749.     end

    8750. 

  8750.     else

    8751. 

  8751.         inherited TriggerSessionConnectedSpecial(Error);

    8752. 

  8752. end;

    8753. 

  8753. 

    8754. 

  8754. 

    8755. 

  8755. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    8756. 

  8756. procedure TCustomSocksWSocket.TriggerSessionClosed(Error : Word);

    8757. 

  8757. begin

    8758. 

  8758.     if FSocksState = socksAuthenticate then

    8759. 

  8759.         TriggerSocksAuthState(socksAuthFailure);

    8760. 

  8760.     inherited TriggerSessionClosed(Error);

    8761. 

  8761. end;

    8762. 

  8762. 

    8763. 

  8763. 

    8764. 

  8764. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    8765. 

  8765. procedure TCustomSocksWSocket.TriggerSocksConnected(Error : Word);

    8766. 

  8766. begin

    8767. 

  8767.     if Assigned(FOnSocksConnected) then

    8768. 

  8768.         FOnSocksConnected(Self, Error);

    8769. 

  8769. end;

    8770. 

  8770. 

    8771. 

  8771. 

    8772. 

  8772. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    8773. 

  8773. procedure TCustomSocksWSocket.TriggerSocksError(Error : Integer; Msg : String);

    8774. 

  8774. begin

    8775. 

  8775.     if Assigned(FOnSocksError) then

    8776. 

  8776.         FOnSocksError(Self, Error, Msg);

    8777. 

  8777. end;

    8778. 

  8778. 

    8779. 

  8779. 

    8780. 

  8780. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    8781. 

  8781. procedure TCustomSocksWSocket.TriggerSocksAuthState(AuthState : TSocksAuthState);

    8782. 

  8782. begin

    8783. 

  8783.     if Assigned(FOnSocksAuthState) then

    8784. 

  8784.         FOnSocksAuthState(Self, AuthState);

    8785. 

  8785. end;

    8786. 

  8786. 

    8787. 

  8787. 

    8788. 

  8788. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    8789. 

  8789. { Rfc1929  Username/Password Autentication protocol.

    8790. 

  8790. The UNAME field contains the username as known to the source operating system.

    8791. 

  8791. The PLEN field contains the length of the PASSWD field that follows.

    8792. 

  8792. The PASSWD field contains the password association with the given UNAME.

    8793. 

  8793. 

    8794. 

  8794. Rfc1929 does not mention anything about character sets allowed so currently

    8795. 

  8795. the Win32 code below converts the user name and password to ANSI using the

    8796. 

  8796. default system code page.                                                   }

    8797. 

  8797. 

    8798. 

  8798. procedure TCustomSocksWSocket.SocksDoAuthenticate;

    8799. 

  8799. {$IFDEF CLR}

    8800. 

  8800. var

    8801. 

  8801.     Buf     : TBytes;

    8802. 

  8802.     I, J    : Integer;

    8803. 

  8803. begin

    8804. 

  8804.     FSocksState := socksAuthenticate;

    8805. 

  8805.     TriggerSocksAuthState(socksAuthStart);

    8806. 

  8806.     SetLength(Buf, 128);

    8807. 

  8807.     I      := 0;

    8808. 

  8808.     Buf[I] := $01; {06/03/99}           { Socks version }

    8809. 

  8809.     Inc(I);

    8810. 

  8810.     Buf[I] := Length(FSocksUsercode);

    8811. 

  8811.     for J := 1 to Length(FSocksUsercode) do begin

    8812. 

  8812.         Inc(I);

    8813. 

  8813.         Buf[I] := Ord(FSocksUsercode[J]);

    8814. 

  8814.     end;

    8815. 

  8815.     Inc(I);

    8816. 

  8816.     Buf[I] := Length(FSocksPassword);

    8817. 

  8817.     for J := 1 to Length(FSocksPassword) do begin

    8818. 

  8818.         Inc(I);

    8819. 

  8819.         Buf[I] := Ord(FSocksPassword[J]);

    8820. 

  8820.     end;

    8821. 

  8821.     Inc(I);

    8822. 

  8822.     try

    8823. 

  8823. {TriggerDisplay('Send = ''' + BufToStr(Buf, I) + '''');}

    8824. 

  8824.         Send(Buf, I);

    8825. 

  8825.     except

    8826. 

  8826.     end;

    8827. 

  8827. end;

    8828. 

  8828. {$ENDIF}

    8829. 

  8829. {$IFDEF WIN32}

    8830. 

  8830. var

    8831. 

  8831.     Buf     : array [0..127] of AnsiChar;

    8832. 

  8832.     I       : Integer;

    8833. 

  8833.     TempS   : AnsiString;

    8834. 

  8834. begin

    8835. 

  8835.     FSocksState := socksAuthenticate;

    8836. 

  8836.     TriggerSocksAuthState(socksAuthStart);

    8837. 

  8837.     Buf[0] := #$01; {06/03/99}           { Socks version }

    8838. 

  8838.     I      := 1;

    8839. 

  8839.     TempS  := AnsiString(FSocksUsercode);

    8840. 

  8840.     Buf[I] := AnsiChar(Length(TempS));

    8841. 

  8841.     Move(TempS[1], Buf[I + 1], Length(TempS));

    8842. 

  8842.     I := I + 1 + Length(TempS);

    8843. 

  8843. 

    8844. 

  8844.     TempS  := AnsiString(FSocksPassword);

    8845. 

  8845.     Buf[I] := AnsiChar(Length(TempS));

    8846. 

  8846.     Move(TempS[1], Buf[I + 1], Length(TempS));

    8847. 

  8847.     I := I + 1 + Length(TempS);

    8848. 

  8848.     try

    8849. 

  8849. {TriggerDisplay('Send = ''' + BufToStr(Buf, I) + '''');}

    8850. 

  8850.         Send(@Buf, I);

    8851. 

  8851.     except

    8852. 

  8852.     end;

    8853. 

  8853. end;

    8854. 

  8854. {$ENDIF}

    8855. 

  8855. 

    8856. 

  8856. 

    8857. 

  8857. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    8858. 

  8858. procedure TCustomSocksWSocket.SocksDoConnect;

    8859. 

  8859. {$IFDEF CLR}

    8860. 

  8860. var

    8861. 

  8861.     Buf     : TBytes;

    8862. 

  8862.     I, J    : Integer;

    8863. 

  8863.     ErrCode : Integer;

    8864. 

  8864.     IP      : u_long;

    8865. 

  8865. begin

    8866. 

  8866.     FSocksState := socksConnect;

    8867. 

  8867.     if FSocksLevel[1] = '4' then begin

    8868. 

  8868.         SetLength(Buf, 128);

    8869. 

  8869.         Buf[0] := 4;                                 { Version number  }

    8870. 

  8870.         Buf[1] := 1;                                 { Connect command }

    8871. 

  8871.         { Todo: Check the byte order ! }

    8872. 

  8872.         Buf[2] := (FPortNum shr 8) and 255;          { Port high byte  }

    8873. 

  8873.         Buf[3] := FPortNum and 255;                  { Port low byte   }

    8874. 

  8874.         if FSocksLevel = '4A' then begin

    8875. 

  8875.             { Conventional IP saying we can't convert the destination   }

    8876. 

  8876.             { host's domain name to find its IP address                 }

    8877. 

  8877.             { The destination must then follow the user ID              }

    8878. 

  8878.             Buf[4] := 0;

    8879. 

  8879.             Buf[5] := 0;

    8880. 

  8880.             Buf[6] := 0;

    8881. 

  8881.             Buf[7] := 1;

    8882. 

  8882.         end

    8883. 

  8883.         else begin

    8884. 

  8884.             { With original SOCKS4, we have to supply the dest address  }

    8885. 

  8885.             try

    8886. 

  8886.                 IP     := WSocketResolveHost(FAddrStr).s_addr;

    8887. 

  8887.                 { Todo: Check the byte order ! }

    8888. 

  8888.                 Buf[4] := (IP shr 24) and 255;

    8889. 

  8889.                 Buf[5] := (IP shr 16) and 255;

    8890. 

  8890.                 Buf[6] := (IP shr  8) and 255;

    8891. 

  8891.                 Buf[7] := IP and 255;

    8892. 

  8892.             except

    8893. 

  8893.                 on E:Exception do begin

    8894. 

  8894.                      ErrCode := socksHostResolutionFailed;

    8895. 

  8895.                      TriggerSocksError(ErrCode, E.ClassName + ' ' + E.Message);

    8896. 

  8896.                      InternalClose(TRUE, ErrCode);

    8897. 

  8897.                      Exit;

    8898. 

  8898.                 end;

    8899. 

  8899.             end;

    8900. 

  8900.         end;

    8901. 

  8901.         I := 8;

    8902. 

  8902.         if Length(FSocksUsercode) > 0 then begin

    8903. 

  8903.             { I'm not sure it has to be like that ! Should I also use the }

    8904. 

  8904.             { password or not ?                                           }

    8905. 

  8905.             for J := 1 to Length(FSocksUsercode) do begin

    8906. 

  8906.                 Buf[I] := Ord(FSocksUsercode[J]);

    8907. 

  8907.                 Inc(I);

    8908. 

  8908.             end;

    8909. 

  8909.         end;

    8910. 

  8910.         Buf[I] := 0;

    8911. 

  8911.         Inc(I);

    8912. 

  8912.         if FSocksLevel = '4A' then begin

    8913. 

  8913.             { We have to supply the destination host name                 }

    8914. 

  8914.             for J := 1 to Length(FAddrStr) do begin

    8915. 

  8915.                 Buf[I] := Ord(FaddrStr[J]);

    8916. 

  8916.                 Inc(I);

    8917. 

  8917.             end;

    8918. 

  8918.             Buf[I] := 0;   { Alon Gingold }

    8919. 

  8919.             Inc(I);        { Alon Gingold }

    8920. 

  8920.         end;

    8921. 

  8921.         { Buf[I] := #0;      Alon Gingold }

    8922. 

  8922.         { Inc(I);            Alon Gingold }

    8923. 

  8923.     end

    8924. 

  8924.     else begin

    8925. 

  8925.         SetLength(Buf, 128);

    8926. 

  8926.         Buf[0] := $05;            { Socks version }

    8927. 

  8927.         Buf[1] := $01;            { Connect command }

    8928. 

  8928.         Buf[2] := $00;            { Reserved, must be $00 }

    8929. 

  8929.         Buf[3] := $03;            { Address type is domain name }

    8930. 

  8930.         Buf[4] := Length(FAddrStr);

    8931. 

  8931.         { Should check buffer overflow }

    8932. 

  8932.         I := 5;

    8933. 

  8933.         for J := 1 to Length(FAddrStr) do begin

    8934. 

  8934.             Buf[I] := Ord(FaddrStr[J]);

    8935. 

  8935.             Inc(I);

    8936. 

  8936.         end;

    8937. 

  8937.         { Todo: Check the byte order ! }

    8938. 

  8938.         Buf[I] := (FPortNum shr 8) and 255;          { Port high byte  }

    8939. 

  8939.         Inc(I);

    8940. 

  8940.         Buf[I] := FPortNum and 255;                  { Port low byte   }

    8941. 

  8941.         Inc(I);

    8942. 

  8942.     end;

    8943. 

  8943. 

    8944. 

  8944.     try

    8945. 

  8945. {TriggerDisplay('Send = ''' + BufToStr(Buf, I + 2) + '''');}

    8946. 

  8946. //MessageBox(0, BufToStr(Buf, I), 'SocksDoConnect', MB_OK);

    8947. 

  8947.         Send(Buf, I);

    8948. 

  8948.     except

    8949. 

  8949.     end;

    8950. 

  8950. end;

    8951. 

  8951. {$ENDIF}

    8952. 

  8952. {$IFDEF WIN32}

    8953. 

  8953. type

    8954. 

  8954.     pu_long = ^u_long;

    8955. 

  8955. var

    8956. 

  8956.     Buf     : array [0..127] of AnsiChar;

    8957. 

  8957.     I       : Integer;

    8958. 

  8958.     ErrCode : Integer;

    8959. 

  8959. begin

    8960. 

  8960.     FSocksState := socksConnect;

    8961. 

  8961.     if FSocksLevel[1] = '4' then begin

    8962. 

  8962.         Buf[0] := #4;                                 { Version number  }

    8963. 

  8963.         Buf[1] := #1;                                 { Connect command }

    8964. 

  8964.         PWORD(@Buf[2])^  := WSocket_Synchronized_ntohs(FPortNum);  { Dest port       }

    8965. 

  8965.         if FSocksLevel = '4A' then

    8966. 

  8966.             { Conventional IP saying we can't convert the destination   }

    8967. 

  8967.             { host's domain name to find its IP address                 }

    8968. 

  8968.             { The destination must then follow the user ID              }

    8969. 

  8969.             pu_long(@Buf[4])^ := WSocket_Synchronized_inet_addr('0.0.0.1')

    8970. 

  8970.         else begin

    8971. 

  8971.             { With original SOCKS4, we have to supply the dest address  }

    8972. 

  8972.             try

    8973. 

  8973.                 pu_long(@Buf[4])^ := WSocket_Synchronized_ResolveHost(AnsiString(FAddrStr)).s_addr;

    8974. 

  8974.             except

    8975. 

  8975.                 on E:Exception do begin

    8976. 

  8976.                      ErrCode := socksHostResolutionFailed;

    8977. 

  8977.                      TriggerSocksError(ErrCode, E.ClassName + ' ' + E.Message);

    8978. 

  8978.                      InternalClose(TRUE, ErrCode);

    8979. 

  8979.                      Exit;

    8980. 

  8980.                 end;

    8981. 

  8981.             end;

    8982. 

  8982.         end;

    8983. 

  8983.         I := 8;

    8984. 

  8984.         if Length(FSocksUsercode) > 0 then begin

    8985. 

  8985.             { I'm not sure it has to be like that ! Should I also use the }

    8986. 

  8986.             { password or not ?                                           }

    8987. 

  8987.             Move(FSocksUsercode[1], Buf[I], Length(FSocksUsercode));

    8988. 

  8988.             I := I + Length(FSocksUsercode);

    8989. 

  8989.         end;

    8990. 

  8990.         Buf[I] := #0;

    8991. 

  8991.         Inc(I);

    8992. 

  8992.         if FSocksLevel = '4A' then begin

    8993. 

  8993.             { We have to supply the destination host name                 }

    8994. 

  8994.             Move(AnsiString(FAddrStr)[1], Buf[I], Length(FAddrStr));  // No length change expected (ASCII)

    8995. 

  8995.             I := I + Length(FAddrStr);

    8996. 

  8996.             Buf[I] := #0;  { Alon Gingold }

    8997. 

  8997.             Inc(I);        { Alon Gingold }

    8998. 

  8998.         end;

    8999. 

  8999.         { Buf[I] := #0;      Alon Gingold }

    9000. 

  9000.         { Inc(I);            Alon Gingold }

    9001. 

  9001.     end

    9002. 

  9002.     else begin

    9003. 

  9003.         Buf[0] := #$05;            { Socks version }

    9004. 

  9004.         Buf[1] := #$01;            { Connect command }

    9005. 

  9005.         Buf[2] := #$00;            { Reserved, must be $00 }

    9006. 

  9006.         Buf[3] := #$03;            { Address type is domain name }

    9007. 

  9007.         Buf[4] := AnsiChar((Length(FAddrStr)));

    9008. 

  9008.         { Should check buffer overflow }

    9009. 

  9009.         Move(AnsiString(FAddrStr)[1], Buf[5], Length(FAddrStr)); // No length change expected (ASCII)

    9010. 

  9010.         I := 5 + Length(FAddrStr);

    9011. 

  9011.         PWord(@Buf[I])^ := WSocket_Synchronized_htons(FPortNum);

    9012. 

  9012.         I := I + 2;

    9013. 

  9013.     end;

    9014. 

  9014. 

    9015. 

  9015.     try

    9016. 

  9016. {TriggerDisplay('Send = ''' + BufToStr(Buf, I + 2) + '''');}

    9017. 

  9017.         Send(@Buf, I);

    9018. 

  9018.     except

    9019. 

  9019.     end;

    9020. 

  9020. end;

    9021. 

  9021. {$ENDIF}

    9022. 

  9022. 

    9023. 

  9023. 

    9024. 

  9024. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    9025. 

  9025. procedure TCustomSocksWSocket.DataAvailableError(

    9026. 

  9026.     ErrCode : Integer;

    9027. 

  9027.     Msg     : String);

    9028. 

  9028. begin

    9029. 

  9029. {   TriggerSocksError(ErrCode, Msg); }

    9030. 

  9030. {   inherited TriggerSessionConnectedSpecial(ErrCode); }

    9031. 

  9031. {   InternalClose(TRUE, ErrCode); }

    9032. 

  9032.     TriggerSocksError(ErrCode, Msg);

    9033. 

  9033.     FSocksState := socksData;

    9034. 

  9034.     {**ALON** Added, so TriggerSessionConnectedSpecial will only call inherited}

    9035. 

  9035.     {inherited} TriggerSessionConnectedSpecial(ErrCode);

    9036. 

  9036.     {**ALON** removed 'inherited' now calls top level}

    9037. 

  9037.     InternalClose(TRUE, ErrCode);

    9038. 

  9038. end;

    9039. 

  9039. 

    9040. 

  9040. 

    9041. 

  9041. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    9042. 

  9042. function TCustomSocksWSocket.TriggerDataAvailable(Error : Word) : Boolean;

    9043. 

  9043. var

    9044. 

  9044.     Len     : Integer;

    9045. 

  9045.     I       : Integer;

    9046. 

  9046.     ErrCode : Word;

    9047. 

  9047.     ErrMsg  : String;

    9048. 

  9048.     InAddr  : TInAddr;

    9049. 

  9049.     AnsLen  : Integer;

    9050. 

  9050. {$IFDEF CLR}

    9051. 

  9051.     J       : Integer;

    9052. 

  9052.     Buf     : TBytes;

    9053. 

  9053. {$ENDIF}

    9054. 

  9054. begin

    9055. 

  9055.     if FSocksState = socksData then begin

    9056. 

  9056.         Result := inherited TriggerDataAvailable(Error);

    9057. 

  9057.         Exit;

    9058. 

  9058.     end;

    9059. 

  9059. 

    9060. 

  9060.     if Error <> 0 then begin

    9061. 

  9061.         DataAvailableError(Error, 'data receive error');

    9062. 

  9062.         Result := FALSE;

    9063. 

  9063.         Exit;

    9064. 

  9064.     end;

    9065. 

  9065. 

    9066. 

  9066. {$IFDEF CLR}

    9067. 

  9067.     if Length(FRcvBuf) <> 128 then

    9068. 

  9068.         SetLength(FRcvBuf, 128);

    9069. 

  9069.     if Length(Buf) <> 128 then

    9070. 

  9070.         SetLength(Buf, 128);

    9071. 

  9071. {$ENDIF}

    9072. 

  9072. 

    9073. 

  9073.     if FSocksState = socksNegociateMethods then begin

    9074. 

  9074.         Result := TRUE;

    9075. 

  9075. {$IFDEF CLR}

    9076. 

  9076.         Len := Receive(Buf, Length(Buf) - FRcvCnt - 1);

    9077. 

  9077.         if Len < 0 then

    9078. 

  9078.             Exit;

    9079. 

  9079.         for I := 0 to Len - 1 do begin

    9080. 

  9080.             FRcvBuf[FRcvCnt] := Buf[I];

    9081. 

  9081.             Inc(FRcvCnt);

    9082. 

  9082.         end;

    9083. 

  9083. {$ENDIF}

    9084. 

  9084. {$IFDEF WIN32}

    9085. 

  9085.         Len := Receive(@FRcvBuf[FRcvCnt], Sizeof(FRcvBuf) - FRcvCnt - 1);

    9086. 

  9086.         if Len < 0 then

    9087. 

  9087.             Exit;

    9088. 

  9088.         FRcvCnt := FRcvCnt + Len;

    9089. 

  9089. {$ENDIF}

    9090. 

  9090. {TriggerDisplay('socksNegociateMethods FrcvBuf = ''' + BufToStr(FRcvBuf, FRcvCnt) + '''');}

    9091. 

  9091.         if FSocksLevel[1] = '4' then begin

    9092. 

  9092.             { We should never comes here }

    9093. 

  9093.             DataAvailableError(socksProtocolError, 'TWSocket logic error');

    9094. 

  9094.             Exit;

    9095. 

  9095.         end

    9096. 

  9096.         else begin  { SOCKS5 }

    9097. 

  9097.             { We are waiting only two bytes }

    9098. 

  9098.             if FRcvCnt < 2 then

    9099. 

  9099.                 Exit;

    9100. 

  9100. {            if FRcvCnt <> 2 then begin  06/03/99}

    9101. 

  9101. {                DataAvailableError(socksProtocolError, 'too much data availaible');}

    9102. 

  9102. {                Exit;                                                              }

    9103. 

  9103. {            end;                                                                   }

    9104. 

  9104.             FRcvCnt := 0; { Clear receive counter }

    9105. 

  9105.             if FRcvBuf[0] <> $05 then begin

    9106. 

  9106.                 DataAvailableError(socksVersionError, 'socks version error');

    9107. 

  9107.                 Exit;

    9108. 

  9108.             end;

    9109. 

  9109.             if FRcvBuf[1] = $00 then begin

    9110. 

  9110.                 { No authentication required }

    9111. 

  9111.                 if FSocksAuthNumber <> #$00 then

    9112. 

  9112.                     { We asked for authentification, so complains... }

    9113. 

  9113.                     TriggerSocksAuthState(socksAuthNotRequired);

    9114. 

  9114.             end

    9115. 

  9115.             else if FRcvBuf[1] = $02 then begin

    9116. 

  9116.                 { Usercode/Password authentication required }

    9117. 

  9117.                 SocksDoAuthenticate;

    9118. 

  9118.                 Exit;

    9119. 

  9119.             end

    9120. 

  9120.             else begin

    9121. 

  9121.                 DataAvailableError(socksAuthMethodError, 'authentification method not acceptable');

    9122. 

  9122.                 Exit;

    9123. 

  9123.             end;

    9124. 

  9124.             SocksDoConnect;

    9125. 

  9125.         end;

    9126. 

  9126.     end

    9127. 

  9127.     else if FSocksState = socksConnect then begin

    9128. 

  9128.         Result := TRUE;

    9129. 

  9129. {TriggerDisplay('socksConnect FrcvBuf = ''' + BufToStr(FRcvBuf, FRcvCnt) + '''');}

    9130. 

  9130.         if FSocksLevel[1] = '4' then begin

    9131. 

  9131.             { We wants at most 8 characters }

    9132. 

  9132. {$IFDEF CLR}

    9133. 

  9133.             Len := Receive(Buf, 8 - FRcvCnt);

    9134. 

  9134.             if Len < 0 then

    9135. 

  9135.                 Exit;

    9136. 

  9136.             for I := 0 to Len - 1 do begin

    9137. 

  9137.                 FRcvBuf[FRcvCnt] := Buf[I];

    9138. 

  9138.                 Inc(FRcvCnt);

    9139. 

  9139.             end;

    9140. 

  9140. {$ENDIF}

    9141. 

  9141. {$IFDEF WIN32}

    9142. 

  9142.             Len := Receive(@FRcvBuf[FRcvCnt], 8 - FRcvCnt);

    9143. 

  9143.             if Len < 0 then

    9144. 

  9144.                 Exit;

    9145. 

  9145.             FRcvCnt := FRcvCnt + Len;

    9146. 

  9146. {$ENDIF}

    9147. 

  9147.             { We are waiting for 8 bytes }

    9148. 

  9148.             if FRcvCnt < 8 then

    9149. 

  9149.                 Exit;

    9150. 

  9150.             FRcvCnt := 0; { Clear receive counter }

    9151. 

  9151.             if FRcvBuf[0] <> 0 then begin

    9152. 

  9152.                 DataAvailableError(socksVersionError, 'socks version error');

    9153. 

  9153.                 Exit;

    9154. 

  9154.             end;

    9155. 

  9155.             if FRcvBuf[1] <> 90 then begin  { david.brock }

    9156. 

  9156.                 case FRcvBuf[1] of

    9157. 

  9157.                 91: ErrCode := socksRejectedOrFailed;

    9158. 

  9158.                 92: ErrCode := socksConnectionRefused;

    9159. 

  9159.                 93: ErrCode := socksAuthenticationFailed;

    9160. 

  9160.                 else

    9161. 

  9161.                    ErrCode := socksUnassignedError;

    9162. 

  9162.                 end;

    9163. 

  9163.                 case ErrCode of

    9164. 

  9164.                 socksRejectedOrFailed :

    9165. 

  9165.                     ErrMsg := 'request rejected or failed';

    9166. 

  9166.                 socksConnectionRefused :

    9167. 

  9167.                     ErrMsg := 'connection refused';

    9168. 

  9168.                 socksAuthenticationFailed :

    9169. 

  9169.                     ErrMsg := 'authentification failed';

    9170. 

  9170.                 else

    9171. 

  9171.                     ErrMsg := 'unassigned error #' + _IntToStr(Ord(FRcvBuf[1]));

    9172. 

  9172.                 end;

    9173. 

  9173.                 DataAvailableError(ErrCode, ErrMsg);

    9174. 

  9174.                 Exit;

    9175. 

  9175.             end;

    9176. 

  9176.             FSocksState := socksData;

    9177. 

  9177. {           inherited TriggerSessionConnectedSpecial(0); }

    9178. 

  9178. {           Result := inherited TriggerDataAvailable(0); }

    9179. 

  9179.             {inherited} TriggerSessionConnectedSpecial(0);

    9180. 

  9180.             {**ALON** removed 'inherited' now calls top level}

    9181. 

  9181.             Result := {inherited} TriggerDataAvailable(0);

    9182. 

  9182.             {**ALON** removed 'inherited' now calls top level}

    9183. 

  9183.         end

    9184. 

  9184.         else begin { SOCKS5 }

    9185. 

  9185.             {$IFDEF CLR}

    9186. 

  9186.             Len := Receive(Buf, Length(Buf) - FRcvCnt - 1);

    9187. 

  9187.             if Len < 0 then

    9188. 

  9188.                 Exit;

    9189. 

  9189.             for I := 0 to Len - 1 do begin

    9190. 

  9190.                 FRcvBuf[FRcvCnt] := Buf[I];

    9191. 

  9191.                 Inc(FRcvCnt);

    9192. 

  9192.             end;

    9193. 

  9193.             {$ENDIF}

    9194. 

  9194.             {$IFDEF WIN32}

    9195. 

  9195.             Len := Receive(@FRcvBuf[FRcvCnt], Sizeof(FRcvBuf) - FRcvCnt - 1);

    9196. 

  9196.             if Len < 0 then

    9197. 

  9197.                 Exit;

    9198. 

  9198.             FRcvCnt := FRcvCnt + Len;

    9199. 

  9199.             {$ENDIF}

    9200. 

  9200.             if FRcvCnt >= 1 then begin

    9201. 

  9201.                 { First byte is version, we expect version 5 }

    9202. 

  9202.                 if FRcvBuf[0] <> $05 then begin

    9203. 

  9203.                     DataAvailableError(socksVersionError, 'socks version error');

    9204. 

  9204.                     Exit;

    9205. 

  9205.                 end;

    9206. 

  9206.             end;

    9207. 

  9207.             if FRcvCnt >= 2 then begin

    9208. 

  9208.                 if FRcvBuf[1] <> $00 then begin

    9209. 

  9209.                     case FRcvBuf[1] of

    9210. 

  9210.                     1: ErrCode := socksGeneralFailure;

    9211. 

  9211.                     2: ErrCode := socksConnectionNotAllowed;

    9212. 

  9212.                     3: ErrCode := socksNetworkUnreachable;

    9213. 

  9213.                     4: ErrCode := socksHostUnreachable;

    9214. 

  9214.                     5: ErrCode := socksConnectionRefused;

    9215. 

  9215.                     6: ErrCode := socksTtlExpired;

    9216. 

  9216.                     7: ErrCode := socksUnknownCommand;

    9217. 

  9217.                     8: ErrCode := socksUnknownAddressType;

    9218. 

  9218.                     else

    9219. 

  9219.                        ErrCode := socksUnassignedError;

    9220. 

  9220.                     end;

    9221. 

  9221.                     case ErrCode of

    9222. 

  9222.                     socksGeneralFailure :

    9223. 

  9223.                         ErrMsg := 'general SOCKS server failure';

    9224. 

  9224.                     socksConnectionNotAllowed :

    9225. 

  9225.                         ErrMsg := 'connection not allowed by ruleset';

    9226. 

  9226.                     socksNetworkUnreachable :

    9227. 

  9227.                         ErrMsg := 'network unreachable';

    9228. 

  9228.                     socksHostUnreachable :

    9229. 

  9229.                         ErrMsg := 'host unreachable';

    9230. 

  9230.                     socksConnectionRefused :

    9231. 

  9231.                         ErrMsg := 'connection refused';

    9232. 

  9232.                     socksTtlExpired :

    9233. 

  9233.                         ErrMsg := 'time to live expired';

    9234. 

  9234.                     socksUnknownCommand :

    9235. 

  9235.                         ErrMsg := 'command not supported';

    9236. 

  9236.                     socksUnknownAddressType :

    9237. 

  9237.                         ErrMsg := 'address type not supported';

    9238. 

  9238.                     else

    9239. 

  9239.                         ErrMsg := 'unassigned error #' + _IntToStr(Ord(FRcvBuf[1]));

    9240. 

  9240.                     end;

    9241. 

  9241.                     DataAvailableError(ErrCode, ErrMsg);

    9242. 

  9242.                     Exit;

    9243. 

  9243.                 end;

    9244. 

  9244.             end;

    9245. 

  9245.             if FRcvCnt < 5 then

    9246. 

  9246.                 Exit;

    9247. 

  9247. 

    9248. 

  9248.             { We have enough data to learn the answer length }

    9249. 

  9249.             if FRcvBuf[3] = $01 then

    9250. 

  9250.                 AnsLen := 10                     { IP V4 address }

    9251. 

  9251.             else if FRcvBuf[3] = $03 then

    9252. 

  9252.                 AnsLen := 7 + Ord(FRcvBuf[4])    { Domain name   }

    9253. 

  9253.             else

    9254. 

  9254.                 AnsLen := 5;                     { Other unsupported }

    9255. 

  9255. 

    9256. 

  9256.             if FRcvCnt < AnsLen then

    9257. 

  9257.                 Exit;

    9258. 

  9258. 

    9259. 

  9259.             if FRcvBuf[3] = $01 then begin

    9260. 

  9260.                 { IP V4 address }

    9261. 

  9261.                 //Move(FRcvBuf[4], InAddr, 4);

    9262. 

  9262.                 InAddr.S_addr := FRcvBuf[4] or

    9263. 

  9263.                                  (FRcvBuf[5] shl 8) or

    9264. 

  9264.                                  (FRcvBuf[6] shl 16) or

    9265. 

  9265.                                  (FRcvBuf[7] shl 24);

    9266. 

  9266.                 FBoundAddr := WSocket_Synchronized_inet_ntoa(InAddr);

    9267. 

  9267.                 I := 4 + 4;

    9268. 

  9268.             end

    9269. 

  9269.             else if FRcvBuf[3] = $03 then begin

    9270. 

  9270.                 { Domain name }

    9271. 

  9271.                 SetLength(FBoundAddr, Ord(FRcvBuf[4]));

    9272. 

  9272.                 {$IFDEF CLR}

    9273. 

  9273.                 for J := 1 to Ord(FRcvBuf[4]) do

    9274. 

  9274.                     FBoundAddr[J] := Char(FRcvBuf[4 + J]);

    9275. 

  9275.                 {$ENDIF}

    9276. 

  9276.                 {$IFDEF WIN32}

    9277. 

  9277.                 Move(FRcvBuf[5], FBoundAddr[1], Length(FBoundAddr)); { david.brock }

    9278. 

  9278.                 {$ENDIF}

    9279. 

  9279.                 I := 4 + Ord(FRcvBuf[4]) + 1;

    9280. 

  9280.             end

    9281. 

  9281.             else begin

    9282. 

  9282.                 { Unsupported address type }

    9283. 

  9283.                 DataAvailableError(socksUnknownAddressType, 'address type not supported');

    9284. 

  9284.                 Exit;

    9285. 

  9285.             end;

    9286. 

  9286. 

    9287. 

  9287.             FBoundPort  := IcsIntToStrA(WSocket_Synchronized_ntohs(

    9288. 

  9288.                                         FRcvBuf[I] or (FRcvBuf[I + 1] shl 8)));

    9289. 

  9289.             I           := I + 2;

    9290. 

  9290.             FSocksState := socksData;

    9291. 

  9291. {           inherited TriggerSessionConnectedSpecial(0); }

    9292. 

  9292. { if IsConsole then WriteLn('SOCKS5 NEGOCIATION OK');}

    9293. 

  9293.             {inherited} TriggerSessionConnectedSpecial(0);

    9294. 

  9294.             {**ALON** removed 'inherited' now calls top level}

    9295. 

  9295.             FSocksRcvdCnt := FRcvCnt - I;

    9296. 

  9296.             if FSocksRcvdCnt < 0 then

    9297. 

  9297.                 FSocksRcvdCnt := 0

    9298. 

  9298.             else

    9299. 

  9299.                 FSocksRcvdPtr := I; //@FRcvBuf[I];

    9300. 

  9300. {           Result := inherited TriggerDataAvailable(0);}

    9301. 

  9301.             Result := {inherited} TriggerDataAvailable(0);

    9302. 

  9302.             {**ALON** removed 'inherited' now calls top level}

    9303. 

  9303.         end;

    9304. 

  9304.     end

    9305. 

  9305.     else if FSocksState = socksAuthenticate then begin

    9306. 

  9306.         Result := TRUE;

    9307. 

  9307.         {$IFDEF CLR}

    9308. 

  9308.         Len := Receive(Buf, Length(Buf) - FRcvCnt - 1);

    9309. 

  9309.         if Len < 0 then

    9310. 

  9310.             Exit;

    9311. 

  9311.         for I := 0 to Len - 1 do begin

    9312. 

  9312.             FRcvBuf[FRcvCnt] := Buf[I];

    9313. 

  9313.             Inc(FRcvCnt);

    9314. 

  9314.         end;

    9315. 

  9315.         {$ENDIF}

    9316. 

  9316.         {$IFDEF WIN32}

    9317. 

  9317.         Len := Receive(@FRcvBuf[FRcvCnt], Sizeof(FRcvBuf) - FRcvCnt - 1);

    9318. 

  9318.         if Len < 0 then

    9319. 

  9319.             Exit;

    9320. 

  9320.         FRcvCnt := FRcvCnt + Len;

    9321. 

  9321.         {$ENDIF}

    9322. 

  9322. {TriggerDisplay('socksAuthenticate FrcvBuf = ''' + BufToStr(FRcvBuf, FRcvCnt) + '''');}

    9323. 

  9323.         if FRcvCnt >= 1 then begin

    9324. 

  9324.             { First byte is version, we expect version 5 }

    9325. 

  9325.             if FRcvBuf[0] <> $01 then begin { 06/03/99 }

    9326. 

  9326. {                TriggerSocksAuthState(socksAuthFailure); Burlakov 12/11/99 }

    9327. 

  9327.                 DataAvailableError(socksVersionError, 'socks version error');

    9328. 

  9328.                 Exit;

    9329. 

  9329.             end;

    9330. 

  9330.         end;

    9331. 

  9331.         if FRcvCnt = 2 then begin

    9332. 

  9332.             { Second byte is status }

    9333. 

  9333.             if FRcvBuf[1] <> $00 then begin

    9334. 

  9334. {                TriggerSocksAuthState(socksAuthFailure); Burlakov 12/11/99 }

    9335. 

  9335.                 DataAvailableError(socksAuthenticationFailed, 'socks authentication failed');

    9336. 

  9336.                 Exit;

    9337. 

  9337.             end;

    9338. 

  9338.         end

    9339. 

  9339.         else if FRcvCnt > 2 then begin

    9340. 

  9340. {            TriggerSocksAuthState(socksAuthFailure); Burlakov 12/11/99 }

    9341. 

  9341.             DataAvailableError(socksProtocolError, 'too much data availaible');

    9342. 

  9342.             Exit;

    9343. 

  9343.         end;

    9344. 

  9344.         FRcvCnt := 0; { 06/03/99 }

    9345. 

  9345.         TriggerSocksAuthState(socksAuthSuccess);

    9346. 

  9346.         SocksDoConnect;

    9347. 

  9347.     end

    9348. 

  9348.     else begin

    9349. 

  9349.         { We should never comes here ! }

    9350. 

  9350.         DataAvailableError(socksInternalError, 'internal error');

    9351. 

  9351.         Result := FALSE;

    9352. 

  9352.     end;

    9353. 

  9353. end;

    9354. 

  9354. 

    9355. 

  9355. 

    9356. 

  9356. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    9357. 

  9357. function TCustomSocksWSocket.GetRcvdCount : LongInt;

    9358. 

  9358. begin

    9359. 

  9359.     if FSocksRcvdCnt <= 0 then

    9360. 

  9360.         Result := inherited GetRcvdCount

    9361. 

  9361.     else

    9362. 

  9362.         Result := FSocksRcvdCnt;

    9363. 

  9363. end;

    9364. 

  9364. 

    9365. 

  9365. 

    9366. 

  9366. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    9367. 

  9367. function TCustomSocksWSocket.DoRecv(

    9368. 

  9368.     var Buffer : TWSocketData;

    9369. 

  9369.     BufferSize : Integer;

    9370. 

  9370.     Flags      : Integer) : Integer;

    9371. 

  9371. {$IFDEF CLR}

    9372. 

  9372. var

    9373. 

  9373.     I : Integer;

    9374. 

  9374. {$ENDIF}

    9375. 

  9375. begin

    9376. 

  9376.     if FSocksRcvdCnt <= 0 then begin

    9377. 

  9377.         Result := inherited DoRecv(Buffer, BufferSize, Flags);

    9378. 

  9378.         Exit;

    9379. 

  9379.     end;

    9380. 

  9380.     { We already have received data into our internal buffer }

    9381. 

  9381.     if FSocksRcvdCnt <= BufferSize then begin

    9382. 

  9382.         { User buffer is greater than received data, copy all and clear }

    9383. 

  9383.         {$IFDEF CLR}

    9384. 

  9384.         for I := 0 to FSocksRcvdCnt - 1 do

    9385. 

  9385.             Buffer[I] := FRcvBuf[FSocksRcvdPtr + I];

    9386. 

  9386.         {$ENDIF}

    9387. 

  9387.         {$IFDEF WIN32}

    9388. 

  9388.         Move(FRcvBuf[FSocksRcvdPtr], Buffer^, FSocksRcvdCnt); { V7.33 }

    9389. 

  9389.         {$ENDIF}

    9390. 

  9390.         Result        := FSocksRcvdCnt;

    9391. 

  9391.         FSocksRcvdCnt := 0;

    9392. 

  9392.         Exit;

    9393. 

  9393.     end;

    9394. 

  9394.     { User buffer is smaller, copy as much as possible }

    9395. 

  9395.     {$IFDEF CLR}

    9396. 

  9396.     for I := 0 to BufferSize - 1 do

    9397. 

  9397.         Buffer[I] := FRcvBuf[FSocksRcvdPtr + I];

    9398. 

  9398.     {$ENDIF}

    9399. 

  9399.     {$IFDEF WIN32}

    9400. 

  9400.     Move(FRcvBuf[FSocksRcvdPtr], Buffer^, BufferSize); { V7.33 }

    9401. 

  9401.     {$ENDIF}

    9402. 

  9402.     Result        := BufferSize;

    9403. 

  9403.     FSocksRcvdPtr := FSocksRcvdPtr + BufferSize;

    9404. 

  9404.     FSocksRcvdCnt := FSocksRcvdCnt - BufferSize;

    9405. 

  9405. end;

    9406. 

  9406. 

    9407. 

  9407. 

    9408. 

  9408. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

    9409. 

  9409. 

    9410. 

  9410.               X          X     X       X      X X X X

    9411. 

  9411.               X          X     X X     X      X

    9412. 

  9412.               X          X     X   X   X      X

    9413. 

  9413.               X          X     X     X X      X X X

    9414. 

  9414.               X          X     X       X      X

    9415. 

  9415.               X          X     X       X      X

    9416. 

  9416.               X X X X    X     X       X      X X X X

    9417. 

  9417. 

    9418. 

  9418.  * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    9419. 

  9419. constructor TCustomLineWSocket.Create{$IFDEF VCL}(AOwner: TComponent){$ENDIF};

    9420. 

  9420. begin

    9421. 

  9421.     inherited Create{$IFDEF VCL}(AOwner){$ENDIF};

    9422. 

  9422.     FLineEnd   := #13#10;

    9423. 

  9423.     FLineMode  := FALSE;

    9424. 

  9424.     FLineEdit  := FALSE;  { AG 2/12/07}

    9425. 

  9425.     FLineLimit := 65536;  { Arbitrary line limit }

    9426. 

  9426. end;

    9427. 

  9427. 

    9428. 

  9428. 

    9429. 

  9429. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    9430. 

  9430. destructor TCustomLineWSocket.Destroy;

    9431. 

  9431. begin

    9432. 

  9432.     if FRcvdPtr <> nil then begin

    9433. 

  9433.         {$IFDEF CLR}

    9434. 

  9434.         SetLength(FRcvdPtr, 0);

    9435. 

  9435.         {$ENDIF}

    9436. 

  9436.         {$IFDEF WIN32}

    9437. 

  9437.         FreeMem(FRcvdPtr, FRcvBufSize);

    9438. 

  9438.         FRcvdPtr     := nil;

    9439. 

  9439.         {$ENDIF}

    9440. 

  9440.         FRcvBufSize := 0;

    9441. 

  9441.     end;

    9442. 

  9442.     inherited Destroy;

    9443. 

  9443. end;

    9444. 

  9444. 

    9445. 

  9445. 

    9446. 

  9446. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    9447. 

  9447. procedure TCustomLineWSocket.WndProc(var MsgRec: TMessage);

    9448. 

  9448. begin

    9449. 

  9449.     with MsgRec do begin

    9450. 

  9450.         if Msg = FMsg_WM_TRIGGER_DATA_AVAILABLE then begin

    9451. 

  9451.             { We *MUST* handle all exception to avoid application shutdown }

    9452. 

  9452.             try

    9453. 

  9453.                 WMTriggerDataAvailable(MsgRec)

    9454. 

  9454.             except

    9455. 

  9455.                 on E:Exception do

    9456. 

  9456.                     HandleBackGroundException(E);

    9457. 

  9457.             end;

    9458. 

  9458.         end

    9459. 

  9459.         else

    9460. 

  9460.             inherited WndProc(MsgRec);

    9461. 

  9461.     end;

    9462. 

  9462. end;

    9463. 

  9463. 

    9464. 

  9464. 

    9465. 

  9465. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    9466. 

  9466. procedure TCustomLineWSocket.WMTriggerDataAvailable(var msg: TMessage);

    9467. 

  9467. var

    9468. 

  9468.     Count : Integer;

    9469. 

  9469. begin

    9470. 

  9470. {$IFDEF OLD_20040117}

    9471. 

  9471.     while FRcvdCnt > 0 do

    9472. 

  9472.         TriggerDataAvailable(0);

    9473. 

  9473. {$ELSE}

    9474. 

  9474.     Count := 0;

    9475. 

  9475.     while FRcvdCnt > 0 do begin

    9476. 

  9476.         Inc(Count);

    9477. 

  9477.         FLineFound := FALSE;

    9478. 

  9478.         TriggerDataAvailable(0);

    9479. 

  9479.         if (FRcvdCnt <= 0) or

    9480. 

  9480.            (FLineMode and (Count > 3) and (not FLineFound)) then

    9481. 

  9481.             Break;

    9482. 

  9482.     end;

    9483. 

  9483. {$ENDIF}

    9484. 

  9484. end;

    9485. 

  9485. 

    9486. 

  9486. 

    9487. 

  9487. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    9488. 

  9488. procedure TCustomLineWSocket.SetLineMode(newValue : Boolean);

    9489. 

  9489. begin

    9490. 

  9490.     if FLineMode = newValue then

    9491. 

  9491.         Exit;

    9492. 

  9492.     FLineMode := newValue;

    9493. 

  9493.     if (FRcvdCnt > 0) or (FLineLength > 0) then

    9494. 

  9494.         _PostMessage(Handle, FMsg_WM_TRIGGER_DATA_AVAILABLE, 0, 0);

    9495. 

  9495. end;

    9496. 

  9496. 

    9497. 

  9497. 

    9498. 

  9498. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    9499. 

  9499. {$IFDEF COMPILER12_UP}

    9500. 

  9500. { Returns -1 on error only if event OnError is assigned, otherwise an       }

    9501. 

  9501. { ESocketException may be raised. Returns the number of bytes written on    }

    9502. 

  9502. { success. LineEnd is treated as a raw sequence of bytes, hence it's not    }

    9503. 

  9503. { converted but sent as is.                                                 }

    9504. 

  9504. function TCustomLineWSocket.SendLine(

    9505. 

  9505.     const Str : UnicodeString;

    9506. 

  9506.     ACodePage : LongWord) : Integer;

    9507. 

  9507. begin

    9508. 

  9508.     Result := PutStringInSendBuffer(Str, ACodePage);

    9509. 

  9509.     if Result > 0 then begin

    9510. 

  9510.         if SendStr(LineEnd) > -1 then

    9511. 

  9511.             Inc(Result, Length(LineEnd))

    9512. 

  9512.         else

    9513. 

  9513.             Result := -1;

    9514. 

  9514.     end;

    9515. 

  9515. end;

    9516. 

  9516. 

    9517. 

  9517. 

    9518. 

  9518. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    9519. 

  9519. function TCustomLineWSocket.SendLine(const Str : UnicodeString) : Integer;

    9520. 

  9520. begin

    9521. 

  9521.     Result := PutStringInSendBuffer(Str);

    9522. 

  9522.     if Result > 0 then begin

    9523. 

  9523.         if SendStr(LineEnd) > -1 then

    9524. 

  9524.             Inc(Result, Length(LineEnd))

    9525. 

  9525.         else

    9526. 

  9526.             Result := -1;

    9527. 

  9527.     end;

    9528. 

  9528. end;

    9529. 

  9529. {$ENDIF}

    9530. 

  9530. 

    9531. 

  9531. 

    9532. 

  9532. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    9533. 

  9533. { Returns -1 on error only if event OnError is assigned, otherwise an       }

    9534. 

  9534. { ESocketException may be raised. Returns the number of bytes written on    }

    9535. 

  9535. { success.                                                                  }

    9536. 

  9536. function TCustomLineWSocket.SendLine(const Str : RawByteString) : Integer;

    9537. 

  9537. begin

    9538. 

  9538.     Result := PutStringInSendBuffer(Str);

    9539. 

  9539.     if Result > 0 then begin

    9540. 

  9540.         if SendStr(LineEnd) > -1 then

    9541. 

  9541.             Inc(Result, Length(LineEnd))

    9542. 

  9542.         else

    9543. 

  9543.             Result := -1;

    9544. 

  9544.     end;

    9545. 

  9545. end;

    9546. 

  9546. 

    9547. 

  9547. 

    9548. 

  9548. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    9549. 

  9549. function TCustomLineWSocket.GetRcvdCount : LongInt;

    9550. 

  9550. begin

    9551. 

  9551.     if not FLineMode then

    9552. 

  9552.         Result := inherited GetRcvdCount

    9553. 

  9553.     else

    9554. 

  9554.         Result := FLineLength;

    9555. 

  9555. end;

    9556. 

  9556. 

    9557. 

  9557. 

    9558. 

  9558. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    9559. 

  9559. function TCustomLineWSocket.DoRecv(

    9560. 

  9560.     var Buffer : TWSocketData;

    9561. 

  9561.     BufferSize : Integer;

    9562. 

  9562.     Flags      : Integer) : Integer;

    9563. 

  9563. {$IFDEF CLR}

    9564. 

  9564. var

    9565. 

  9565.     I : Integer;

    9566. 

  9566. {$ENDIF}

    9567. 

  9567. begin

    9568. 

  9568.     if FLineMode and (FLineLength > 0) then begin

    9569. 

  9569.         { We are in line mode and a line is received }

    9570. 

  9570.         if FLineLength <= BufferSize then begin

    9571. 

  9571.             { User buffer is greater than received data, copy all and clear }

    9572. 

  9572.             {$IFDEF CLR}

    9573. 

  9573.             System.Buffer.BlockCopy(FRcvdPtr, 0, Buffer, 0, FLineLength);

    9574. 

  9574.             //for I := 0 to FLineLength - 1 do

    9575. 

  9575.             //    Buffer[I] := FRcvdPtr[I];

    9576. 

  9576.             {$ENDIF}

    9577. 

  9577.             {$IFDEF WIN32}

    9578. 

  9578.             Move(FRcvdPtr^, Buffer^, FLineLength);

    9579. 

  9579.             {$ENDIF}

    9580. 

  9580.             Result      := FLineLength;

    9581. 

  9581.             FLineLength := 0;

    9582. 

  9582.             Exit;

    9583. 

  9583.         end;

    9584. 

  9584.         { User buffer is smaller, copy as much as possible }

    9585. 

  9585.         {$IFDEF CLR}

    9586. 

  9586.         for I := 0 to BufferSize - 1 do

    9587. 

  9587.             Buffer[I] := FRcvdPtr[I];

    9588. 

  9588.         { Move the end of line to beginning of buffer to be read the next time }

    9589. 

  9589.         for I := 0 to FLineLength - BufferSize - 1 do

    9590. 

  9590.             FRcvdPtr[I] := FRcvdPtr[BufferSize + I];

    9591. 

  9591.         {$ENDIF}

    9592. 

  9592.         {$IFDEF WIN32}

    9593. 

  9593.         Move(FRcvdPtr^, Buffer^, BufferSize);

    9594. 

  9594.         { Move the end of line to beginning of buffer to be read the next time }

    9595. 

  9595.         Move(PAnsiChar(FRcvdPtr)[BufferSize], FRcvdPtr^, FLineLength - BufferSize);

    9596. 

  9596.         {$ENDIF}

    9597. 

  9597.         Result      := BufferSize;

    9598. 

  9598.         FLineLength := FLineLength - BufferSize;

    9599. 

  9599.         Exit;

    9600. 

  9600.     end;

    9601. 

  9601. 

    9602. 

  9602.     if FLineMode or (FRcvdCnt <= 0) then begin

    9603. 

  9603.         { There is nothing in our internal buffer }

    9604. 

  9604.         Result := inherited DoRecv(Buffer, BufferSize, Flags);

    9605. 

  9605.         Exit;

    9606. 

  9606.     end;

    9607. 

  9607. 

    9608. 

  9608.     { We already have received data into our internal buffer }

    9609. 

  9609.     if FRcvdCnt <= BufferSize then begin

    9610. 

  9610.         { User buffer is greater than received data, copy all and clear }

    9611. 

  9611.         {$IFDEF CLR}

    9612. 

  9612.         for I := 0 to FRcvdCnt - 1 do

    9613. 

  9613.             Buffer[I] := FRcvdPtr[I];

    9614. 

  9614.         {$ENDIF}

    9615. 

  9615.         {$IFDEF WIN32}

    9616. 

  9616.         Move(FRcvdPtr^, Buffer^, FRcvdCnt);

    9617. 

  9617.         {$ENDIF}

    9618. 

  9618.         Result   := FRcvdCnt;

    9619. 

  9619.         FRcvdCnt := 0;

    9620. 

  9620.         Exit;

    9621. 

  9621.     end;

    9622. 

  9622.     {$IFDEF CLR}

    9623. 

  9623.     { User buffer is smaller, copy as much as possible }

    9624. 

  9624.     for I := 0 to BufferSize - 1 do

    9625. 

  9625.         Buffer[I] := FRcvdPtr[I];

    9626. 

  9626.     { Then move remaining data to front of buffer  16/10/99 }

    9627. 

  9627.     for I := 0 to FRcvdCnt - BufferSize do

    9628. 

  9628.         FRcvdPtr[I] := FRcvdPtr[BufferSize + I];

    9629. 

  9629.     {$ENDIF}

    9630. 

  9630.     {$IFDEF WIN32}

    9631. 

  9631.     { User buffer is smaller, copy as much as possible }

    9632. 

  9632.     Move(FRcvdPtr^, Buffer^, BufferSize);

    9633. 

  9633.     { Then move remaining data to front og buffer  16/10/99 }

    9634. 

  9634.     Move(PAnsiChar(FRcvdPtr)[BufferSize], FRcvdPtr^, FRcvdCnt - BufferSize + 1);  

    9635. 

  9635.     {$ENDIF}

    9636. 

  9636.     Result   := BufferSize;

    9637. 

  9637.     FRcvdCnt := FRcvdCnt - BufferSize;

    9638. 

  9638. end;

    9639. 

  9639. 

    9640. 

  9640. 

    9641. 

  9641. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    9642. 

  9642. { Edit received data. Handle TAB and BACKSPACE characters.                  }

    9643. 

  9643. { A data packet has been received into FRcvPtr buffer, starting from        }

    9644. 

  9644. { FRcvdCnt offset. Packet size if passed as the Len argument.               }

    9645. 

  9645. procedure TCustomLineWSocket.EditLine(var Len : Integer);

    9646. 

  9646. {$IFDEF CLR}

    9647. 

  9647. var

    9648. 

  9648.     Buf     : TBytes;

    9649. 

  9649.     BufSize : LongInt;

    9650. 

  9650.     I       : LongInt;

    9651. 

  9651.     J       : LongInt;

    9652. 

  9652.     K       : Integer;

    9653. 

  9653.     Edited  : Boolean;

    9654. 

  9654.     NewCnt  : LongInt;

    9655. 

  9655.     NewSize : LongInt;

    9656. 

  9656. const

    9657. 

  9657.     BackString : String = #8 + ' ' + #8;

    9658. 

  9658. begin

    9659. 

  9659.     BufSize := 0;

    9660. 

  9660.     try

    9661. 

  9661.         Edited := FALSE;

    9662. 

  9662.         I      := FRcvdCnt;

    9663. 

  9663.         J      := FRcvdCnt;

    9664. 

  9664.         NewCnt := FRcvdCnt;

    9665. 

  9665.         { Loop to process all received char }

    9666. 

  9666.         while I < (FRcvdCnt + Len) do begin

    9667. 

  9667.             if FRcvdPtr[I] = 8 then begin   { BACKSPACE character }

    9668. 

  9668.                 if FLineEcho and (J > 0) then

    9669. 

  9669.                     SendStr(BackString);

    9670. 

  9670.                 if not Edited then begin

    9671. 

  9671.                     { Not edited yet, so we allocate a buffer to store }

    9672. 

  9672.                     { edited data and we remember we edited data.      }

    9673. 

  9673.                     Edited := TRUE;

    9674. 

  9674.                     { Compute buffer size as a multiple of 256 bytes   }

    9675. 

  9675.                     BufSize := ((FRcvdCnt + Len + 256) shr 8) shl 8;

    9676. 

  9676.                     SetLength(Buf, BufSize);

    9677. 

  9677.                     { Copy data already processed }

    9678. 

  9678.                     for K := 0 to I - 1 do

    9679. 

  9679.                         Buf[K] := FRcvdPtr[K];

    9680. 

  9680.                 end;

    9681. 

  9681.                 if J > 0 then begin

    9682. 

  9682.                     Dec(J);

    9683. 

  9683.                     if J < NewCnt then

    9684. 

  9684.                         NewCnt := J;

    9685. 

  9685.                 end;

    9686. 

  9686.                 Inc(I);

    9687. 

  9687.             end

    9688. 

  9688.             else if FRcvdPtr[I] = 9 then begin  { TAB character }

    9689. 

  9689.                 if not Edited then begin

    9690. 

  9690.                     { Not edited yet, so we allocate a buffer to store }

    9691. 

  9691.                     { edited data and we remember we edited data.      }

    9692. 

  9692.                     Edited := TRUE;

    9693. 

  9693.                     { Compute buffer size as a multiple of 256 bytes   }

    9694. 

  9694.                     BufSize := ((FRcvdCnt + Len + 256) shr 8) shl 8;

    9695. 

  9695.                     SetLength(Buf, BufSize);

    9696. 

  9696.                     { Copy data already processed }

    9697. 

  9697.                     for K := 0 to I - 1 do

    9698. 

  9698.                         Buf[K] := FRcvdPtr[K];

    9699. 

  9699.                 end;

    9700. 

  9700.                 repeat

    9701. 

  9701.                     if FLineEcho then

    9702. 

  9702.                         SendStr(' ');

    9703. 

  9703.                     Buf[J] := Ord(' ');

    9704. 

  9704.                     Inc(J);

    9705. 

  9705.                 until (J and 7) = 0;

    9706. 

  9706.                 Inc(I);

    9707. 

  9707.             end

    9708. 

  9708.             else begin

    9709. 

  9709.                 if FLineEcho then

    9710. 

  9710.                     Send(FRcvdPtr[I]);

    9711. 

  9711.                 if Edited then begin

    9712. 

  9712.                     if J >= BufSize then begin

    9713. 

  9713.                         { Need to allocate more buffer space }

    9714. 

  9714.                         NewSize := BufSize + 256;

    9715. 

  9715.                         SetLength(Buf, NewSize);

    9716. 

  9716.                         BufSize := NewSize;

    9717. 

  9717.                     end;

    9718. 

  9718.                     Buf[J] := FRcvdPtr[I];

    9719. 

  9719.                 end;

    9720. 

  9720.                 Inc(I);

    9721. 

  9721.                 Inc(J);

    9722. 

  9722.             end;

    9723. 

  9723.         end;

    9724. 

  9724.         if Edited then begin

    9725. 

  9725.             if J >= FRcvBufSize then begin

    9726. 

  9726.                 { Current buffer is too small, allocate larger }

    9727. 

  9727.                 NewSize := J + 1;

    9728. 

  9728.                 SetLength(FRcvdPtr, NewSize);

    9729. 

  9729.                 FRcvBufSize := NewSize;

    9730. 

  9730.             end;

    9731. 

  9731.             { Move edited data back to original buffer }

    9732. 

  9732.             for K := 0 to J - 1 do

    9733. 

  9733.                 FRcvdPtr[K] := Buf[K];

    9734. 

  9734.             FRcvdPtr[J] := 0;

    9735. 

  9735.             FRcvdCnt    := NewCnt;

    9736. 

  9736.             Len         := J - FRcvdCnt;

    9737. 

  9737.         end;

    9738. 

  9738.     finally

    9739. 

  9739.         if BufSize > 0 then

    9740. 

  9740.             SetLength(Buf, BufSize);

    9741. 

  9741.     end;

    9742. 

  9742. end;

    9743. 

  9743. {$ENDIF}

    9744. 

  9744. {$IFDEF WIN32}

    9745. 

  9745. var

    9746. 

  9746.     Buf     : PAnsiChar;

    9747. 

  9747.     BufSize : LongInt;

    9748. 

  9748.     I       : LongInt;

    9749. 

  9749.     J       : LongInt;

    9750. 

  9750.     Edited  : Boolean;

    9751. 

  9751.     NewCnt  : LongInt;

    9752. 

  9752.     NewSize : LongInt;

    9753. 

  9753. const

    9754. 

  9754.     BackString : String = #8 + ' ' + #8;

    9755. 

  9755. begin

    9756. 

  9756.     BufSize := 0;

    9757. 

  9757.     try

    9758. 

  9758.         Edited := FALSE;

    9759. 

  9759.         I      := FRcvdCnt;

    9760. 

  9760.         J      := FRcvdCnt;

    9761. 

  9761.         NewCnt := FRcvdCnt;

    9762. 

  9762.         { Loop to process all received char }

    9763. 

  9763.         while I < (FRcvdCnt + Len) do begin

    9764. 

  9764.             if PAnsiChar(FRcvdPtr)[I] = #8 then begin   { BACKSPACE character }

    9765. 

  9765.                 if FLineEcho and (J > 0) then

    9766. 

  9766.                     SendStr(BackString);

    9767. 

  9767.                 if not Edited then begin

    9768. 

  9768.                     { Not edited yet, so we allocate a buffer to store }

    9769. 

  9769.                     { edited data and we remember we edited data.      }

    9770. 

  9770.                     Edited := TRUE;

    9771. 

  9771.                     { Computer buffer size as a multiple of 256 bytes  }

    9772. 

  9772.                     BufSize := ((FRcvdCnt + Len + 256) shr 8) shl 8;

    9773. 

  9773.                     GetMem(Buf, BufSize);

    9774. 

  9774.                     { Copy data already processed }

    9775. 

  9775.                     Move(FRcvdPtr^, Buf^, I);

    9776. 

  9776.                 end;

    9777. 

  9777.                 if J > 0 then begin

    9778. 

  9778.                     Dec(J);

    9779. 

  9779.                     if J < NewCnt then

    9780. 

  9780.                         NewCnt := J;

    9781. 

  9781.                 end;

    9782. 

  9782.                 Inc(I);

    9783. 

  9783.             end

    9784. 

  9784.             else if PAnsiChar(FRcvdPtr)[I] = #9 then begin  { TAB character }

    9785. 

  9785.                 if not Edited then begin

    9786. 

  9786.                     { Not edited yet, so we allocate a buffer to store }

    9787. 

  9787.                     { edited data and we remember we edited data.      }

    9788. 

  9788.                     Edited := TRUE;

    9789. 

  9789.                     { Computer buffer size as a multiple of 256 bytes  }

    9790. 

  9790.                     BufSize := ((FRcvdCnt + Len + 256) shr 8) shl 8;

    9791. 

  9791.                     GetMem(Buf, BufSize);

    9792. 

  9792.                     { Copy data already processed }

    9793. 

  9793.                     Move(FRcvdPtr^, Buf^, I);

    9794. 

  9794.                 end;

    9795. 

  9795.                 repeat

    9796. 

  9796.                     if FLineEcho then

    9797. 

  9797.                         SendStr(' ');

    9798. 

  9798.                     Buf[J] := ' ';

    9799. 

  9799.                     Inc(J);

    9800. 

  9800.                 until (J and 7) = 0;

    9801. 

  9801.                 Inc(I);

    9802. 

  9802.             end

    9803. 

  9803.             else begin

    9804. 

  9804.                 if FLineEcho then

    9805. 

  9805.                     Send(@PAnsiChar(FRcvdPtr)[I], 1);

    9806. 

  9806.                 if Edited then begin

    9807. 

  9807.                     if J >= BufSize then begin

    9808. 

  9808.                         { Need to allocate more buffer space }

    9809. 

  9809.                         NewSize := BufSize + 256;

    9810. 

  9810.                         {$IFDEF DELPHI1}

    9811. 

  9811.                         Buf := ReallocMem(Buf, BufSize, NewSize);

    9812. 

  9812.                         {$ELSE}

    9813. 

  9813.                         ReallocMem(Buf, NewSize);

    9814. 

  9814.                         {$ENDIF}

    9815. 

  9815.                         BufSize := NewSize;

    9816. 

  9816.                     end;

    9817. 

  9817.                     Buf[J] := PAnsiChar(FRcvdPtr)[I];

    9818. 

  9818.                 end;

    9819. 

  9819.                 Inc(I);

    9820. 

  9820.                 Inc(J);

    9821. 

  9821.             end;

    9822. 

  9822.         end;

    9823. 

  9823.         if Edited then begin

    9824. 

  9824.             if J >= FRcvBufSize then begin

    9825. 

  9825.                 { Current buffer is too small, allocate larger }

    9826. 

  9826.                 NewSize := J + 1;

    9827. 

  9827.                 {$IFDEF DELPHI1}

    9828. 

  9828.                 FRcvdPtr := ReallocMem(FRcvdPtr, FRcvBufSize, NewSize);

    9829. 

  9829.                 {$ELSE}

    9830. 

  9830.                 ReallocMem(FRcvdPtr, NewSize);

    9831. 

  9831.                 {$ENDIF}

    9832. 

  9832.                 FRcvBufSize := NewSize;

    9833. 

  9833.             end;

    9834. 

  9834.             { Move edited data back to original buffer }

    9835. 

  9835.             Move(Buf^, FRcvdPtr^, J);

    9836. 

  9836.             PAnsiChar(FRcvdPtr)[J] := #0;

    9837. 

  9837.             FRcvdCnt := NewCnt;

    9838. 

  9838.             Len      := J - FRcvdCnt;

    9839. 

  9839.         end;

    9840. 

  9840.     finally

    9841. 

  9841.         if BufSize > 0 then

    9842. 

  9842.             FreeMem(Buf, BufSize);

    9843. 

  9843.     end;

    9844. 

  9844. end;

    9845. 

  9845. {$ENDIF}

    9846. 

  9846. 

    9847. 

  9847. 

    9848. 

  9848. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    9849. 

  9849. procedure TCustomLineWSocket.TriggerLineLimitExceeded(

    9850. 

  9850.     Cnt           : Integer;

    9851. 

  9851.     var ClearData : Boolean);

    9852. 

  9852. begin

    9853. 

  9853.     if Assigned(FOnLineLimitExceeded) then

    9854. 

  9854.         FOnLineLimitExceeded(Self, Cnt, ClearData);

    9855. 

  9855. end;

    9856. 

  9856. 

    9857. 

  9857. 

    9858. 

  9858. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    9859. 

  9859. function TCustomLineWSocket.TriggerDataAvailable(ErrCode : Word) : Boolean;

    9860. 

  9860. {$IFDEF CLR}

    9861. 

  9861. var

    9862. 

  9862.     Cnt        : Integer;

    9863. 

  9863.     Len        : Integer;

    9864. 

  9864.     NewSize    : LongInt;

    9865. 

  9865.     SearchFrom : LongInt;

    9866. 

  9866.     I, K       : LongInt;

    9867. 

  9867.     Found      : Boolean;

    9868. 

  9868. begin

    9869. 

  9869. {  if (not FLineMode) or (Length(FLineEnd) = 0) then begin }

    9870. 

  9870.     if (not FLineMode) or (Length(FLineEnd) = 0) or (FSocksState <> socksData)

    9871. 

  9871.     {**ALON** added check so, if data is received while still handshaking }

    9872. 

  9872.     { with the socks server, we ask the TCustomSocksWSocket to handle it  }

    9873. 

  9873.     then begin

    9874. 

  9874.         { We are not in line mode }

    9875. 

  9875.         Result := inherited TriggerDataAvailable(ErrCode);

    9876. 

  9876.         Exit;

    9877. 

  9877.     end;

    9878. 

  9878. 

    9879. 

  9879.     { We are in line mode. We receive data ourself }

    9880. 

  9880. 

    9881. 

  9881.     Result := TRUE;

    9882. 

  9882.     Cnt    := inherited GetRcvdCount;

    9883. 

  9883.     { if Cnt <= 0 then }

    9884. 

  9884.     {    Exit;         }

    9885. 

  9885.     if Cnt < 0 then

    9886. 

  9886.         Exit;

    9887. 

  9887.     if Cnt = 0 then

    9888. 

  9888.         Cnt := 255;

    9889. 

  9889. 

    9890. 

  9890.     if (FRcvdCnt + Cnt + 1) > FRcvBufSize then begin

    9891. 

  9891.         { Current buffer is too small, allocate larger }

    9892. 

  9892.         NewSize := FRcvdCnt + Cnt + 1;

    9893. 

  9893.         SetLength(FRcvdPtr, NewSize);

    9894. 

  9894.         FRcvBufSize := NewSize;

    9895. 

  9895.     end;

    9896. 

  9896. 

    9897. 

  9897.     if Length(FLocalBuf) < Cnt then

    9898. 

  9898.         SetLength(FLocalBuf, ((Cnt + 256) shr 8) shl 8);

    9899. 

  9899. 

    9900. 

  9900.     Len := Receive(FLocalBuf, Cnt);

    9901. 

  9901.     if Len <= 0 then

    9902. 

  9902.         Exit;

    9903. 

  9903.     for I := 0 to Len - 1 do

    9904. 

  9904.          FRcvdPtr[FRcvdCnt + I] := FLocalBuf[I];

    9905. 

  9905.     FRcvdPtr[FRcvdCnt + Len] := 0;

    9906. 

  9906.     if FLineEdit then

    9907. 

  9907.         EditLine(Len)

    9908. 

  9908.     else if FLineEcho then

    9909. 

  9909.         Send(FLocalBuf, Len);

    9910. 

  9910.     SearchFrom := FRcvdCnt - Length(FLineEnd);

    9911. 

  9911.     if SearchFrom < 0 then

    9912. 

  9912.         SearchFrom := 0;

    9913. 

  9913.     FRcvdCnt := FRcvdCnt + Len;

    9914. 

  9914.     while FLineMode do begin

    9915. 

  9915.         Found := FALSE;

    9916. 

  9916.         I := SearchFrom;

    9917. 

  9917.         while I < (FRcvdCnt - Length(FLineEnd) + 1) do begin

    9918. 

  9918.             if FRcvdPtr[I] = Ord(FLineEnd[1]) then begin

    9919. 

  9919.                 Found := TRUE;

    9920. 

  9920.                 for K := 2 to Length(FLineEnd) do begin

    9921. 

  9921.                     Found := (FRcvdPtr[I + K - 1] = Ord(FLineEnd[K]));

    9922. 

  9922.                     if not Found then

    9923. 

  9923.                         break;

    9924. 

  9924.                 end;

    9925. 

  9925.                 if Found then

    9926. 

  9926.                     break;    { Found the end of line marker }

    9927. 

  9927.             end;

    9928. 

  9928.             Inc(I);

    9929. 

  9929.         end;

    9930. 

  9930.         if not Found then begin

    9931. 

  9931.             if ((FLineLimit > 0) and (FRcvdCnt > FLineLimit)) then begin

    9932. 

  9932.                 FLineClearData := TRUE;

    9933. 

  9933.                 TriggerLineLimitExceeded(FRcvdCnt, FLineClearData);

    9934. 

  9934.                 if FLineClearData then begin

    9935. 

  9935.                     FLineLength        := 0;

    9936. 

  9936.                     FRcvdCnt           := 0;

    9937. 

  9937.                     FLineClearData     := FALSE;

    9938. 

  9938.                 end;

    9939. 

  9939.             end;

    9940. 

  9940.             break;

    9941. 

  9941.         end;

    9942. 

  9942.         FLineLength       := I + Length(FLineEnd);

    9943. 

  9943.         FLineReceivedFlag := TRUE;

    9944. 

  9944.         FLineFound        := TRUE;

    9945. 

  9945.         { We received a complete line. We need to signal it to application }

    9946. 

  9946.         { The application may not have a large buffer so we may need       }

    9947. 

  9947.         { several events to read the entire line. In the meanwhile, the    }

    9948. 

  9948.         { application may turn line mode off.                              }

    9949. 

  9949.         while FLineMode and (FLineLength > 0) do begin

    9950. 

  9950.             if not inherited TriggerDataAvailable(0) then

    9951. 

  9951.                 { There is no handler installed }

    9952. 

  9952.                 FLineLength := 0;

    9953. 

  9953.         end;

    9954. 

  9954.         { Move remaining data in front of buffer }

    9955. 

  9955.         if FLineLength > 0 then begin

    9956. 

  9956.             { Line mode was turned off in the middle of a line read. }

    9957. 

  9957.             { We preserve unread line and other received data.       }

    9958. 

  9958.             for K := 0 to FRcvdCnt - I - 1 do

    9959. 

  9959.                 FRcvdPtr[FLineLength + K] := FRcvdPtr[I + K];

    9960. 

  9960.             FRcvdCnt := FRcvdCnt - I + FLineLength;

    9961. 

  9961.         end

    9962. 

  9962.         else begin

    9963. 

  9963.             for K := 0 to FRcvdCnt - I - Length(FLineEnd) - 1 do

    9964. 

  9964.                  FRcvdPtr[K] := FRcvdPtr[I + Length(FLineEnd) + K];

    9965. 

  9965.             FRcvdCnt := FRcvdCnt - I - Length(FLineEnd);

    9966. 

  9966.         end;

    9967. 

  9967.         if FRcvdCnt >= 0 then

    9968. 

  9968.             FRcvdPtr[FRcvdCnt] := 0;

    9969. 

  9969.         SearchFrom := 0;

    9970. 

  9970.         { It is possible the user has turned line mode to off. If data is }

    9971. 

  9971.         { still available in the receive buffer, we will deliver it.      }

    9972. 

  9972.         while (not FLineMode) and (FRcvdCnt > 0) do            { 26/01/04 }

    9973. 

  9973.             inherited TriggerDataAvailable(0);                 { 26/01/04 }

    9974. 

  9974.     end;

    9975. 

  9975. end;

    9976. 

  9976. {$ENDIF}

    9977. 

  9977. {$IFDEF WIN32}

    9978. 

  9978. var

    9979. 

  9979.     Cnt        : Integer;

    9980. 

  9980.     Len        : Integer;

    9981. 

  9981.     NewSize    : LongInt;

    9982. 

  9982.     SearchFrom : LongInt;

    9983. 

  9983.     I          : LongInt;

    9984. 

  9984.     Found      : Boolean;

    9985. 

  9985. begin

    9986. 

  9986. {  if (not FLineMode) or (Length(FLineEnd) = 0) then begin }

    9987. 

  9987.     if (not FLineMode) or (Length(FLineEnd) = 0) or (FSocksState <> socksData)

    9988. 

  9988.     {**ALON** added check so, if data is received while still handshaking }

    9989. 

  9989.     { with the socks server, we ask the TCustomSocksWSocket to handle it  }

    9990. 

  9990.     then begin

    9991. 

  9991.         { We are not in line mode }

    9992. 

  9992.         Result := inherited TriggerDataAvailable(ErrCode);

    9993. 

  9993.         Exit;

    9994. 

  9994.     end;

    9995. 

  9995. 

    9996. 

  9996.     { We are in line mode. We receive data ourself }

    9997. 

  9997. 

    9998. 

  9998.     Result := TRUE;

    9999. 

  9999.     Cnt    := inherited GetRcvdCount;

    10000. 

  10000.     { if Cnt <= 0 then }

    10001. 

  10001.     {    Exit;         }

    10002. 

  10002.     if Cnt < 0 then

    10003. 

  10003.         Exit;

    10004. 

  10004.     if Cnt = 0 then

    10005. 

  10005.         Cnt := 255;

    10006. 

  10006. 

    10007. 

  10007.     if (FRcvdCnt + Cnt + 1) > FRcvBufSize then begin

    10008. 

  10008.         { Current buffer is too small, allocate larger }

    10009. 

  10009.         NewSize := FRcvdCnt + Cnt + 1;

    10010. 

  10010.         {$IFDEF DELPHI1}

    10011. 

  10011.         FRcvdPtr := ReallocMem(FRcvdPtr, FRcvBufSize, NewSize);

    10012. 

  10012.         {$ELSE}

    10013. 

  10013.         ReallocMem(FRcvdPtr, NewSize);

    10014. 

  10014.         {$ENDIF}

    10015. 

  10015.         FRcvBufSize := NewSize;

    10016. 

  10016.     end;

    10017. 

  10017. 

    10018. 

  10018.     Len := Receive(IncPtr(FRcvdPtr, FRcvdCnt), Cnt);

    10019. 

  10019. {$IFDEF OLD_20040117}

    10020. 

  10020.     if Len <= 0 then

    10021. 

  10021.         Exit;

    10022. 

  10022.     FRcvdPtr[FRcvdCnt + Len] := #0;

    10023. 

  10023. {$ELSE}

    10024. 

  10024.     if Len <= 0 then begin

    10025. 

  10025.         if FRcvdCnt <= 0 then

    10026. 

  10026.             Exit;

    10027. 

  10027.         Len := 0;

    10028. 

  10028.     end;

    10029. 

  10029. {$ENDIF}

    10030. 

  10030. 

    10031. 

  10031.     if Len > 0 then begin

    10032. 

  10032.         if FLineEdit then

    10033. 

  10033.             EditLine(Len)

    10034. 

  10034.         else if FLineEcho then

    10035. 

  10035.             Send(IncPtr(FRcvdPtr, FRcvdCnt), Len);

    10036. 

  10036.     end;

    10037. 

  10037. 

    10038. 

  10038.     SearchFrom := FRcvdCnt - Length(FLineEnd);

    10039. 

  10039.     if SearchFrom < 0 then

    10040. 

  10040.         SearchFrom := 0;

    10041. 

  10041.     FRcvdCnt := FRcvdCnt + Len;

    10042. 

  10042.     while FLineMode do begin

    10043. 

  10043.         Found := FALSE;

    10044. 

  10044.         I := SearchFrom;

    10045. 

  10045.         while I < (FRcvdCnt - Length(FLineEnd) + 1) do begin

    10046. 

  10046.             if PAnsiChar(FRcvdPtr)[I] = AnsiChar(FLineEnd[1]) then begin     

    10047. 

  10047.                 Found := _StrLComp(PAnsiChar(@(PAnsiChar(FRcvdPtr)[I])),

    10048. 

  10048.                                   PAnsiChar(FLineEnd), Length(FLineEnd)) = 0;

    10049. 

  10049.                 if Found then

    10050. 

  10050.                     break;    { Found the end of line marker }

    10051. 

  10051.             end;

    10052. 

  10052.             Inc(I);

    10053. 

  10053.         end;

    10054. 

  10054.         if not Found then begin

    10055. 

  10055.             if ((FLineLimit > 0) and (FRcvdCnt > FLineLimit)) then begin

    10056. 

  10056.                 FLineClearData := TRUE;

    10057. 

  10057.                 TriggerLineLimitExceeded(FRcvdCnt, FLineClearData);

    10058. 

  10058.                 if FLineClearData then begin

    10059. 

  10059.                     FLineLength        := 0;

    10060. 

  10060.                     FRcvdCnt           := 0;

    10061. 

  10061.                     FLineClearData     := FALSE;

    10062. 

  10062.                 end;

    10063. 

  10063.             end;

    10064. 

  10064.             break;

    10065. 

  10065.         end;

    10066. 

  10066.         FLineLength       := I + Length(FLineEnd);

    10067. 

  10067.         FLineReceivedFlag := TRUE;

    10068. 

  10068.         FLineFound        := TRUE;

    10069. 

  10069.         { We received a complete line. We need to signal it to application }

    10070. 

  10070.         { The application may not have a large buffer so we may need       }

    10071. 

  10071.         { several events to read the entire line. In the meanwhile, the    }

    10072. 

  10072.         { application may turn line mode off.                              }

    10073. 

  10073.         while FLineMode and (FLineLength > 0) do begin

    10074. 

  10074.             if not inherited TriggerDataAvailable(0) then

    10075. 

  10075.                 { There is no handler installed }

    10076. 

  10076.                 FLineLength := 0;

    10077. 

  10077.         end;

    10078. 

  10078.         { Move remaining data in front of buffer }

    10079. 

  10079.         if FLineLength > 0 then begin

    10080. 

  10080.             { Line mode was turned off in the middle of a line read. }

    10081. 

  10081.             { We preserve unread line and other received data.       }

    10082. 

  10082.             Move(PAnsiChar(FRcvdPtr)[I], PAnsiChar(FRcvdPtr)[FLineLength],

    10083. 

  10083.                  FRcvdCnt - I);

    10084. 

  10084.             FRcvdCnt := FRcvdCnt - I + FLineLength;

    10085. 

  10085.         end

    10086. 

  10086.         else begin

    10087. 

  10087.             Move(PAnsiChar(FRcvdPtr)[I + Length(FLineEnd)], PAnsiChar(FRcvdPtr)[0],

    10088. 

  10088.                  FRcvdCnt - I - Length(FLineEnd));

    10089. 

  10089.             FRcvdCnt := FRcvdCnt - I - Length(FLineEnd);

    10090. 

  10090.         end;

    10091. 

  10091.         if FRcvdCnt >= 0 then

    10092. 

  10092.             PAnsiChar(FRcvdPtr)[FRcvdCnt] := #0;

    10093. 

  10093.         SearchFrom := 0;

    10094. 

  10094.         { It is possible the user has turned line mode to off. If data is }

    10095. 

  10095.         { still available in the receive buffer, we will deliver it.      }

    10096. 

  10096.         while (not FLineMode) and (FRcvdCnt > 0) do            { 26/01/04 }

    10097. 

  10097.             inherited TriggerDataAvailable(0);                 { 26/01/04 }

    10098. 

  10098.     end;

    10099. 

  10099. end;

    10100. 

  10100. {$ENDIF}

    10101. 

  10101. 

    10102. 

  10102. 

    10103. 

  10103. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    10104. 

  10104. procedure TCustomLineWSocket.TriggerSessionClosed(Error : Word);

    10105. 

  10105. begin

    10106. 

  10106.     FLineReceivedFlag := TRUE;

    10107. 

  10107.     if FRcvdPtr <> nil then begin

    10108. 

  10108.         if FLineMode and (FRcvdCnt > 0) and (not FLineClearData) then begin

    10109. 

  10109.             FLineLength       := FRcvdCnt;

    10110. 

  10110.             while FLineMode and (FLineLength > 0) do

    10111. 

  10111.                 inherited TriggerDataAvailable(0);

    10112. 

  10112.         end;

    10113. 

  10113.         {$IFDEF CLR}

    10114. 

  10114.         SetLength(FRcvdPtr, FRcvBufSize);

    10115. 

  10115.         {$ENDIF}

    10116. 

  10116.         {$IFDEF WIN32}

    10117. 

  10117.         FreeMem(FRcvdPtr, FRcvBufSize);

    10118. 

  10118.         FRcvdPtr    := nil;

    10119. 

  10119.         {$ENDIF}

    10120. 

  10120.         FRcvBufSize := 0;

    10121. 

  10121.         FRcvdCnt    := 0;

    10122. 

  10122.     end;

    10123. 

  10123.     inherited TriggerSessionClosed(Error);

    10124. 

  10124. end;

    10125. 

  10125. 

    10126. 

  10126. 

    10127. 

  10127. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

    10128. 

  10128. 

    10129. 

  10129.                  X X      X     X    X       X     X X X

    10130. 

  10130.                X     X      X   X    X X     X   X      X

    10131. 

  10131.                X              X X    X   X   X   X

    10132. 

  10132.                  X X            X    X     X X   X

    10133. 

  10133.                      X          X    X       X   X

    10134. 

  10134.                X     X    X     X    X       X   X      X

    10135. 

  10135.                  X X        X X      X       X     X X X

    10136. 

  10136. 

    10137. 

  10137.  * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    10138. 

  10138. procedure TCustomSyncWSocket.InternalDataAvailable(

    10139. 

  10139.     Sender : TObject;

    10140. 

  10140.     Error  : Word);

    10141. 

  10141. var

    10142. 

  10142.     Len : Integer;

    10143. 

  10143. begin

    10144. 

  10144.     {$IFDEF CLR}

    10145. 

  10145.     SetLength(FLinePointer, FLineLength);

    10146. 

  10146.     Len := Receive(FLinePointer, FLineLength);

    10147. 

  10147.     if Len <= 0 then

    10148. 

  10148.         Len := 0;

    10149. 

  10149.     SetLength(FLinePointer, Len);

    10150. 

  10150.     {$ENDIF}

    10151. 

  10151.     {$IFDEF WIN32}

    10152. 

  10152.     SetLength(FLinePointer^, FLineLength);

    10153. 

  10153.     Len := Receive(@FLinePointer^[1], FLineLength);

    10154. 

  10154.     if Len <= 0 then

    10155. 

  10155.         FLinePointer^ := ''

    10156. 

  10156.     else

    10157. 

  10157.         SetLength(FLinePointer^, Len);

    10158. 

  10158.     {$ENDIF}

    10159. 

  10159. end;

    10160. 

  10160. 

    10161. 

  10161. 

    10162. 

  10162. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    10163. 

  10163. function TCustomSyncWSocket.WaitUntilReady(var DoneFlag : Boolean) : Integer;

    10164. 

  10164. begin

    10165. 

  10165.     Result := 0;           { Suppose success }

    10166. 

  10166.     FTimeStop := Integer(_GetTickCount) + FTimeout;

    10167. 

  10167.     while TRUE do begin

    10168. 

  10168.         if DoneFlag then begin

    10169. 

  10169.             Result := 0;

    10170. 

  10170.             break;

    10171. 

  10171.         end;

    10172. 

  10172. 

    10173. 

  10173.         if ((FTimeout > 0) and (Integer(_GetTickCount) > FTimeStop)) or

    10174. 

  10174. {$IFDEF WIN32}

    10175. 

  10175. {$IFNDEF NOFORMS}

    10176. 

  10176.            Application.Terminated or

    10177. 

  10177. {$ENDIF}

    10178. 

  10178. {$ENDIF}

    10179. 

  10179.            FTerminated then begin

    10180. 

  10180.             { Application is terminated or timeout occured }

    10181. 

  10181.             Result := WSA_WSOCKET_TIMEOUT;

    10182. 

  10182.             break;

    10183. 

  10183.         end;

    10184. 

  10184.         MessagePump;

    10185. 

  10185. {$IFDEF COMPILER2_UP}

    10186. 

  10186.         { Do not use 100% CPU, but slow down transfert on high speed LAN }

    10187. 

  10187.         _Sleep(0);

    10188. 

  10188. {$ENDIF}

    10189. 

  10189.     end;

    10190. 

  10190. end;

    10191. 

  10191. 

    10192. 

  10192. 

    10193. 

  10193. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    10194. 

  10194. { DEPRECATED: DO NOT USE Synchronize procedure for a new application.       }

    10195. 

  10195. { Instead, use pure event-driven design.                                    }

    10196. 

  10196. function TCustomSyncWSocket.Synchronize(

    10197. 

  10197.     Proc : TWSocketSyncNextProc;

    10198. 

  10198.     var DoneFlag : Boolean) : Integer;

    10199. 

  10199. begin

    10200. 

  10200.     DoneFlag := FALSE;

    10201. 

  10201.     if Assigned(Proc) then

    10202. 

  10202.         Proc;

    10203. 

  10203.     Result := WaitUntilReady(DoneFlag);

    10204. 

  10204. end;

    10205. 

  10205. 

    10206. 

  10206. 

    10207. 

  10207. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    10208. 

  10208. { DEPRECATED: DO NOT USE ReadLine procedure for a new application.          }

    10209. 

  10209. { Instead, use pure event-driven design using OnDataAvailable event.        }

    10210. 

  10210. procedure TCustomSyncWSocket.ReadLine(

    10211. 

  10211.     Timeout    : Integer;  { seconds if positive, milli-seconds if negative }

    10212. 

  10212.     var Buffer : AnsiString);

    10213. 

  10213. var

    10214. 

  10214.     OldDataAvailable : TDataAvailable;

    10215. 

  10215.     OldLineMode      : Boolean;

    10216. 

  10216.     Status           : Integer;

    10217. 

  10217. {$IFDEF CLR}

    10218. 

  10218.     I                : Integer;

    10219. 

  10219. {$ENDIF}

    10220. 

  10220. begin

    10221. 

  10221.     Buffer            := '';

    10222. 

  10222.     if FState <> wsConnected then begin

    10223. 

  10223.         RaiseException('ReadLine failed: not connected');

    10224. 

  10224.         Exit;

    10225. 

  10225.     end;

    10226. 

  10226. 

    10227. 

  10227.     { Positive timeout means seconds. Negative means milli-seconds }

    10228. 

  10228.     { Null means 60 seconds.                                       }

    10229. 

  10229.     if TimeOut = 0 then

    10230. 

  10230.         FTimeOut      := 60000

    10231. 

  10231.     else if TimeOut > 0 then

    10232. 

  10232.         FTimeOut      := Timeout * 1000

    10233. 

  10233.     else

    10234. 

  10234.         FTimeOut      := -Timeout;

    10235. 

  10235. 

    10236. 

  10236.     FLineReceivedFlag := FALSE;

    10237. 

  10237.     {$IFDEF WIN32}

    10238. 

  10238.     FLinePointer      := @Buffer;

    10239. 

  10239.     {$ENDIF}

    10240. 

  10240.     { Save existing OnDataAvailable handler and install our own }

    10241. 

  10241.     OldDataAvailable  := FOnDataAvailable;

    10242. 

  10242.     FOnDataAvailable  := InternalDataAvailable;

    10243. 

  10243.     { Save existing line mode and turn it on }

    10244. 

  10244.     OldLineMode       := FLineMode;

    10245. 

  10245.     FLineMode         := TRUE;

    10246. 

  10246.     try

    10247. 

  10247.         Status := Synchronize(nil, FLineReceivedFlag);

    10248. 

  10248.         if Status = WSA_WSOCKET_TIMEOUT then begin

    10249. 

  10249.              { Sender didn't send line end within allowed time. Get all }

    10250. 

  10250.              { data available so far.                                   }

    10251. 

  10251.              if FRcvdCnt > 0 then begin

    10252. 

  10252.                  SetLength(Buffer, FRcvdCnt);

    10253. 

  10253.                  {$IFDEF CLR}

    10254. 

  10254.                  for I := 0 to FRcvdCnt - 1 do

    10255. 

  10255.                      Buffer[I + 1] := Char(FRcvdPtr[I]);

    10256. 

  10256.                  {$ENDIF}

    10257. 

  10257.                  {$IFDEF WIN32}

    10258. 

  10258.                  Move(FRcvdPtr^, Buffer[1], FRcvdCnt);

    10259. 

  10259.                  {$ENDIF}

    10260. 

  10260.                  FRcvdCnt := 0;

    10261. 

  10261.              {$IFDEF CLR}

    10262. 

  10262.              end

    10263. 

  10263.              else begin

    10264. 

  10264.                  SetLength(Buffer, Length(FLinePointer));

    10265. 

  10265.                  for I := 0 to Length(FLinePointer) - 1 do

    10266. 

  10266.                      Buffer[I + 1] := Char(FLinePointer[I]);

    10267. 

  10267.              {$ENDIF}

    10268. 

  10268.              end;

    10269. 

  10269.         end;

    10270. 

  10270.         { Should I raise an exception to tell the application that       }

    10271. 

  10271.         { some error occured ?                                           }

    10272. 

  10272.     finally

    10273. 

  10273.         FOnDataAvailable := OldDataAvailable;

    10274. 

  10274.         FLineMode        := OldLineMode;

    10275. 

  10275.     end;

    10276. 

  10276. end;

    10277. 

  10277. 

    10278. 

  10278. 

    10279. 

  10279. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    10280. 

  10280. {$IFDEF BUILTIN_TIMEOUT}

    10281. 

  10281. 

    10282. 

  10282. { TCustomTimeoutWSocket }

    10283. 

  10283. 

    10284. 

  10284. const

    10285. 

  10285.     MIN_TIMEOUT_SAMPLING_INTERVAL = 1000;

    10286. 

  10286. 

    10287. 

  10287. constructor TCustomTimeoutWSocket.Create(AOwner: TComponent);

    10288. 

  10288. begin

    10289. 

  10289.     inherited;

    10290. 

  10290.     FTimeoutKeepThreadAlive := TRUE;

    10291. 

  10291.     FTimeoutSampling := 5000;

    10292. 

  10292. end;

    10293. 

  10293. 

    10294. 

  10294. 

    10295. 

  10295. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    10296. 

  10296. procedure TCustomTimeoutWSocket.TimeoutHandleTimer(

    10297. 

  10297.     Sender: TObject);

    10298. 

  10298. begin

    10299. 

  10299.     if (FTimeoutConnect > 0) and (FState <> wsConnected) then begin

    10300. 

  10300.         if IcsCalcTickDiff(FTimeoutConnectStartTick,

    10301. 

  10301.                            _GetTickCount) > FTimeoutConnect then begin

    10302. 

  10302.             TimeoutStopSampling;

    10303. 

  10303.             TriggerTimeout(torConnect);

    10304. 

  10304.         end;

    10305. 

  10305.     end

    10306. 

  10306.     else if (FTimeoutIdle > 0) then begin

    10307. 

  10307.         if IcsCalcTickDiff(FCounter.GetLastAliveTick,

    10308. 

  10308.                            _GetTickCount) > FTimeoutIdle then begin

    10309. 

  10309.             TimeoutStopSampling;

    10310. 

  10310.             TriggerTimeout(torIdle);

    10311. 

  10311.         end;

    10312. 

  10312.     end

    10313. 

  10313.     else

    10314. 

  10314.         TimeoutStopSampling;

    10315. 

  10315. end;

    10316. 

  10316. 

    10317. 

  10317. 

    10318. 

  10318. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    10319. 

  10319. procedure TCustomTimeoutWSocket.Connect;

    10320. 

  10320. begin

    10321. 

  10321.     if FTimeoutConnect > 0 then begin

    10322. 

  10322.         TimeoutStartSampling;

    10323. 

  10323.         FTimeoutConnectStartTick := _GetTickCount;

    10324. 

  10324.     end

    10325. 

  10325.     else if FTimeoutIdle > 0 then

    10326. 

  10326.         TimeoutStartSampling;

    10327. 

  10327.     inherited Connect;

    10328. 

  10328. end;

    10329. 

  10329. 

    10330. 

  10330. 

    10331. 

  10331. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    10332. 

  10332. procedure TCustomTimeoutWSocket.SetTimeoutKeepThreadAlive(const Value: Boolean);

    10333. 

  10333. begin

    10334. 

  10334.     FTimeoutKeepThreadAlive := Value;

    10335. 

  10335.     if FTimeoutTimer <> nil then

    10336. 

  10336.         FTimeoutTimer.KeepThreadAlive := FTimeoutKeepThreadAlive;

    10337. 

  10337. end;

    10338. 

  10338. 

    10339. 

  10339. 

    10340. 

  10340. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    10341. 

  10341. procedure TCustomTimeoutWSocket.SetTimeoutSampling(const Value: LongWord);

    10342. 

  10342. begin

    10343. 

  10343.     if (Value > 0) and (Value < MIN_TIMEOUT_SAMPLING_INTERVAL) then

    10344. 

  10344.        FTimeoutSampling := MIN_TIMEOUT_SAMPLING_INTERVAL

    10345. 

  10345.     else

    10346. 

  10346.        FTimeoutSampling := Value;

    10347. 

  10347. end;

    10348. 

  10348. 

    10349. 

  10349. 

    10350. 

  10350. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    10351. 

  10351. procedure TCustomTimeoutWSocket.TimeoutStartSampling;

    10352. 

  10352. begin

    10353. 

  10353.     if not Assigned(FTimeoutTimer) then begin

    10354. 

  10354.         FTimeoutTimer := TIcsThreadTimer.Create(Self);

    10355. 

  10355.         FTimeoutTimer.KeepThreadAlive := FTimeoutKeepThreadAlive;

    10356. 

  10356.         FTimeoutTimer.OnTimer := TimeoutHandleTimer;

    10357. 

  10357.     end;

    10358. 

  10358.     if not Assigned(FCounter) then

    10359. 

  10359.         CreateCounter

    10360. 

  10360.     else

    10361. 

  10361.         FCounter.LastSendTick := _GetTickCount; // Init

    10362. 

  10362.     if FTimeoutTimer.Interval <> FTimeoutSampling then

    10363. 

  10363.         FTimeoutTimer.Interval := FTimeoutSampling;

    10364. 

  10364.     if not FTimeoutTimer.Enabled then

    10365. 

  10365.         FTimeoutTimer.Enabled := TRUE;

    10366. 

  10366. end;

    10367. 

  10367. 

    10368. 

  10368. 

    10369. 

  10369. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    10370. 

  10370. procedure TCustomTimeoutWSocket.TimeoutStopSampling;

    10371. 

  10371. begin

    10372. 

  10372.     if Assigned(FTimeoutTimer) then

    10373. 

  10373.         FTimeoutTimer.Enabled := FALSE;

    10374. 

  10374. end;

    10375. 

  10375. 

    10376. 

  10376. 

    10377. 

  10377. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    10378. 

  10378. procedure TCustomTimeoutWSocket.DupConnected;

    10379. 

  10379. begin

    10380. 

  10380.     if FTimeoutIdle > 0 then

    10381. 

  10381.         TimeoutStartSampling

    10382. 

  10382.     else

    10383. 

  10383.         TimeoutStopSampling;

    10384. 

  10384.     inherited DupConnected;

    10385. 

  10385. end;

    10386. 

  10386. 

    10387. 

  10387. 

    10388. 

  10388. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    10389. 

  10389. procedure TCustomTimeoutWSocket.ThreadAttach;

    10390. 

  10390. begin

    10391. 

  10391.     inherited ThreadAttach;

    10392. 

  10392.     if Assigned(FTimeoutTimer) then

    10393. 

  10393.         FTimeoutTimer.Enabled := FTimeoutOldTimerEnabled;

    10394. 

  10394. end;

    10395. 

  10395. 

    10396. 

  10396. 

    10397. 

  10397. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    10398. 

  10398. procedure TCustomTimeoutWSocket.ThreadDetach;

    10399. 

  10399. begin

    10400. 

  10400.     if Assigned(FTimeoutTimer) and

    10401. 

  10401.       (_GetCurrentThreadID = DWORD(FThreadID)) then begin

    10402. 

  10402.         FTimeoutOldTimerEnabled := FTimeoutTimer.Enabled;

    10403. 

  10403.         if FTimeoutOldTimerEnabled then

    10404. 

  10404.             FTimeoutTimer.Enabled := FALSE;

    10405. 

  10405.     end;

    10406. 

  10406.     inherited ThreadDetach;

    10407. 

  10407. end;

    10408. 

  10408. 

    10409. 

  10409. 

    10410. 

  10410. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    10411. 

  10411. procedure TCustomTimeoutWSocket.TriggerSessionClosed(Error: Word);

    10412. 

  10412. begin

    10413. 

  10413.     TimeoutStopSampling;

    10414. 

  10414.     inherited TriggerSessionClosed(Error);

    10415. 

  10415. end;

    10416. 

  10416. 

    10417. 

  10417. 

    10418. 

  10418. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    10419. 

  10419. procedure TCustomTimeoutWSocket.TriggerSessionConnectedSpecial(

    10420. 

  10420.   Error: Word);

    10421. 

  10421. begin

    10422. 

  10422.     if (Error = 0) and (FTimeoutIdle > 0) then

    10423. 

  10423.         TimeoutStartSampling

    10424. 

  10424.     else

    10425. 

  10425.         TimeoutStopSampling;

    10426. 

  10426.     inherited TriggerSessionConnectedSpecial(Error);

    10427. 

  10427. end;

    10428. 

  10428. 

    10429. 

  10429. 

    10430. 

  10430. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    10431. 

  10431. procedure TCustomTimeoutWSocket.TriggerTimeout(Reason: TTimeoutReason);

    10432. 

  10432. begin

    10433. 

  10433.     if Assigned(FOnTimeout) then

    10434. 

  10434.         FOnTimeout(Self, Reason);

    10435. 

  10435. end;

    10436. 

  10436. {$ENDIF}

    10437. 

  10437. 

    10438. 

  10438. 

    10439. 

  10439. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    10440. 

  10440. {$IFDEF BUILTIN_THROTTLE}

    10441. 

  10441. 

    10442. 

  10442. { TCustomThrottledWSocket }

    10443. 

  10443. 

    10444. 

  10444. constructor TCustomThrottledWSocket.Create(AOwner: TComponent);

    10445. 

  10445. begin

    10446. 

  10446.     inherited Create(AOwner);

    10447. 

  10447.     FBandwidthKeepThreadAlive := TRUE;

    10448. 

  10448.     FBandwidthSampling := 1000; { Msec sampling interval }

    10449. 

  10449. end;

    10450. 

  10450. 

    10451. 

  10451. 

    10452. 

  10452. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    10453. 

  10453. procedure TCustomThrottledWSocket.ThreadAttach;

    10454. 

  10454. begin

    10455. 

  10455.     inherited ThreadAttach;

    10456. 

  10456.     if Assigned(FBandwidthTimer) then

    10457. 

  10457.         FBandwidthTimer.Enabled := FBandwidthOldTimerEnabled;

    10458. 

  10458. end;

    10459. 

  10459. 

    10460. 

  10460. 

    10461. 

  10461. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    10462. 

  10462. procedure TCustomThrottledWSocket.ThreadDetach;

    10463. 

  10463. begin

    10464. 

  10464.     if Assigned(FBandwidthTimer) and

    10465. 

  10465.       (_GetCurrentThreadID = DWORD(FThreadID)) then begin

    10466. 

  10466.         FBandwidthOldTimerEnabled := FBandwidthTimer.Enabled;

    10467. 

  10467.         if FBandwidthOldTimerEnabled then

    10468. 

  10468.             FBandwidthTimer.Enabled := FALSE;

    10469. 

  10469.     end;

    10470. 

  10470.     inherited ThreadDetach;

    10471. 

  10471. end;

    10472. 

  10472. 

    10473. 

  10473. 

    10474. 

  10474. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    10475. 

  10475. procedure TCustomThrottledWSocket.DupConnected;

    10476. 

  10476. begin

    10477. 

  10477.     inherited DupConnected;

    10478. 

  10478.     SetBandwidthControl;

    10479. 

  10479. end;

    10480. 

  10480. 

    10481. 

  10481. 

    10482. 

  10482. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    10483. 

  10483. procedure TCustomThrottledWSocket.SetBandwidthControl;

    10484. 

  10484. var

    10485. 

  10485.     I : Int64;

    10486. 

  10486. begin

    10487. 

  10487.     FBandwidthCount := 0;

    10488. 

  10488.     if FBandwidthLimit > 0 then

    10489. 

  10489.     begin

    10490. 

  10490.         if not Assigned(FBandwidthTimer) then begin

    10491. 

  10491.             FBandwidthTimer := TIcsThreadTimer.Create(Self);

    10492. 

  10492.             FBandwidthTimer.KeepThreadAlive := FBandwidthKeepThreadAlive;

    10493. 

  10493.             FBandwidthTimer.OnTimer := BandwidthHandleTimer;

    10494. 

  10494.         end;

    10495. 

  10495.         FBandwidthTimer.Interval := FBandwidthSampling;

    10496. 

  10496.         if not FBandwidthTimer.Enabled then

    10497. 

  10497.             FBandwidthTimer.Enabled := TRUE;

    10498. 

  10498.         // Number of bytes we allow during a sampling period, max integer max.

    10499. 

  10499.         I := Int64(FBandwidthLimit) * FBandwidthSampling div 1000;

    10500. 

  10500.         if I < MaxInt then

    10501. 

  10501.             FBandwidthMaxCount := I

    10502. 

  10502.         else

    10503. 

  10503.             FBandwidthMaxCount := MaxInt;

    10504. 

  10504.         FBandwidthPaused := FALSE;

    10505. 

  10505.         Include(FComponentOptions, wsoNoReceiveLoop);

    10506. 

  10506.         FBandwidthEnabled := TRUE;

    10507. 

  10507.     {$IFNDEF NO_DEBUG_LOG}

    10508. 

  10508.         if CheckLogOptions(loWsockInfo) then

    10509. 

  10509.             DebugLog(loWsockInfo,

    10510. 

  10510.                      _IntToHex(INT_PTR(Self), SizeOf(Pointer) * 2) +

    10511. 

  10511.                      ' Bandwidth ON ' + _IntToStr(FHSocket));

    10512. 

  10512.     {$ENDIF}

    10513. 

  10513.     end

    10514. 

  10514.     else begin

    10515. 

  10515.         if Assigned(FBandwidthTimer) then begin

    10516. 

  10516.             if FBandwidthTimer.Enabled then

    10517. 

  10517.                 FBandwidthTimer.Enabled := FALSE;

    10518. 

  10518.             if FBandwidthEnabled then begin

    10519. 

  10519.                 FBandwidthEnabled := FALSE;

    10520. 

  10520.             {$IFNDEF NO_DEBUG_LOG}

    10521. 

  10521.                 if CheckLogOptions(loWsockInfo) then

    10522. 

  10522.                     DebugLog(loWsockInfo,

    10523. 

  10523.                             _IntToHex(INT_PTR(Self), SizeOf(Pointer) * 2) +

    10524. 

  10524.                             ' Bandwidth OFF ' + _IntToStr(FHSocket));

    10525. 

  10525.             {$ENDIF}

    10526. 

  10526.             end;

    10527. 

  10527.         end;

    10528. 

  10528.     end;

    10529. 

  10529. end;

    10530. 

  10530. 

    10531. 

  10531. 

    10532. 

  10532. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    10533. 

  10533. procedure TCustomThrottledWSocket.SetBandwidthKeepThreadAlive(

    10534. 

  10534.   const Value: Boolean);

    10535. 

  10535. begin

    10536. 

  10536.     FBandwidthKeepThreadAlive := Value;

    10537. 

  10537.     if FBandwidthTimer <> nil then

    10538. 

  10538.         FBandwidthTimer.KeepThreadAlive := FBandwidthKeepThreadAlive;

    10539. 

  10539. end;

    10540. 

  10540. 

    10541. 

  10541. 

    10542. 

  10542. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    10543. 

  10543. procedure TCustomThrottledWSocket.SetBandwidthSampling(const Value: LongWord);

    10544. 

  10544. begin

    10545. 

  10545.     if Value < 500 then

    10546. 

  10546.         FBandwidthSampling := 500

    10547. 

  10547.     else

    10548. 

  10548.         FBandwidthSampling := Value;

    10549. 

  10549. end;

    10550. 

  10550. 

    10551. 

  10551. 

    10552. 

  10552. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    10553. 

  10553. function TCustomThrottledWSocket.RealSend(var Data: TWSocketData;

    10554. 

  10554.   Len: Integer): Integer;

    10555. 

  10555. begin

    10556. 

  10556.     if not FBandwidthEnabled then

    10557. 

  10557.         Result := inherited RealSend(Data, Len)

    10558. 

  10558.     else begin

    10559. 

  10559.         { Try to adjust amount of data actually passed to winsock }

    10560. 

  10560.         if (Len > 0) and (FBandwidthCount < FBandwidthMaxCount) and

    10561. 

  10561.            (FBandwidthCount + LongWord(Len) > FBandwidthMaxCount) then

    10562. 

  10562.             Len := (FBandwidthMaxCount - FBandwidthCount) + 1;

    10563. 

  10563. 

    10564. 

  10564.         Result := inherited RealSend(Data, Len);

    10565. 

  10565. 

    10566. 

  10566.         if (Result > 0) then begin

    10567. 

  10567.             Inc(FBandwidthCount, Result);

    10568. 

  10568.             if (FBandwidthCount > FBandwidthMaxCount) and

    10569. 

  10569.                (not FBandwidthPaused) then begin

    10570. 

  10570.                 FBandwidthPaused := TRUE;

    10571. 

  10571.                 Pause;

    10572. 

  10572.            {$IFNDEF NO_DEBUG_LOG}

    10573. 

  10573.                 if CheckLogOptions(loWsockInfo) then

    10574. 

  10574.                     DebugLog(loWsockInfo,

    10575. 

  10575.                             _IntToHex(INT_PTR(Self), SizeOf(Pointer) * 2) +

    10576. 

  10576.                             ' Bandwidth Paused on send ' + _IntToStr(FHSocket));

    10577. 

  10577.            {$ENDIF}

    10578. 

  10578.            end;

    10579. 

  10579.        end;

    10580. 

  10580.     end;

    10581. 

  10581. end;

    10582. 

  10582. 

    10583. 

  10583. 

    10584. 

  10584. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    10585. 

  10585. function TCustomThrottledWSocket.Receive(Buffer: TWSocketData;

    10586. 

  10586.   BufferSize: Integer): Integer;

    10587. 

  10587. begin

    10588. 

  10588.     { The Receive throttle does not work if FD_CLOSE message has been received }

    10589. 

  10589.     { yet since handler Do_FD_CLOSE removes option wsoNoReceiveLoop.           }

    10590. 

  10590.     if (not FBandwidthEnabled) or not (wsoNoReceiveLoop in ComponentOptions) then

    10591. 

  10591.         Result := inherited Receive(Buffer, BufferSize)

    10592. 

  10592.     else begin

    10593. 

  10593.         { Try to adjust amount of data to be received from winsock }

    10594. 

  10594.         if (BufferSize > 0) and (FBandwidthCount < FBandwidthMaxCount) and

    10595. 

  10595.            (FBandwidthCount + LongWord(BufferSize) > FBandwidthMaxCount) then

    10596. 

  10596.             BufferSize := (FBandwidthMaxCount - FBandwidthCount) + 1;

    10597. 

  10597. 

    10598. 

  10598.         Result := inherited Receive(Buffer, BufferSize);

    10599. 

  10599.     

    10600. 

  10600.         if (Result > 0) then begin

    10601. 

  10601.             Inc(FBandwidthCount, Result);

    10602. 

  10602.             if (FBandwidthCount > FBandwidthMaxCount) and

    10603. 

  10603.                (not FBandwidthPaused) then begin

    10604. 

  10604.                 FBandwidthPaused := TRUE;

    10605. 

  10605.                 Pause;

    10606. 

  10606.             {$IFNDEF NO_DEBUG_LOG}

    10607. 

  10607.                 if CheckLogOptions(loWsockInfo) then

    10608. 

  10608.                     DebugLog(loWsockInfo,

    10609. 

  10609.                              _IntToHex(INT_PTR(Self), SizeOf(Pointer) * 2) +

    10610. 

  10610.                              ' Bandwidth Paused on receive ' + _IntToStr(FHSocket));

    10611. 

  10611.             {$ENDIF}

    10612. 

  10612.             end;

    10613. 

  10613.         end;

    10614. 

  10614.     end;

    10615. 

  10615. end;

    10616. 

  10616. 

    10617. 

  10617. 

    10618. 

  10618. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    10619. 

  10619. procedure TCustomThrottledWSocket.BandwidthHandleTimer(

    10620. 

  10620.     Sender: TObject);

    10621. 

  10621. begin

    10622. 

  10622.     if FBandwidthPaused then begin

    10623. 

  10623.         FBandwidthPaused := FALSE;

    10624. 

  10624.         Dec(FBandwidthCount, FBandwidthMaxCount);

    10625. 

  10625.         if FBandwidthCount > FBandwidthMaxCount then

    10626. 

  10626.             FBandwidthCount := FBandwidthMaxCount;

    10627. 

  10627.         if (FHSocket <> INVALID_SOCKET) then begin

    10628. 

  10628.         {$IFNDEF NO_DEBUG_LOG}

    10629. 

  10629.             if CheckLogOptions(loWsockInfo) then

    10630. 

  10630.                 DebugLog(loWsockInfo,

    10631. 

  10631.                          _IntToHex(INT_PTR(Self), SizeOf(Pointer) * 2) +

    10632. 

  10632.                          ' Bandwidth Resume ' + _IntToStr(FHSocket));

    10633. 

  10633.         {$ENDIF}

    10634. 

  10634.             Resume;

    10635. 

  10635.         end;

    10636. 

  10636.     end

    10637. 

  10637.     else

    10638. 

  10638.         FBandwidthCount := 0;

    10639. 

  10639. end;

    10640. 

  10640. 

    10641. 

  10641. 

    10642. 

  10642. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    10643. 

  10643. procedure TCustomThrottledWSocket.TriggerSessionClosed(Error: Word);

    10644. 

  10644. begin

    10645. 

  10645.     if Assigned(FBandwidthTimer) then begin

    10646. 

  10646.         FBandwidthTimer.Enabled := FALSE;

    10647. 

  10647.         FBandwidthEnabled       := FALSE;

    10648. 

  10648.     end;

    10649. 

  10649.     inherited TriggerSessionClosed(Error);

    10650. 

  10650. end;

    10651. 

  10651. 

    10652. 

  10652. 

    10653. 

  10653. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    10654. 

  10654. procedure TCustomThrottledWSocket.TriggerSessionConnectedSpecial(Error: Word);

    10655. 

  10655. begin

    10656. 

  10656.     { Turn on the throttle early, inherited TriggerSessionConnectedSpecial }

    10657. 

  10657.     { might already process the first data chunk.                          }

    10658. 

  10658.     if (Error = 0) then

    10659. 

  10659.         SetBandwidthControl;

    10660. 

  10660.     inherited TriggerSessionConnectedSpecial(Error);

    10661. 

  10661.     if (Error <> 0) and Assigned(FBandwidthTimer) then begin

    10662. 

  10662.         FBandwidthTimer.Enabled := FALSE;

    10663. 

  10663.         FBandwidthEnabled       := FALSE;

    10664. 

  10664.     end;

    10665. 

  10665. end;

    10666. 

  10666. {$ENDIF}

    10667. 

  10667. 

    10668. 

  10668. 

    10669. 

  10669. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    10670. 

  10670. { You must define USE_SSL so that SSL code is included in the component.    }

    10671. 

  10671. { Either in OverbyteIcsDefs.inc or in the project/package options.          }

    10672. 

  10672. {$IFDEF USE_SSL}

    10673. 

  10673. 

    10674. 

  10674. var

    10675. 

  10675.     //GSslInitialized     : Integer = 0;

    10676. 

  10676.     SslRefCount               : Integer = 0;

    10677. 

  10677.     GSslRegisterAllCompleted  : Boolean = FALSE;

    10678. 

  10678. 

    10679. 

  10679. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    10680. 

  10680. (* procedure OutputDebugString(const Msg : String);  angus

    10681. 

  10681. begin

    10682. 

  10682. {$IFDEF DEBUG_OUTPUT}

    10683. 

  10683.         WriteLn(LogFile, Msg {+ ' ThreadID: ' + IntToHex(GetCurrentThreadID, 8)});

    10684. 

  10684.         Flush(LogFile);

    10685. 

  10685. {#$ELSE}

    10686. 

  10686.     //WinProcs.OutputDebugString(PChar(Msg));

    10687. 

  10687. {$ENDIF}

    10688. 

  10688. end;  *)

    10689. 

  10689. 

    10690. 

  10690. 

    10691. 

  10691. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    10692. 

  10692. var TraceCount : Integer = 0;

    10693. 

  10693. (*procedure OutputTrace(const Msg: String);

    10694. 

  10694. begin

    10695. 

  10695.     OutputDebugString(Msg);

    10696. 

  10696.     if TraceCount = 15 then

    10697. 

  10697.          TraceCount := 15;

    10698. 

  10698. end; *)

    10699. 

  10699. 

    10700. 

  10700. 

    10701. 

  10701. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    10702. 

  10702. procedure LoadSsl;

    10703. 

  10703. var

    10704. 

  10704.     Tick : Cardinal;

    10705. 

  10705.     S    : String;

    10706. 

  10706. {$IFDEF LOADSSL_ERROR_FILE} // Optional define in OverbyteIcsSslDefs.inc

    10707. 

  10707.     F    : TextFile;

    10708. 

  10708.     I, J : Integer;

    10709. 

  10709. {$ENDIF}

    10710. 

  10710. begin

    10711. 

  10711.     _EnterCriticalSection(SslCritSect);

    10712. 

  10712.     try

    10713. 

  10713.         if SslRefCount = 0 then begin

    10714. 

  10714.             // Load LIBEAY DLL

    10715. 

  10715.             // Must be loaded before SSlEAY for the versioncheck to work!

    10716. 

  10716.             if not OverbyteIcsLIBEAY.Load then begin

    10717. 

  10717.             {$IFDEF LOADSSL_ERROR_FILE}

    10718. 

  10718.                 AssignFile(F, _ExtractFilePath(ParamStr(0)) + 'FailedIcsLIBEAY.txt');

    10719. 

  10719.                 Rewrite(F);

    10720. 

  10720.                 S := OverbyteIcsLIBEAY.WhichFailedToLoad;

    10721. 

  10721.                 I := 1;

    10722. 

  10722.                 while I < Length(S) do begin

    10723. 

  10723.                     J := I;

    10724. 

  10724.                     while (I <= Length(S)) and (S[I] <> ' ') do

    10725. 

  10725.                         Inc(I);

    10726. 

  10726.                     Inc(I);

    10727. 

  10727.                     WriteLn(F, Copy(S, J, I - J));

    10728. 

  10728.                 end;

    10729. 

  10729.                 CloseFile(F);

    10730. 

  10730.             {$ENDIF}

    10731. 

  10731.                 if OverbyteIcsLIBEAY.GLIBEAY_DLL_Handle <> 0 then begin

    10732. 

  10732.                     _FreeLibrary(OverbyteIcsLIBEAY.GLIBEAY_DLL_Handle);

    10733. 

  10733.                     OverbyteIcsLIBEAY.GLIBEAY_DLL_Handle := 0

    10734. 

  10734.                 end;

    10735. 

  10735.                 raise EIcsLibeayException.Create('Unable to load LIBEAY DLL. Can''t find ' + S);

    10736. 

  10736.             end;

    10737. 

  10737.             // Load SSlEAY DLL

    10738. 

  10738.             if not OverbyteIcsSSLEAY.Load then begin

    10739. 

  10739.             {$IFDEF LOADSSL_ERROR_FILE}

    10740. 

  10740.                 AssignFile(F, _ExtractFilePath(ParamStr(0)) + 'FailedIcsSSLEAY.txt');

    10741. 

  10741.                 Rewrite(F);

    10742. 

  10742.                 S := OverbyteIcsSSLEAY.WhichFailedToLoad;

    10743. 

  10743.                 I := 1;

    10744. 

  10744.                 while I < Length(S) do begin

    10745. 

  10745.                     J := I;

    10746. 

  10746.                     while (I <= Length(S)) and (S[I] <> ' ') do

    10747. 

  10747.                         Inc(I);

    10748. 

  10748.                     Inc(I);

    10749. 

  10749.                     WriteLn(F, Copy(S, J, I - J));

    10750. 

  10750.                 end;

    10751. 

  10751.                 CloseFile(F);

    10752. 

  10752.             {$ENDIF}

    10753. 

  10753.                 if OverbyteIcsSSLEAY.GSSLEAY_DLL_Handle <> 0 then begin

    10754. 

  10754.                     _FreeLibrary(OverbyteIcsSSLEAY.GSSLEAY_DLL_Handle);

    10755. 

  10755.                     OverbyteIcsSSLEAY.GSSLEAY_DLL_Handle := 0;

    10756. 

  10756.                 end;

    10757. 

  10757.                 if OverbyteIcsLIBEAY.GLIBEAY_DLL_Handle <> 0 then begin

    10758. 

  10758.                     _FreeLibrary(OverbyteIcsLIBEAY.GLIBEAY_DLL_Handle);

    10759. 

  10759.                     OverbyteIcsLIBEAY.GLIBEAY_DLL_Handle := 0

    10760. 

  10760.                 end;

    10761. 

  10761.                 raise EIcsSsleayException.Create('Unable to load SSLEAY DLL. Can''t find ' + S);

    10762. 

  10762.             end;

    10763. 

  10763. 

    10764. 

  10764.             // Global system initialization

    10765. 

  10765.             if f_SSL_library_init <> 1 then begin

    10766. 

  10766.                 if OverbyteIcsSSLEAY.GSSLEAY_DLL_Handle <> 0 then begin

    10767. 

  10767.                     _FreeLibrary(OverbyteIcsSSLEAY.GSSLEAY_DLL_Handle);

    10768. 

  10768.                     OverbyteIcsSSLEAY.GSSLEAY_DLL_Handle := 0;

    10769. 

  10769.                 end;

    10770. 

  10770.                 if OverbyteIcsLIBEAY.GLIBEAY_DLL_Handle <> 0 then begin

    10771. 

  10771.                     _FreeLibrary(OverbyteIcsLIBEAY.GLIBEAY_DLL_Handle);

    10772. 

  10772.                     OverbyteIcsLIBEAY.GLIBEAY_DLL_Handle := 0

    10773. 

  10773.                 end;

    10774. 

  10774.             end;

    10775. 

  10775.             f_SSL_load_error_strings;

    10776. 

  10776.             Tick := _GetTickCount;           // probably weak

    10777. 

  10777.             f_RAND_seed(@Tick, SizeOf(Tick));

    10778. 

  10778.         {$IFNDEF OPENSSL_NO_ENGINE}

    10779. 

  10779.             //* Load all bundled ENGINEs into memory and make them visible */

    10780. 

  10780.             f_ENGINE_load_builtin_engines;

    10781. 

  10781.         {$ENDIF}

    10782. 

  10782.         end; // SslRefCount = 0

    10783. 

  10783.         Inc(SslRefCount);

    10784. 

  10784.     finally

    10785. 

  10785.         _LeaveCriticalSection(SslCritSect);

    10786. 

  10786.     end;

    10787. 

  10787. end;

    10788. 

  10788. 

    10789. 

  10789. 

    10790. 

  10790. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    10791. 

  10791. { Reminder:

    10792. 

  10792.   /* thread-local cleanup */

    10793. 

  10793.   ERR_remove_state(0);

    10794. 

  10794. 

    10795. 

  10795.   /* thread-safe cleanup */

    10796. 

  10796.   ENGINE_cleanup();

    10797. 

  10797.   CONF_modules_unload(1);

    10798. 

  10798. 

    10799. 

  10799.   /* global application exit cleanup (after all SSL activity is shutdown) */

    10800. 

  10800.   ERR_free_strings();

    10801. 

  10801.   EVP_cleanup();

    10802. 

  10802.   CRYPTO_cleanup_all_ex_data();

    10803. 

  10803. }

    10804. 

  10804. procedure UnloadSsl;

    10805. 

  10805. begin

    10806. 

  10806.     _EnterCriticalSection(SslCritSect);

    10807. 

  10807.     try

    10808. 

  10808.         if SslRefCount > 0 then        {AG 12/30/07}

    10809. 

  10809.             Dec(SslRefCount);

    10810. 

  10810.         if SslRefCount = 0 then begin  {AG 12/30/07}

    10811. 

  10811. 

    10812. 

  10812.             //* thread-local cleanup */

    10813. 

  10813.             f_ERR_remove_state(0);

    10814. 

  10814. 

    10815. 

  10815.             //* thread-safe cleanup */

    10816. 

  10816.             f_CONF_modules_unload(1);

    10817. 

  10817.         {$IFNDEF OPENSSL_NO_ENGINE}

    10818. 

  10818.             f_ENGINE_cleanup;

    10819. 

  10819.         {$ENDIF}

    10820. 

  10820. 

    10821. 

  10821.             //* global application exit cleanup (after all SSL activity is shutdown) */

    10822. 

  10822.             f_ERR_free_strings;

    10823. 

  10823.             f_EVP_cleanup;

    10824. 

  10824.             f_CRYPTO_cleanup_all_ex_data;

    10825. 

  10825. 

    10826. 

  10826.             if OverbyteIcsSSLEAY.GSSLEAY_DLL_Handle <> 0 then begin

    10827. 

  10827.                 _FreeLibrary(OverbyteIcsSSLEAY.GSSLEAY_DLL_Handle);

    10828. 

  10828.                 OverbyteIcsSSLEAY.GSSLEAY_DLL_Handle := 0;

    10829. 

  10829.             end;

    10830. 

  10830.             if OverbyteIcsLIBEAY.GLIBEAY_DLL_Handle <> 0 then begin

    10831. 

  10831.                 _FreeLibrary(OverbyteIcsLIBEAY.GLIBEAY_DLL_Handle);

    10832. 

  10832.                 OverbyteIcsLIBEAY.GLIBEAY_DLL_Handle := 0

    10833. 

  10833.             end;

    10834. 

  10834.         end;

    10835. 

  10835.     finally

    10836. 

  10836.         _LeaveCriticalSection(SslCritSect);

    10837. 

  10837.     end;

    10838. 

  10838. end;

    10839. 

  10839. 

    10840. 

  10840. 

    10841. 

  10841. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    10842. 

  10842. function SslErrorToStr(Err: Integer): String;

    10843. 

  10843. begin

    10844. 

  10844.     case Err of

    10845. 

  10845.         SSL_ERROR_ZERO_RETURN      :  Result := 'SSL_ERROR_ZERO_RETURN';  // A closure alert has occurred in the protocol

    10846. 

  10846.         SSL_ERROR_WANT_CONNECT     :  Result := 'SSL_ERROR_WANT_CONNECT';

    10847. 

  10847.         SSL_ERROR_WANT_ACCEPT      :  Result := 'SSL_ERROR_WANT_ACCEPT';

    10848. 

  10848.         SSL_ERROR_WANT_READ        :  Result := 'SSL_ERROR_WANT_READ';

    10849. 

  10849.         SSL_ERROR_WANT_WRITE       :  Result := 'SSL_ERROR_WANT_WRITE';

    10850. 

  10850.         SSL_ERROR_WANT_X509_LOOKUP :  Result := 'SSL_ERROR_WANT_X509_LOOKUP';

    10851. 

  10851.         SSL_ERROR_SYSCALL          :  Result := 'SSL_ERROR_SYSCALL';

    10852. 

  10852.         SSL_ERROR_SSL              :  Result := 'SSL_ERROR_SSL';

    10853. 

  10853.         else

    10854. 

  10854.             Result := 'Unknown';

    10855. 

  10855.     end;

    10856. 

  10856. end;

    10857. 

  10857. 

    10858. 

  10858. 

    10859. 

  10859. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    10860. 

  10860. function print_errors: AnsiString;

    10861. 

  10861. var

    10862. 

  10862.     Flags    : Integer;

    10863. 

  10863.     Line     : Integer;

    10864. 

  10864.     Data     : PAnsiChar;

    10865. 

  10865.     FileName : PAnsiChar;

    10866. 

  10866.     ErrCode  : Cardinal;

    10867. 

  10867. begin

    10868. 

  10868.     result := '' ;

    10869. 

  10869.     ErrCode := f_ERR_get_error_line_data(@FileName, @Line, @Data, @Flags);

    10870. 

  10870.     while ErrCode <> 0 do begin

    10871. 

  10871.         if Result <> '' then Result := Result + #13#10;

    10872. 

  10872.         Result := Result + 'error code: ' + IcsIntToStrA(ErrCode) +

    10873. 

  10873.                           ' in ' + FileName + ' line ' + IcsIntToStrA(line);

    10874. 

  10874.         if (Data <> nil) and ((Flags and ERR_TXT_STRING) <> 0) then

    10875. 

  10875.                 Result := Result + #13#10 + 'error data: ' + _StrPas(Data);

    10876. 

  10876.         ErrCode := f_ERR_get_error_line_data(@FileName, @Line, @Data, @Flags);

    10877. 

  10877.     end;

    10878. 

  10878. end;

    10879. 

  10879. 

    10880. 

  10880. 

    10881. 

  10881. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    10882. 

  10882. function print_error: AnsiString;

    10883. 

  10883. var

    10884. 

  10884.     ErrCode : Integer;

    10885. 

  10885. begin

    10886. 

  10886.     ErrCode := f_ERR_peek_error;

    10887. 

  10887.     SetLength(result, 255);

    10888. 

  10888.     f_ERR_error_string_n(ErrCode, PAnsiChar(Result), Length(Result));

    10889. 

  10889.     SetLength(Result, _StrLen(PAnsiChar(Result)));

    10890. 

  10890. end;

    10891. 

  10891. 

    10892. 

  10892. 

    10893. 

  10893. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    10894. 

  10894. function OpenSslErrMsg(const AErrCode: LongWord): String;

    10895. 

  10895. var

    10896. 

  10896.     Buf : AnsiString;

    10897. 

  10897. begin

    10898. 

  10898.     SetLength(Buf, 127);

    10899. 

  10899.     f_ERR_error_string_n(AErrCode, PAnsiChar(Buf), Length(Buf));

    10900. 

  10900.     SetLength(Buf, _StrLen(PAnsiChar(Buf)));

    10901. 

  10901.     Result := String(Buf);

    10902. 

  10902. end;

    10903. 

  10903. 

    10904. 

  10904. 

    10905. 

  10905. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    10906. 

  10906. function LastOpenSslErrMsg(Dump: Boolean): AnsiString;

    10907. 

  10907. var

    10908. 

  10908.     ErrMsg  : AnsiString;

    10909. 

  10909.     ErrCode : Integer;

    10910. 

  10910. begin

    10911. 

  10911.     ErrCode := f_ERR_get_error;

    10912. 

  10912.     SetLength(Result, 120);

    10913. 

  10913.     f_ERR_error_string_n(ErrCode, PAnsiChar(Result), Length(Result));

    10914. 

  10914.     SetLength(Result, _StrLen(PAnsiChar(Result)));

    10915. 

  10915.     if Dump then begin

    10916. 

  10916.         ErrCode := f_ERR_get_error;

    10917. 

  10917.         while ErrCode <> 0 do begin

    10918. 

  10918.             SetLength(ErrMsg, 120);

    10919. 

  10919.             f_ERR_error_string_n(ErrCode, PAnsiChar(ErrMsg), Length(ErrMsg));

    10920. 

  10920.             SetLength(ErrMsg, _StrLen(PAnsiChar(ErrMsg)));

    10921. 

  10921.             Result := Result + #13#10 + ErrMsg;

    10922. 

  10922.             ErrCode := f_ERR_get_error;

    10923. 

  10923.         end;

    10924. 

  10924.     end;

    10925. 

  10925. end;

    10926. 

  10926. 

    10927. 

  10927. 

    10928. 

  10928. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    10929. 

  10929. procedure TSslBaseComponent.RaiseLastOpenSslError(

    10930. 

  10930.     EClass          : ExceptClass;

    10931. 

  10931.     Dump            : Boolean = FALSE;

    10932. 

  10932.     const CustomMsg : String  = '');

    10933. 

  10933. begin

    10934. 

  10934.     FLastSslError := f_ERR_peek_error;

    10935. 

  10935.     if Length(CustomMsg) > 0 then

    10936. 

  10936.         raise EClass.Create(#13#10 + CustomMsg + #13#10 +

    10937. 

  10937.                             String(LastOpenSslErrMsg(Dump)) + #13#10)

    10938. 

  10938.     else

    10939. 

  10939.         raise EClass.Create(#13#10 + String(LastOpenSslErrMsg(Dump)) + #13#10);

    10940. 

  10940. end;

    10941. 

  10941. 

    10942. 

  10942. 

    10943. 

  10943. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    10944. 

  10944. constructor TSslBaseComponent.Create(AOwner: TComponent);

    10945. 

  10945. begin

    10946. 

  10946.     inherited Create(AOwner);

    10947. 

  10947.     FLastSslError   := 0;

    10948. 

  10948.     FSslInitialized := FALSE;

    10949. 

  10949. end;

    10950. 

  10950. 

    10951. 

  10951. 

    10952. 

  10952. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    10953. 

  10953. destructor TSslBaseComponent.Destroy;

    10954. 

  10954. begin

    10955. 

  10955.     FinalizeSsl;

    10956. 

  10956.     inherited Destroy;

    10957. 

  10957. end;

    10958. 

  10958. 

    10959. 

  10959. 

    10960. 

  10960. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    10961. 

  10961. procedure TSslBaseComponent.FinalizeSsl;

    10962. 

  10962. begin

    10963. 

  10963.     if not FSslInitialized then

    10964. 

  10964.         Exit;

    10965. 

  10965.     UnloadSsl;

    10966. 

  10966.     FSslInitialized := FALSE;

    10967. 

  10967. end;

    10968. 

  10968. 

    10969. 

  10969. 

    10970. 

  10970. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    10971. 

  10971. procedure TSslBaseComponent.InitializeSsl;

    10972. 

  10972. begin

    10973. 

  10973.     if FSslInitialized then

    10974. 

  10974.         Exit;

    10975. 

  10975.     LoadSsl;

    10976. 

  10976.     FSslInitialized := TRUE;

    10977. 

  10977. end;

    10978. 

  10978. 

    10979. 

  10979. 

    10980. 

  10980. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}  { V5.21 }

    10981. 

  10981. {$IFNDEF NO_DEBUG_LOG}

    10982. 

  10982. function TSslBaseComponent.CheckLogOptions(const LogOption: TLogOption): Boolean;

    10983. 

  10983. begin

    10984. 

  10984.     Result := Assigned(FIcsLogger) and (LogOption in FIcsLogger.LogOptions);

    10985. 

  10985. end;

    10986. 

  10986. 

    10987. 

  10987. 

    10988. 

  10988. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    10989. 

  10989. procedure TSslBaseComponent.DebugLog(LogOption: TLogOption; const Msg: String);

    10990. 

  10990. begin

    10991. 

  10991.     if Assigned(FIcsLogger) then

    10992. 

  10992.         {if loAddStamp in FIcsLogger.LogOptions then

    10993. 

  10993.             FIcsLogger.DoDebugLog(Self, LogOption,

    10994. 

  10994.                                   IcsLoggerAddTimeStamp + ' ' + Msg)

    10995. 

  10995.         else}

    10996. 

  10996.         FIcsLogger.DoDebugLog(Self, LogOption, Msg);

    10997. 

  10997. end;

    10998. 

  10998. 

    10999. 

  10999. 

    11000. 

  11000. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    11001. 

  11001. procedure TSslBaseComponent.Notification(

    11002. 

  11002.     AComponent : TComponent;

    11003. 

  11003.     Operation  : TOperation);

    11004. 

  11004. begin

    11005. 

  11005.     inherited Notification(AComponent, Operation);

    11006. 

  11006.     if Operation = opRemove then begin

    11007. 

  11007.         if AComponent = FIcsLogger then

    11008. 

  11008.             FIcsLogger := nil;

    11009. 

  11009.     end;

    11010. 

  11010. end;

    11011. 

  11011. 

    11012. 

  11012. 

    11013. 

  11013. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    11014. 

  11014. procedure TSslBaseComponent.SetIcsLogger(const Value: TIcsLogger);

    11015. 

  11015. begin

    11016. 

  11016.     FIcsLogger := Value;

    11017. 

  11017.     if Value <> nil then

    11018. 

  11018.         Value.FreeNotification(Self);

    11019. 

  11019. end;

    11020. 

  11020. {$ENDIF}

    11021. 

  11021. 

    11022. 

  11022. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    11023. 

  11023. constructor TX509List.Create(AOwner: TComponent);

    11024. 

  11024. begin

    11025. 

  11025.     inherited Create;

    11026. 

  11026.     FOwner            := AOwner;

    11027. 

  11027.     FX509Class        := TX509Base;

    11028. 

  11028.     FList             := TComponentList.Create;

    11029. 

  11029.     FList.OwnsObjects := TRUE;

    11030. 

  11030. end;

    11031. 

  11031. 

    11032. 

  11032. 

    11033. 

  11033. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    11034. 

  11034. destructor TX509List.Destroy;

    11035. 

  11035. begin

    11036. 

  11036.     _FreeAndNil(FList);

    11037. 

  11037.     inherited Destroy;

    11038. 

  11038. end;

    11039. 

  11039. 

    11040. 

  11040. 

    11041. 

  11041. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    11042. 

  11042. procedure TX509List.Clear;

    11043. 

  11043. begin

    11044. 

  11044.     FList.Clear;

    11045. 

  11045. end;

    11046. 

  11046. 

    11047. 

  11047. 

    11048. 

  11048. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    11049. 

  11049. procedure TX509List.Delete(const Index: Integer);

    11050. 

  11050. begin

    11051. 

  11051.     FList.Delete(Index);

    11052. 

  11052. end;

    11053. 

  11053. 

    11054. 

  11054. 

    11055. 

  11055. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    11056. 

  11056. function TX509List.GetByHash(const Sha1Hash: AnsiString): TX509Base;

    11057. 

  11057. var

    11058. 

  11058.     I : Integer;

    11059. 

  11059. begin

    11060. 

  11060.     for I := 0 to FList.Count -1 do begin

    11061. 

  11061.         if not Assigned(FList[I]) then

    11062. 

  11062.             Continue;

    11063. 

  11063.         Result := TX509Base(FList[I]);

    11064. 

  11064.         if _CompareStr(Result.Sha1Hash, Sha1Hash) = 0 then

    11065. 

  11065.             Exit;

    11066. 

  11066.     end;

    11067. 

  11067.     Result := nil;

    11068. 

  11068. end;

    11069. 

  11069. 

    11070. 

  11070. 

    11071. 

  11071. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    11072. 

  11072. function TX509List.GetCount: Integer;

    11073. 

  11073. begin

    11074. 

  11074.     Result := FList.Count;

    11075. 

  11075. end;

    11076. 

  11076. 

    11077. 

  11077. 

    11078. 

  11078. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    11079. 

  11079. function TX509List.GetX509Base(Index: Integer): TX509Base;

    11080. 

  11080. begin

    11081. 

  11081.     Result := TX509Base(FList[Index]);

    11082. 

  11082. end;

    11083. 

  11083. 

    11084. 

  11084. 

    11085. 

  11085. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    11086. 

  11086. function TX509List.IndexOf(const X509Base: TX509Base): Integer;

    11087. 

  11087. begin

    11088. 

  11088.     Result := FList.IndexOf(X509Base);

    11089. 

  11089. end;

    11090. 

  11090. 

    11091. 

  11091. 

    11092. 

  11092. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    11093. 

  11093. procedure TX509List.SetX509Base(Index: Integer; Value: TX509Base);

    11094. 

  11094. var

    11095. 

  11095.     X : TX509Base;

    11096. 

  11096. begin

    11097. 

  11097.     X := TX509Base(FList[Index]);

    11098. 

  11098.     if Assigned(X) then

    11099. 

  11099.         X.Free;

    11100. 

  11100.     FList[Index] := Value;

    11101. 

  11101. end;

    11102. 

  11102. 

    11103. 

  11103. 

    11104. 

  11104. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    11105. 

  11105. function TX509List.Add(X509: PX509 = nil): TX509Base;

    11106. 

  11106. begin

    11107. 

  11107.     Result := FX509Class.Create(FOwner, X509);

    11108. 

  11108.     FList.Add(Result);

    11109. 

  11109. end;

    11110. 

  11110. 

    11111. 

  11111. 

    11112. 

  11112. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    11113. 

  11113. function TX509List.GetByPX509(const X509: PX509): TX509Base;

    11114. 

  11114. var

    11115. 

  11115.     Len  : Integer;

    11116. 

  11116.     Hash : AnsiString;

    11117. 

  11117. begin

    11118. 

  11118.     if Assigned(X509) then begin

    11119. 

  11119.         Len := 20;

    11120. 

  11120.         SetLength(Hash, Len);

    11121. 

  11121.         f_X509_digest(X509, f_EVP_sha1, PAnsiChar(Hash), @Len);

    11122. 

  11122.         SetLength(Hash, _StrLen(PAnsiChar(Hash)));

    11123. 

  11123.         Result := GetByHash(Hash);

    11124. 

  11124.     end

    11125. 

  11125.     else

    11126. 

  11126.         Result := nil;

    11127. 

  11127. end;

    11128. 

  11128. 

    11129. 

  11129. 

    11130. 

  11130. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    11131. 

  11131. { TSslEngine }

    11132. 

  11132. 

    11133. 

  11133. {$IFNDEF OPENSSL_NO_ENGINE}

    11134. 

  11134. 

    11135. 

  11135. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    11136. 

  11136. procedure TSslEngine.Close;

    11137. 

  11137. begin

    11138. 

  11138.     try

    11139. 

  11139.         case FState of

    11140. 

  11140.             esInit : f_ENGINE_finish(FEngine); // release the functional reference

    11141. 

  11141.             esOpen : f_ENGINE_free(FEngine); // release the structural reference

    11142. 

  11142.             else

    11143. 

  11143.                 Exit;

    11144. 

  11144.         end;

    11145. 

  11145.         FEngine := nil;

    11146. 

  11146.         FState  := esClosed;

    11147. 

  11147.     except

    11148. 

  11148.         FEngine := nil;

    11149. 

  11149.         FState  := esClosed;

    11150. 

  11150.         raise;

    11151. 

  11151.     end;

    11152. 

  11152. end;

    11153. 

  11153. 

    11154. 

  11154. 

    11155. 

  11155. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    11156. 

  11156. function TSslEngine.Control(const Cmd, Arg: String): Boolean;

    11157. 

  11157. var

    11158. 

  11158.     PArg : PAnsiChar;

    11159. 

  11159.     Msg  : String;

    11160. 

  11160. begin

    11161. 

  11161.     if FState = esClosed then

    11162. 

  11162.         raise ESslEngineError.Create('Cannot control a closed engine');

    11163. 

  11163.         

    11164. 

  11164.     if _CompareStr(Cmd, 'INIT') = 0 then // special ICS control command 

    11165. 

  11165.     begin

    11166. 

  11166.         Result := Init;

    11167. 

  11167.         Exit;

    11168. 

  11168.     end;

    11169. 

  11169. 

    11170. 

  11170.     if Arg = '' then

    11171. 

  11171.     begin

    11172. 

  11172.         PArg := nil;

    11173. 

  11173.         Msg  := _Format('Executing engine control command %s', [Cmd]);

    11174. 

  11174.     end

    11175. 

  11175.     else begin

    11176. 

  11176.         PArg := PAnsiChar(AnsiString(Arg));

    11177. 

  11177.         Msg :=  _Format('Executing engine control command %s:%s', [Cmd, Arg]);

    11178. 

  11178.     end;

    11179. 

  11179. 

    11180. 

  11180.     if f_ENGINE_ctrl_cmd_string(FEngine, PAnsiChar(AnsiString(Cmd)), PArg, 0) = 0 then

    11181. 

  11181.     begin

    11182. 

  11182.         FLastSslError := f_ERR_peek_last_error;

    11183. 

  11183.         FLastErrorMsg := Msg  + ' ' + String(LastOpenSslErrMsg(TRUE));

    11184. 

  11184.         Result        := FALSE;

    11185. 

  11185.     end

    11186. 

  11186.     else begin

    11187. 

  11187.         FLastSslError := 0;

    11188. 

  11188.         FLastErrorMsg := Msg;

    11189. 

  11189.         Result        := TRUE;

    11190. 

  11190.     end;

    11191. 

  11191. end;

    11192. 

  11192. 

    11193. 

  11193. 

    11194. 

  11194. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    11195. 

  11195. destructor TSslEngine.Destroy;

    11196. 

  11196. begin

    11197. 

  11197.     Close;

    11198. 

  11198.     inherited;

    11199. 

  11199. end;

    11200. 

  11200. 

    11201. 

  11201. 

    11202. 

  11202. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    11203. 

  11203. function TSslEngine.Init: Boolean;

    11204. 

  11204. begin

    11205. 

  11205.     if FState = esClosed then

    11206. 

  11206.         raise ESslEngineError.Create('Cannot initialize a closed engine');

    11207. 

  11207.     FLastErrorMsg := 'Engine ' + FNameID + 'initialized';

    11208. 

  11208.     FLastSslError := 0;

    11209. 

  11209.     Result        := TRUE;

    11210. 

  11210.     if FState = esInit then

    11211. 

  11211.         Exit;

    11212. 

  11212.     if f_ENGINE_init(FEngine) = 0 then

    11213. 

  11213.     begin

    11214. 

  11214.         FLastSslError := f_ERR_peek_last_error;

    11215. 

  11215.         FLastErrorMsg := 'ENGINE_init'#13#10 + String(LastOpenSslErrMsg(TRUE));

    11216. 

  11216.         Result        := FALSE;

    11217. 

  11217.     end

    11218. 

  11218.     else begin

    11219. 

  11219.         { This should always succeed if 'FEngine' was initialised OK }

    11220. 

  11220.         f_ENGINE_set_default(FEngine, ENGINE_METHOD_ALL);

    11221. 

  11221.         FState := esInit;

    11222. 

  11222.         f_ENGINE_free(FEngine); // release the structural reference

    11223. 

  11223.     end;

    11224. 

  11224. end;

    11225. 

  11225. 

    11226. 

  11226. 

    11227. 

  11227. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    11228. 

  11228. function TSslEngine.Open: Boolean;

    11229. 

  11229. begin

    11230. 

  11230.     InitializeSsl;

    11231. 

  11231.     {if _CompareStr(FNameID, 'auto') = 0 then

    11232. 

  11232.     begin

    11233. 

  11233.         f_ENGINE_register_all_complete;

    11234. 

  11234.         FLastErrorMsg := 'Auto engine support enabled';

    11235. 

  11235.         Result := TRUE;

    11236. 

  11236.         Exit;

    11237. 

  11237.     end;}

    11238. 

  11238. 

    11239. 

  11239.     Close; // close the previous one (if assigned) 

    11240. 

  11240.     FEngine := f_ENGINE_by_id(PAnsiChar(AnsiString(FNameID)));

    11241. 

  11241. 

    11242. 

  11242.     if FEngine = nil then

    11243. 

  11243.     begin

    11244. 

  11244.         FLastSslError := f_ERR_peek_last_error;

    11245. 

  11245.         FLastErrorMsg := String(LastOpenSslErrMsg(TRUE));

    11246. 

  11246.         Result        := FALSE;

    11247. 

  11247.     end

    11248. 

  11248.     else begin

    11249. 

  11249.         FState := esOpen;

    11250. 

  11250.         Result := TRUE;

    11251. 

  11251.     end;

    11252. 

  11252. end;

    11253. 

  11253. 

    11254. 

  11254. 

    11255. 

  11255. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    11256. 

  11256. procedure TSslEngine.SetNameID(const Value: String);

    11257. 

  11257. begin

    11258. 

  11258.     Close;

    11259. 

  11259.     FNameID := Value;

    11260. 

  11260. end;

    11261. 

  11261. 

    11262. 

  11262. 

    11263. 

  11263. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    11264. 

  11264. {$ENDIF OPENSSL_NO_ENGINE}

    11265. 

  11265. 

    11266. 

  11266. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    11267. 

  11267. const

    11268. 

  11268.     SslIntOptions: array[TSslOption] of Integer =                   { V7.30 }

    11269. 

  11269.            (SSL_OP_CIPHER_SERVER_PREFERENCE,

    11270. 

  11270.             SSL_OP_MICROSOFT_SESS_ID_BUG,

    11271. 

  11271.             SSL_OP_NETSCAPE_CHALLENGE_BUG,

    11272. 

  11272.             SSL_OP_NETSCAPE_REUSE_CIPHER_CHANGE_BUG,

    11273. 

  11273.             SSL_OP_SSLREF2_REUSE_CERT_TYPE_BUG,

    11274. 

  11274.             SSL_OP_MICROSOFT_BIG_SSLV3_BUFFER,

    11275. 

  11275.             SSL_OP_MSIE_SSLV2_RSA_PADDING,

    11276. 

  11276.             SSL_OP_SSLEAY_080_CLIENT_DH_BUG,

    11277. 

  11277.             SSL_OP_TLS_D5_BUG,

    11278. 

  11278.             SSL_OP_TLS_BLOCK_PADDING_BUG,

    11279. 

  11279.             SSL_OP_TLS_ROLLBACK_BUG,

    11280. 

  11280.             SSL_OP_DONT_INSERT_EMPTY_FRAGMENTS,

    11281. 

  11281.             SSL_OP_SINGLE_DH_USE,

    11282. 

  11282.             SSL_OP_EPHEMERAL_RSA,

    11283. 

  11283.             SSL_OP_NO_SSLv2,

    11284. 

  11284.             SSL_OP_NO_SSLv3,

    11285. 

  11285.             SSL_OP_NO_TLSv1,

    11286. 

  11286.             SSL_OP_PKCS1_CHECK_1,

    11287. 

  11287.             SSL_OP_PKCS1_CHECK_2,

    11288. 

  11288.             SSL_OP_NETSCAPE_CA_DN_BUG,

    11289. 

  11289.             SSL_OP_NO_SESSION_RESUMPTION_ON_RENEGOTIATION,

    11290. 

  11290.             SSL_OP_NETSCAPE_DEMO_CIPHER_CHANGE_BUG,

    11291. 

  11291.             SSL_OP_ALLOW_UNSAFE_LEGACY_RENEGOTIATION); // Since OSSL 0.9.8n

    11292. 

  11292. 

    11293. 

  11293.   SslIntSessCacheModes: array[TSslSessCacheMode] of Integer =     { V7.30 }

    11294. 

  11294.             (SSL_SESS_CACHE_CLIENT,

    11295. 

  11295.              SSL_SESS_CACHE_SERVER,

    11296. 

  11296.              SSL_SESS_CACHE_NO_AUTO_CLEAR,

    11297. 

  11297.              SSL_SESS_CACHE_NO_INTERNAL_LOOKUP,

    11298. 

  11298.              SSL_SESS_CACHE_NO_INTERNAL_STORE);

    11299. 

  11299. 

    11300. 

  11300. constructor TSslContext.Create(AOwner: TComponent);

    11301. 

  11301. begin

    11302. 

  11302.     inherited Create(AOwner);

    11303. 

  11303. {$IFNDEF NO_SSL_MT}

    11304. 

  11304.     _InitializeCriticalSection(FLock);

    11305. 

  11305. {$ENDIF}

    11306. 

  11306.     FSslCtx := nil;

    11307. 

  11307.     SetSslVerifyPeerModes([SslVerifyMode_PEER]);

    11308. 

  11308.     SetSslCipherList('ALL:!ADH:RC4+RSA:+SSLv2:@STRENGTH');

    11309. 

  11309.     FSslVersionMethod    := sslV23;

    11310. 

  11310.     SslVerifyDepth       := 9;

    11311. 

  11311.     FSslSessionTimeOut   := 0; // OSSL-default

    11312. 

  11312.     FSslSessionCacheSize := SSL_SESSION_CACHE_MAX_SIZE_DEFAULT;

    11313. 

  11313. end;

    11314. 

  11314. 

    11315. 

  11315. 

    11316. 

  11316. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    11317. 

  11317. destructor TSslContext.Destroy;

    11318. 

  11318. begin

    11319. 

  11319.     DeInitContext;

    11320. 

  11320. {$IFNDEF NO_SSL_MT}

    11321. 

  11321.     _DeleteCriticalSection(FLock);

    11322. 

  11322. {$ENDIF}

    11323. 

  11323.     inherited Destroy;

    11324. 

  11324. end;

    11325. 

  11325. 

    11326. 

  11326. 

    11327. 

  11327. (*

    11328. 

  11328. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    11329. 

  11329. procedure TSslContext.TriggerDebugLog (LogOption: TLogOption;   { V5.21 }

    11330. 

  11330.                                                  const Msg, Data: String);

    11331. 

  11331. var

    11332. 

  11332.     S: String;

    11333. 

  11333. begin

    11334. 

  11334.     if loOptStamp in FLogOptions then

    11335. 

  11335.         S := WSocketAddTimeStamp + ' ' + Msg

    11336. 

  11336.     else

    11337. 

  11337.         S := Msg;

    11338. 

  11338.     if loOptEvent in FLogOptions then begin

    11339. 

  11339.         if Assigned (FOnIcsLogEvent) then

    11340. 

  11340.                         FOnIcsLogEvent(Self, LogOption, S, '');

    11341. 

  11341.     end;

    11342. 

  11342.     if loOptOutDebug in FLogOptions then OutputDebugString(Pchar(S));

    11343. 

  11343.     if loOptFile in FLogOptions then begin

    11344. 

  11344.         if WSocketOpenLogFile then WriteLn(WSocketLogFile, S);

    11345. 

  11345.     end;

    11346. 

  11346. end;     *)

    11347. 

  11347. 

    11348. 

  11348. 

    11349. 

  11349. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    11350. 

  11350. function TSslContext.InitializeCtx: PSSL_CTX;

    11351. 

  11351. var

    11352. 

  11352.     Meth : PSSL_METHOD;

    11353. 

  11353. begin

    11354. 

  11354.     case FSslVersionMethod of

    11355. 

  11355.     sslV2:            Meth := f_SSLv2_method;

    11356. 

  11356.     sslV2_CLIENT:     Meth := f_SSLv2_client_method;

    11357. 

  11357.     sslV2_SERVER:     Meth := f_SSLv2_server_method;

    11358. 

  11358.     sslV3:            Meth := f_SSLv3_method;

    11359. 

  11359.     sslV3_CLIENT:     Meth := f_SSLv3_client_method;

    11360. 

  11360.     sslV3_SERVER:     Meth := f_SSLv3_server_method;

    11361. 

  11361.     sslTLS_V1:        Meth := f_TLSv1_method;

    11362. 

  11362.     sslTLS_V1_CLIENT: Meth := f_TLSv1_client_method;

    11363. 

  11363.     sslTLS_V1_SERVER: Meth := f_TLSv1_server_method;

    11364. 

  11364.     sslV23:           Meth := f_SSLv23_method;

    11365. 

  11365.     sslV23_CLIENT:    Meth := f_SSLv23_client_method;

    11366. 

  11366.     sslV23_SERVER:    Meth := f_SSLv23_server_method;

    11367. 

  11367.     else              raise ESslContextException.Create('Unknown SslVersionMethod');

    11368. 

  11368.     end;

    11369. 

  11369.     Result := f_SSL_CTX_new(Meth);

    11370. 

  11370. end;

    11371. 

  11371. 

    11372. 

  11372. 

    11373. 

  11373. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    11374. 

  11374. function TSslContext.GetIsCtxInitialized : Boolean;

    11375. 

  11375. begin

    11376. 

  11376.     Result := FSslCtx <> nil;

    11377. 

  11377. end;

    11378. 

  11378. 

    11379. 

  11379. 

    11380. 

  11380. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    11381. 

  11381. function TSslContext.TrustCert(Cert: TX509Base): Boolean;

    11382. 

  11382. var

    11383. 

  11383.     St : PX509_STORE;

    11384. 

  11384. begin

    11385. 

  11385. {$IFNDEF NO_SSL_MT}

    11386. 

  11386.     Lock;

    11387. 

  11387.     try

    11388. 

  11388. {$ENDIF}

    11389. 

  11389.         Result := FALSE;

    11390. 

  11390.         if (not Assigned(FSslCtx)) then

    11391. 

  11391.             raise ESslContextException.Create(msgSslCtxNotInit);

    11392. 

  11392.         if (not Assigned(Cert)) or (not Assigned(Cert.X509)) then

    11393. 

  11393.             Exit;

    11394. 

  11394.         //St := nil;

    11395. 

  11395.         St := f_SSL_CTX_get_cert_store(FSslCtx);

    11396. 

  11396.         if Assigned(St) then

    11397. 

  11397.             Result := f_X509_STORE_add_cert(St, Cert.X509) <> 0;

    11398. 

  11398.         { Fails if cert exists in store }

    11399. 

  11399. {$IFNDEF NO_DEBUG_LOG}

    11400. 

  11400.         if (not Result) and

    11401. 

  11401.             CheckLogOptions(loSslErr) then  { V5.21 } { replaces $IFDEF DEBUG_OUTPUT  }

    11402. 

  11402.             DebugLog(loSslErr, String(LastOpenSslErrMsg(TRUE)));

    11403. 

  11403. {$ELSE}

    11404. 

  11404.         if (not Result) then

    11405. 

  11405.             f_ERR_clear_error;

    11406. 

  11406. {$ENDIF}

    11407. 

  11407. {$IFNDEF NO_SSL_MT}    

    11408. 

  11408.     finally

    11409. 

  11409.         Unlock;

    11410. 

  11410.     end;

    11411. 

  11411. {$ENDIF}

    11412. 

  11412. end;

    11413. 

  11413. 

    11414. 

  11414. 

    11415. 

  11415. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    11416. 

  11416. function PasswordCallBack(

    11417. 

  11417.     Buf      : PAnsiChar;

    11418. 

  11418.     Num      : Integer;

    11419. 

  11419.     RWFlag   : Integer;

    11420. 

  11420.     UserData : Pointer) : Integer; cdecl;

    11421. 

  11421. var

    11422. 

  11422.     Obj : TSslContext;

    11423. 

  11423.     SslPassPhraseA : AnsiString;

    11424. 

  11424. begin

    11425. 

  11425. {$IFNDEF NO_SSL_MT}

    11426. 

  11426.     _EnterCriticalSection(LockPwdCB);

    11427. 

  11427.     try

    11428. 

  11428. {$ENDIF}

    11429. 

  11429.         Obj := TSslContext(UserData);

    11430. 

  11430.         if (Num < (Length(Obj.SslPassPhrase) + 1)) or

    11431. 

  11431.            (Length(Obj.SslPassPhrase) = 0) then

    11432. 

  11432.             Result := 0

    11433. 

  11433.         else begin

    11434. 

  11434.             SslPassPhraseA := AnsiString(Obj.SslPassPhrase);

    11435. 

  11435.             Move(Pointer(SslPassPhraseA)^, Buf^, Length(SslPassPhraseA) + 1);

    11436. 

  11436.             Result := Length(SslPassPhraseA);

    11437. 

  11437.         end;

    11438. 

  11438. {$IFNDEF NO_SSL_MT}

    11439. 

  11439.     finally

    11440. 

  11440.         _LeaveCriticalSection(LockPwdCB);

    11441. 

  11441.     end;

    11442. 

  11442. {$ENDIF}

    11443. 

  11443. end;

    11444. 

  11444. 

    11445. 

  11445. 

    11446. 

  11446. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    11447. 

  11447. {$IFNDEF OPENSSL_NO_ENGINE}

    11448. 

  11448. function PinCallback(ui: PUI; uis: PUI_STRING): Integer; cdecl;

    11449. 

  11449. var

    11450. 

  11450.     Obj : TSslContext;

    11451. 

  11451. begin

    11452. 

  11452. {$IFNDEF NO_SSL_MT}

    11453. 

  11453.     _EnterCriticalSection(LockPwdCB);

    11454. 

  11454.     try

    11455. 

  11455. {$ENDIF}

    11456. 

  11456.         Obj := TSslContext(f_Ics_UI_get_app_data(ui));

    11457. 

  11457.         f_UI_set_result(ui, uis, PAnsiChar(AnsiString(Obj.FSslPassPhrase)));

    11458. 

  11458.         Result := 1;

    11459. 

  11459. 

    11460. 

  11460. {$IFNDEF NO_SSL_MT}

    11461. 

  11461.     finally

    11462. 

  11462.         _LeaveCriticalSection(LockPwdCB);

    11463. 

  11463.     end;

    11464. 

  11464. {$ENDIF}

    11465. 

  11465. end;

    11466. 

  11466. {$ENDIF}

    11467. 

  11467. 

    11468. 

  11468. 

    11469. 

  11469. 

    11470. 

  11470. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    11471. 

  11471. function PeerVerifyCallback(

    11472. 

  11472.     Ok       : Integer;

    11473. 

  11473.     StoreCtx : PX509_STORE_CTX) : Integer; cdecl;

    11474. 

  11474. var

    11475. 

  11475.     MySsl   : PSSL;

    11476. 

  11476.     Obj     : TCustomSslWSocket;

    11477. 

  11477.     Cert    : PX509;

    11478. 

  11478.     CurCert : TX509Base;

    11479. 

  11479. begin

    11480. 

  11480. {$IFNDEF NO_SSL_MT}

    11481. 

  11481.     _EnterCriticalSection(LockVerifyCB);

    11482. 

  11482.     try

    11483. 

  11483. {$ENDIF}

    11484. 

  11484.         // Retrieve the pointer to the SSL of the current connection

    11485. 

  11485.         MySsl := f_X509_STORE_CTX_get_ex_data(

    11486. 

  11486.                                 StoreCtx, f_SSL_get_ex_data_X509_STORE_CTX_idx);

    11487. 

  11487.         // Retrieve the object reference we stored at index 0

    11488. 

  11488.         Obj := TCustomSslWSocket(f_SSL_get_ex_data(MySsl, 0));

    11489. 

  11489.         if Assigned(Obj) then begin

    11490. 

  11490.             Obj.Pause;

    11491. 

  11491.             Obj.FSsl_In_CB := TRUE;

    11492. 

  11492.             try

    11493. 

  11493.                 Cert := f_X509_STORE_CTX_get_current_cert(StoreCtx);

    11494. 

  11494.                 { Lookup this cert in our custom list (chain) }

    11495. 

  11495.                 CurCert := Obj.SslCertChain.GetByPX509(Cert);

    11496. 

  11496.                 { Add it to our list }

    11497. 

  11497.                 if not Assigned(CurCert) then begin

    11498. 

  11498.                     Obj.SslCertChain.X509Class := Obj.X509Class;

    11499. 

  11499.                     CurCert := Obj.SslCertChain.Add(Cert);

    11500. 

  11500.                     CurCert.VerifyResult := f_X509_STORE_CTX_get_error(StoreCtx);

    11501. 

  11501.                     CurCert.FFirstVerifyResult := CurCert.VerifyResult;

    11502. 

  11502.                 end

    11503. 

  11503.                 else { Unfortunately me must overwrite here }

    11504. 

  11504.                     CurCert.VerifyResult := f_X509_STORE_CTX_get_error(StoreCtx);

    11505. 

  11505.                 CurCert.VerifyDepth := f_X509_STORE_CTX_get_error_depth(StoreCtx);

    11506. 

  11506.                 //CurCert.CustomVerifyResult := CurCert.VerifyResult; // don't overwrite

    11507. 

  11507.                 Obj.SslCertChain.FLastVerifyResult := CurCert.VerifyResult;

    11508. 

  11508. {$IFNDEF NO_DEBUG_LOG}

    11509. 

  11509.                 if Obj.CheckLogOptions(loSslInfo) then begin  { V5.21 } { replaces $IFDEF DEBUG_OUTPUT  }

    11510. 

  11510.                     Obj.DebugLog(loSslInfo,'VCB> VerifyPeer: Subject = '  + CurCert.SubjectOneLine);

    11511. 

  11511.                     Obj.DebugLog(loSslInfo,'VCB> VerifyPeer: Serial  = $' + _IntToHex(CurCert.SerialNum, 8));

    11512. 

  11512.                     Obj.DebugLog(loSslInfo,'VCB> VerifyPeer: Error   = '  + CurCert.VerifyErrMsg);

    11513. 

  11513.                 end;

    11514. 

  11514. {$ENDIF}

    11515. 

  11515.                 // Save verify result

    11516. 

  11516.                 Obj.FSslVerifyResult := CurCert.VerifyResult;

    11517. 

  11517.                 Obj.TriggerSslVerifyPeer(Ok, CurCert);

    11518. 

  11518.                 if Ok <> 0 then

    11519. 

  11519.                     Obj.FSslVerifyResult := X509_V_OK;

    11520. 

  11520.             finally

    11521. 

  11521.                 Obj.Resume;

    11522. 

  11522.                 Obj.FSsl_In_CB := FALSE;

    11523. 

  11523.                 if Obj.FHSocket = INVALID_SOCKET then

    11524. 

  11524.                     _PostMessage(Obj.FWindowHandle, Obj.FMsg_WM_RESET_SSL, 0, 0);

    11525. 

  11525.             end;

    11526. 

  11526.         end;

    11527. 

  11527.         Result := Ok;

    11528. 

  11528. {$IFNDEF NO_SSL_MT}

    11529. 

  11529.     finally

    11530. 

  11530.         _LeaveCriticalSection(LockVerifyCB);

    11531. 

  11531.     end;

    11532. 

  11532. {$ENDIF}

    11533. 

  11533. end;

    11534. 

  11534. 

    11535. 

  11535. 

    11536. 

  11536. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    11537. 

  11537. procedure RemoveSessionCallback(const Ctx : PSSL_CTX; Sess : PSSL_SESSION); cdecl;

    11538. 

  11538. var

    11539. 

  11539.     Obj : TSslContext;

    11540. 

  11540. begin

    11541. 

  11541.    { If remove_session_cb is not null, it will be called when               }

    11542. 

  11542.    { a session-id is removed from the cache.  After the call,               }

    11543. 

  11543.    { OpenSSL will SSL_SESSION_free() it.                                    }

    11544. 

  11544.    { Also: It is invoked whenever a SSL_SESSION is destroyed.  It is called }

    11545. 

  11545.    { just before the session object is destroyed because it is invalid or   }

    11546. 

  11546.    { has expired.                                                           }

    11547. 

  11547. {$IFNDEF NO_SSL_MT}

    11548. 

  11548.     _EnterCriticalSection(LockRemSessCB);

    11549. 

  11549.     try

    11550. 

  11550. {$ENDIF}                                                             

    11551. 

  11551.         Obj := TSslContext(f_SSL_CTX_get_ex_data(Ctx, 0));

    11552. 

  11552.         if Assigned(Obj) then begin

    11553. 

  11553. {$IFNDEF NO_DEBUG_LOG}

    11554. 

  11554.             if Obj.CheckLogOptions(loSslInfo) then  { V5.21 } { replaces $IFDEF DEBUG_OUTPUT  }

    11555. 

  11555.                 Obj.DebugLog(loSslInfo,'RSCB> Session removed');

    11556. 

  11556. {$ENDIF}

    11557. 

  11557.             if Assigned(Obj.FOnRemoveSession) then

    11558. 

  11558.                 Obj.FOnRemoveSession(Obj, Sess);

    11559. 

  11559.         end;

    11560. 

  11560. {$IFNDEF NO_SSL_MT}

    11561. 

  11561.     finally

    11562. 

  11562.         _LeaveCriticalSection(LockRemSessCB);

    11563. 

  11563.     end;

    11564. 

  11564. {$ENDIF}

    11565. 

  11565. end;

    11566. 

  11566. 

    11567. 

  11567. 

    11568. 

  11568. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    11569. 

  11569. function Ics_EVP_PKEY_dup(PKey: PEVP_PKEY): PEVP_PKEY;

    11570. 

  11570. begin

    11571. 

  11571.     Result := nil;

    11572. 

  11572.     if PKey <> nil then begin

    11573. 

  11573.         _EnterCriticalSection(SslCritSect);

    11574. 

  11574.         try

    11575. 

  11575.             Inc(PKey^.references);

    11576. 

  11576.             Result := PKey;

    11577. 

  11577.         finally

    11578. 

  11578.             _LeaveCriticalSection(SslCritSect);

    11579. 

  11579.         end;

    11580. 

  11580.     end;

    11581. 

  11581. end;

    11582. 

  11582. 

    11583. 

  11583. 

    11584. 

  11584. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    11585. 

  11585. function ClientCertCallback(

    11586. 

  11586.     Ssl     : PSSL;

    11587. 

  11587.     X509    : PPX509;

    11588. 

  11588.     PKEY    : PPEVP_PKEY): Integer; cdecl;

    11589. 

  11589. var

    11590. 

  11590.     Obj  : TCustomSslWSocket;

    11591. 

  11591.     Cert : TX509Base;

    11592. 

  11592.     X, P : Pointer;

    11593. 

  11593. begin

    11594. 

  11594.     { It's called when a client certificate is requested by a server and no    }

    11595. 

  11595.     { certificate was yet set for the SSL object. client_cert_cb() is the      }

    11596. 

  11596.     { application defined callback. If it wants to set a certificate, a        }

    11597. 

  11597.     { certificate/private key combination must be set using the x509 and pkey  }

    11598. 

  11598.     { arguments and ``1'' must be returned. The certificate will be installed  }

    11599. 

  11599.     { into ssl, see the NOTES and BUGS sections. If no certificate should be   }

    11600. 

  11600.     { set, ``0'' has to be returned and no certificate will be sent.           }

    11601. 

  11601.     { A negative return value will suspend the handshake and the handshake     }

    11602. 

  11602.     { function will return immediatly. SSL_get_error(3) will return            }

    11603. 

  11603.     { SSL_ERROR_WANT_X509_LOOKUP to indicate, that the handshake was suspended.}

    11604. 

  11604.     { The next call to the handshake function will again lead to the call of   }

    11605. 

  11605.     { client_cert_cb(). It is the job of the client_cert_cb() to store         }

    11606. 

  11606.     { information about the state of the last call, if required to continue.   }

    11607. 

  11607. 

    11608. 

  11608.     { Called when a client certificate is requested but there is not one set   }

    11609. 

  11609.     { against the SSL_CTX or the SSL.  If the callback returns 1, x509 and     }

    11610. 

  11610.     { pkey need to point to valid data.  The library will free these when      }

    11611. 

  11611.     { required so if the application wants to keep these around, increment     }

    11612. 

  11612.     { their reference counts.  If 0 is returned, no client cert is             }

    11613. 

  11613.     { available.  If -1 is returned, it is assumed that the callback needs     }

    11614. 

  11614.     { to be called again at a later point in time.  SSL_connect will return    }

    11615. 

  11615.     { -1 and SSL_want_x509_lookup(ssl) returns TRUE.  Remember that            }

    11616. 

  11616.     { application data can be attached to an SSL structure via the             }

    11617. 

  11617. 

    11618. 

  11618. {$IFNDEF NO_SSL_MT}

    11619. 

  11619.     _EnterCriticalSection(LockClientCertCB);

    11620. 

  11620.     try

    11621. 

  11621. {$ENDIF}

    11622. 

  11622.         Result := 0;

    11623. 

  11623.         Obj := TCustomSslWSocket(f_SSL_get_ex_data(Ssl, 0));

    11624. 

  11624.         if Assigned(Obj) then begin

    11625. 

  11625.             Obj.FSsl_In_CB := TRUE;

    11626. 

  11626.             Obj.Pause;

    11627. 

  11627.             try

    11628. 

  11628.                 if Assigned(Obj.FOnSslCliCertRequest) then begin

    11629. 

  11629.                     Cert := nil;

    11630. 

  11630.                     try

    11631. 

  11631.                         Obj.FOnSslCliCertRequest(Obj, Cert);

    11632. 

  11632.                         if (Cert <> nil) and (Cert.X509 <> nil) and

    11633. 

  11633.                            (Cert.PrivateKey <> nil) then begin

    11634. 

  11634.                             X     := f_X509_dup(Cert.X509);

    11635. 

  11635.                             P     := Ics_EVP_PKEY_dup(Cert.FPrivateKey);

    11636. 

  11636.                             X509^  := X;

    11637. 

  11637.                             PKEY^  := P;

    11638. 

  11638.                             Result := 1;

    11639. 

  11639.                         end

    11640. 

  11640.                         else begin

    11641. 

  11641.                             //X509  := nil;

    11642. 

  11642.                             //PKEY  := nil;

    11643. 

  11643.                         end;

    11644. 

  11644.                     except

    11645. 

  11645.                         // psst

    11646. 

  11646.                     end;

    11647. 

  11647.                 end;

    11648. 

  11648.             finally

    11649. 

  11649.                 Obj.Resume;

    11650. 

  11650.                 Obj.FSsl_In_CB := FALSE;

    11651. 

  11651.                 if Obj.FHSocket = INVALID_SOCKET then

    11652. 

  11652.                     _PostMessage(Obj.FWindowHandle, Obj.FMsg_WM_RESET_SSL, 0, 0);

    11653. 

  11653.             end;

    11654. 

  11654.         end;

    11655. 

  11655. {$IFNDEF NO_SSL_MT}

    11656. 

  11656.     finally

    11657. 

  11657.         _LeaveCriticalSection(LockClientCertCB)

    11658. 

  11658.     end;

    11659. 

  11659. {$ENDIF}

    11660. 

  11660. end;

    11661. 

  11661. 

    11662. 

  11662. 

    11663. 

  11663. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    11664. 

  11664. {$IFNDEF NO_SSL_MT}

    11665. 

  11665. procedure TSslContext.Lock;

    11666. 

  11666. begin

    11667. 

  11667.     _EnterCriticalSection(FLock)

    11668. 

  11668. end;

    11669. 

  11669. 

    11670. 

  11670. 

    11671. 

  11671. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    11672. 

  11672. procedure TSslContext.Unlock;

    11673. 

  11673. begin

    11674. 

  11674.     _LeaveCriticalSection(FLock)

    11675. 

  11675. end;

    11676. 

  11676. 

    11677. 

  11677. {$ENDIF}

    11678. 

  11678. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    11679. 

  11679. function NewSessionCallback(const SSL : PSSL; Sess : PSSL_SESSION): Integer; cdecl;

    11680. 

  11680. var

    11681. 

  11681.     Obj                : TCustomSslWSocket;

    11682. 

  11682.     AddToInternalCache : Boolean;

    11683. 

  11683.     SessID             : Pointer;

    11684. 

  11684.     IdLen              : Integer;

    11685. 

  11685. begin

    11686. 

  11686.    { If this callback is not null, it will be called each                  }

    11687. 

  11687.    { time a session id is added to the cache.  If this function            }

    11688. 

  11688.    { returns 1, it means that the callback will do a                       }

    11689. 

  11689.    { SSL_SESSION_free() when it has finished using it. Otherwise,          }

    11690. 

  11690.    { on 0, it means the callback has finished with it.                     }

    11691. 

  11691.    { Also: If this function returns 0,  the session object will not be     }

    11692. 

  11692.    { cached. A nonzero return allows the session to be cached              }

    11693. 

  11693.    

    11694. 

  11694. {$IFNDEF NO_SSL_MT}

    11695. 

  11695.     _EnterCriticalSection(LockNewSessCB);

    11696. 

  11696.     try

    11697. 

  11697. {$ENDIF}

    11698. 

  11698.         Result := 0;

    11699. 

  11699.         Obj := TCustomSslWSocket(f_SSL_get_ex_data(SSL, 0));

    11700. 

  11700.         if not Assigned(Obj) then

    11701. 

  11701.             raise Exception.Create('NewSessionCallback Obj not assigned');

    11702. 

  11702.         Obj.FSsl_In_CB := TRUE;

    11703. 

  11703.         try

    11704. 

  11704. {$IFNDEF NO_DEBUG_LOG}

    11705. 

  11705.             if Obj.CheckLogOptions(loSslInfo) then  { V5.21 } { replaces $IFDEF DEBUG_OUTPUT  }

    11706. 

  11706.                 Obj.DebugLog(loSslInfo, 'NSCB> New session created');

    11707. 

  11707. {$ENDIF}

    11708. 

  11708.             //f_SSL_session_get_id(Sess, SessID, IdLen); { 03/02/07 AG }

    11709. 

  11709.             SessID := f_SSL_SESSION_get_id(Sess, IdLen); { 03/02/07 AG }

    11710. 

  11710.             AddToInternalCache := FALSE; // not sure about the default value

    11711. 

  11711.             if Assigned(Obj.FOnSslSvrNewSession) then

    11712. 

  11712.                 Obj.FOnSslSvrNewSession(Obj, Sess, SessID, IdLen, AddToInternalCache);

    11713. 

  11713.             if AddToInternalCache then

    11714. 

  11714.                 Result := 1

    11715. 

  11715.             else

    11716. 

  11716.                 Result := 0;

    11717. 

  11717.         finally

    11718. 

  11718.             Obj.FSsl_In_CB := FALSE;

    11719. 

  11719.             if Obj.FHSocket = INVALID_SOCKET then

    11720. 

  11720.                 _PostMessage(Obj.FWindowHandle, Obj.FMsg_WM_RESET_SSL, 0, 0);

    11721. 

  11721.         end;

    11722. 

  11722. {$IFNDEF NO_SSL_MT}

    11723. 

  11723.     finally

    11724. 

  11724.         _LeaveCriticalSection(LockNewSessCB);

    11725. 

  11725.     end;

    11726. 

  11726. {$ENDIF}    

    11727. 

  11727. end;

    11728. 

  11728. 

    11729. 

  11729. 

    11730. 

  11730. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    11731. 

  11731. function GetSessionCallback(

    11732. 

  11732.     const SSL : PSSL;

    11733. 

  11733.     SessId    : Pointer;

    11734. 

  11734.     IdLen     : Integer;

    11735. 

  11735.     Ref       : PInteger) : PSSL_SESSION; cdecl;

    11736. 

  11736. var

    11737. 

  11737.     Obj         : TCustomSslWSocket;

    11738. 

  11738.     Sess        : Pointer;

    11739. 

  11739.     IncRefCount : Boolean;

    11740. 

  11740. begin

    11741. 

  11741.     { SessId = Session ID that's being requested by the peer.             }

    11742. 

  11742.     { The Session ID is distinctly different from the session ID context  }                                            

    11743. 

  11743.     { Ref = An output from the callback. It is used to allow the          }

    11744. 

  11744.     { callback to specify whether the reference count on the returned     }

    11745. 

  11745.     { session object should be incremented or not. It returns as          }

    11746. 

  11746.     { nonzero if the object's reference count should be incremented;      }

    11747. 

  11747.     { otherwise, zero is returned                                         }

    11748. 

  11748. 

    11749. 

  11749. {$IFNDEF NO_SSL_MT}

    11750. 

  11750.     _EnterCriticalSection(LockGetSessCB);

    11751. 

  11751.     try

    11752. 

  11752. {$ENDIF}

    11753. 

  11753.         Result := nil;

    11754. 

  11754.         Obj := TCustomSslWSocket(f_SSL_get_ex_data(SSL, 0));

    11755. 

  11755.         if not Assigned(Obj) then

    11756. 

  11756.             raise Exception.Create('GetSessionCallback Obj not assigned');

    11757. 

  11757.         Obj.FSsl_In_CB := TRUE;

    11758. 

  11758.         try

    11759. 

  11759. {$IFNDEF NO_DEBUG_LOG}

    11760. 

  11760.             if Obj.CheckLogOptions(loSslInfo) then  { V5.21 } { replaces $IFDEF DEBUG_OUTPUT  }

    11761. 

  11761.                 Obj.DebugLog(loSslInfo, 'GSCB> Get session');

    11762. 

  11762. {$ENDIF}

    11763. 

  11763.             Sess := nil;

    11764. 

  11764.             IncRefCount := (Ref^ <> 0);

    11765. 

  11765.             if Assigned(Obj.FOnSslSvrGetSession) then

    11766. 

  11766.                 Obj.FOnSslSvrGetSession(Obj, Sess, SessId, IdLen, IncRefCount);

    11767. 

  11767.             if IncRefCount then

    11768. 

  11768.                 Ref^ := 1

    11769. 

  11769.             else

    11770. 

  11770.                 Ref^ := 0;

    11771. 

  11771.             Result := Sess;

    11772. 

  11772.         finally

    11773. 

  11773.             Obj.FSsl_In_CB := FALSE;

    11774. 

  11774.             if Obj.FHSocket = INVALID_SOCKET then

    11775. 

  11775.                 _PostMessage(Obj.FWindowHandle, Obj.FMsg_WM_RESET_SSL, 0, 0);

    11776. 

  11776.         end;

    11777. 

  11777. {$IFNDEF NO_SSL_MT}

    11778. 

  11778.     finally

    11779. 

  11779.         _LeaveCriticalSection(LockGetSessCB);

    11780. 

  11780.     end;

    11781. 

  11781. {$ENDIF}

    11782. 

  11782. end;

    11783. 

  11783. 

    11784. 

  11784. 

    11785. 

  11785. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    11786. 

  11786. function TSslContext.OpenFileBio(

    11787. 

  11787.     const FileName    : String;

    11788. 

  11788.     Methode           : TBioOpenMethode): PBIO;

    11789. 

  11789. begin

    11790. 

  11790.     if Filename = '' then

    11791. 

  11791.         raise ESslContextException.Create('File name not specified');

    11792. 

  11792.     if (Methode = bomRead) and (not _FileExists(Filename)) then

    11793. 

  11793.         raise ESslContextException.Create('File not found "' +

    11794. 

  11794.                                           Filename + '"');

    11795. 

  11795.     if Methode = bomRead then

    11796. 

  11796.         Result := f_BIO_new_file(PAnsiChar(AnsiString(Filename)), PAnsiChar('r+'))

    11797. 

  11797.     else

    11798. 

  11798.         Result := f_BIO_new_file(PAnsiChar(AnsiString(Filename)), PAnsiChar('w+'));

    11799. 

  11799.     if Result = nil then

    11800. 

  11800.         RaiseLastOpenSslError(ESslContextException, FALSE,

    11801. 

  11801.                               'Error on opening file "' + Filename + '"');

    11802. 

  11802. end;

    11803. 

  11803. 

    11804. 

  11804. 

    11805. 

  11805. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    11806. 

  11806. { A X509_INFO may contain x509/crl/pkey sets, PEM format only }

    11807. 

  11807. function TSslContext.LoadStackFromInfoFile(const FileName: String;

    11808. 

  11808.     Mode: TInfoExtractMode): PStack;

    11809. 

  11809. var

    11810. 

  11810.     InfoStack   : PStack;

    11811. 

  11811.     CertInfo    : PX509_INFO;

    11812. 

  11812.     InBIO       : PBIO;

    11813. 

  11813.     //PKey        : PX509_PKEY;

    11814. 

  11814. begin

    11815. 

  11815.     //InfoStack := nil;

    11816. 

  11816.     //CertInfo  := nil;

    11817. 

  11817.     //InBIO     := nil;

    11818. 

  11818.     Result      := nil;

    11819. 

  11819.     if not Assigned(FSslCtx) then

    11820. 

  11820.         raise ESslContextException.Create(msgSslCtxNotInit);

    11821. 

  11821.     if FileName = '' then

    11822. 

  11822.         Exit;

    11823. 

  11823.     InBIO := OpenFileBio(FileName, bomRead);

    11824. 

  11824.     try

    11825. 

  11825.         // This loads from a file, a stack of x509/crl/pkey sets

    11826. 

  11826.         InfoStack := PStack(f_PEM_X509_INFO_read_bio(InBIO, nil, nil, nil));

    11827. 

  11827.         if not Assigned(InfoStack) then

    11828. 

  11828.             raise ESslContextException.CreateFmt('Error reading info file "%s"',

    11829. 

  11829.                                                  [FileName]);

    11830. 

  11830.         try

    11831. 

  11831.             if f_sk_num(InfoStack) > 0 then

    11832. 

  11832.                 Result := f_sk_new_null

    11833. 

  11833.             else

    11834. 

  11834.                 Exit;

    11835. 

  11835.             if Result = nil then

    11836. 

  11836.                 raise ESslContextException.Create('Error creating Stack');

    11837. 

  11837.             // Scan over it and pull out what is needed

    11838. 

  11838.             while f_sk_num(InfoStack) > 0 do begin

    11839. 

  11839.                 CertInfo := PX509_INFO(f_sk_delete(InfoStack, 0));

    11840. 

  11840.                 case Mode of

    11841. 

  11841.                 emCert :

    11842. 

  11842.                     if CertInfo^.x509 <> nil then

    11843. 

  11843.                         f_sk_insert(Result, PAnsiChar(f_X509_dup(CertInfo^.x509)),

    11844. 

  11844.                                                   f_sk_num(Result) + 1);

    11845. 

  11845.                 { A Dup-function for X509_PKEY is still missing in OpenSsl arrg!

    11846. 

  11846.                 emKey :

    11847. 

  11847.                     if CertInfo^.x_pkey <> nil then

    11848. 

  11848.                         f_sk_insert(Result, PChar(f_X509_PKEY_dup(CertInfo^.x_pkey)),

    11849. 

  11849.                                                   f_sk_num(Result) + 1);}

    11850. 

  11850.                 emCrl :

    11851. 

  11851.                     if CertInfo^.crl <> nil then

    11852. 

  11852.                         f_sk_insert(Result, PAnsiChar(f_X509_CRL_dup(CertInfo^.crl)),

    11853. 

  11853.                                                   f_sk_num(Result) + 1);

    11854. 

  11854.                 end; //case

    11855. 

  11855.                 f_X509_INFO_free(CertInfo);

    11856. 

  11856.             end;

    11857. 

  11857.         finally

    11858. 

  11858.              f_sk_pop_free(InfoStack, @f_X509_INFO_free);

    11859. 

  11859.         end;

    11860. 

  11860.     finally

    11861. 

  11861.        f_Bio_free(InBio);

    11862. 

  11862.     end;

    11863. 

  11863. end;

    11864. 

  11864. 

    11865. 

  11865. 

    11866. 

  11866. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    11867. 

  11867. { PEM format only, the file may contain multiple certificates.              }

    11868. 

  11868. { Loads intermediate CA certificates needed to build a complete chain.      }

    11869. 

  11869. { PEM format only, any file of a given directory }

    11870. 

  11870. { PEM format only, the file may contain multiple CRL's }

    11871. 

  11871. procedure TSslContext.LoadCrlFromFile(const Filename: String);

    11872. 

  11872. var

    11873. 

  11873.     CRL      : PX509_CRL;

    11874. 

  11874.     St       : PX509_STORE;

    11875. 

  11875.     CrlStack : PStack;

    11876. 

  11876. begin

    11877. 

  11877. {$IFNDEF NO_SSL_MT}

    11878. 

  11878.     Lock;

    11879. 

  11879.     try

    11880. 

  11880. {$ENDIF}

    11881. 

  11881.         if not Assigned(FSslCtx) then

    11882. 

  11882.             raise ESslContextException.Create(msgSslCtxNotInit);

    11883. 

  11883.         if (Filename <> '') and (not _FileExists(Filename)) then

    11884. 

  11884.             raise ESslContextException.Create('CRL file not found "' +

    11885. 

  11885.                                               Filename + '"');

    11886. 

  11886.         if Filename <> '' then begin

    11887. 

  11887.             //CrlStack := nil;

    11888. 

  11888.             CrlStack := LoadStackFromInfoFile(FileName, emCrl);

    11889. 

  11889.             if not Assigned(CrlStack) then

    11890. 

  11890.                 raise ESslContextException.Create('Error on reading CRL file "' +

    11891. 

  11891.                                                   Filename + '"');

    11892. 

  11892.             try

    11893. 

  11893.                 //St := nil;

    11894. 

  11894.                 St := f_SSL_CTX_get_cert_store(FSslCtx);

    11895. 

  11895.                 if not Assigned(St) then

    11896. 

  11896.                     raise ESslContextException.Create('Error on opening store');

    11897. 

  11897.                 while f_sk_num(CrlStack) > 0 do begin

    11898. 

  11898.                     //Crl := nil;

    11899. 

  11899.                     Crl := PX509_CRL(f_sk_delete(CrlStack, 0));

    11900. 

  11900.                     if Assigned(Crl) then

    11901. 

  11901.                         try

    11902. 

  11902.                             { Fails if CRL is already in hash table }

    11903. 

  11903.                             if f_X509_STORE_add_crl(St, Crl) = 0 then

    11904. 

  11904. {$IFNDEF NO_DEBUG_LOG}

    11905. 

  11905.                                 if CheckLogOptions(loSslErr) then  { V5.21 }

    11906. 

  11906.                                     DebugLog(loSslErr, String(LastOpenSslErrMsg(True)));

    11907. 

  11907. {$ELSE}

    11908. 

  11908.                                 f_ERR_clear_error;

    11909. 

  11909. {$ENDIF};

    11910. 

  11910.                         finally

    11911. 

  11911.                             f_X509_CRL_free(Crl);

    11912. 

  11912.                         end;

    11913. 

  11913.                     end;

    11914. 

  11914.             finally

    11915. 

  11915.                 f_sk_pop_free(CrlStack, @f_X509_CRL_free);

    11916. 

  11916.             end;

    11917. 

  11917.         end;

    11918. 

  11918. {$IFNDEF NO_SSL_MT}        

    11919. 

  11919.     finally

    11920. 

  11920.         Unlock;

    11921. 

  11921.     end;

    11922. 

  11922. {$ENDIF}    

    11923. 

  11923. end;

    11924. 

  11924. 

    11925. 

  11925. 

    11926. 

  11926. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    11927. 

  11927. { PEM format only, any file of a given directory }

    11928. 

  11928. procedure TSslContext.LoadCrlFromPath(const Path: String);

    11929. 

  11929. var

    11930. 

  11930.     SRec  : TSearchRec;

    11931. 

  11931.     Found : Boolean;

    11932. 

  11932.     S     : String;

    11933. 

  11933. begin

    11934. 

  11934.     if not Assigned(FSslCtx) then

    11935. 

  11935.         raise ESslContextException.Create(msgSslCtxNotInit);

    11936. 

  11936.     if (Path <> '') and (not _DirectoryExists(Path)) then

    11937. 

  11937.         raise ESslContextException.Create('CRL directory not found "' +

    11938. 

  11938.                                           Path + '"');

    11939. 

  11939.     if Path <> '' then begin

    11940. 

  11940.         S := _IncludeTrailingPathDelimiter(Path);

    11941. 

  11941.         Found := _FindFirst(S + '*.*', faAnyFile - faDirectory, SRec) = 0;

    11942. 

  11942.         if Found then

    11943. 

  11943.             try

    11944. 

  11944.                 while Found do begin

    11945. 

  11945.                     LoadCrlFromFile(S + SRec.Name);

    11946. 

  11946.                     Found := _FindNext(SRec) = 0;

    11947. 

  11947.                 end;

    11948. 

  11948.             finally

    11949. 

  11949.                 _FindClose(SRec);

    11950. 

  11950.             end;

    11951. 

  11951.     end;

    11952. 

  11952. end;

    11953. 

  11953. 

    11954. 

  11954. 

    11955. 

  11955. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    11956. 

  11956. procedure TSslContext.LoadVerifyLocations(const CAFile, CAPath: String);

    11957. 

  11957. var

    11958. 

  11958.     PCAPath : PAnsiChar;

    11959. 

  11959.     PCAFile : PAnsiChar;

    11960. 

  11960. begin

    11961. 

  11961.     // Load the CAs we trust

    11962. 

  11962.     //

    11963. 

  11963.     // If CAfile is not NIL, it points to a file of CA certificates in PEM

    11964. 

  11964.     // format. The file can contain several CA certificates.

    11965. 

  11965.     //

    11966. 

  11966.     // If CApath is not NIL, it points to a directory containing CA

    11967. 

  11967.     // certificates in PEM format. The files each contain one CA certificate.

    11968. 

  11968.     // The files are looked up by the CA subject name hash value, which must

    11969. 

  11969.     // hence be available. If more than one CA certificate with the same name

    11970. 

  11970.     // hash value exist, the extension must be different (e.g. 9d66eef0.0,

    11971. 

  11971.     // 9d66eef0.1 etc). The search is performed in the ordering of the

    11972. 

  11972.     // extension number, regardless of other properties of the certificates.

    11973. 

  11973.     // The certificates in CApath are only looked up when required, e.g. when

    11974. 

  11974.     // building the certificate chain or when actually performing the

    11975. 

  11975.     // verification of a peer certificate. When looking up CA certificates,

    11976. 

  11976.     // the OpenSSL library will first search the certificates in CAfile, then

    11977. 

  11977.     // those in CApath. 

    11978. 

  11978. 

    11979. 

  11979.     if FSslCtx = nil then

    11980. 

  11980.         raise ESslContextException.Create(msgSslCtxNotInit);

    11981. 

  11981.     if (CAFile <> '') and (not _FileExists(CAFile)) then

    11982. 

  11982.         raise ESslContextException.Create('File not found "' + CAFile + '"');

    11983. 

  11983.     if (Length(CAPath) > 0) and (not _DirectoryExists(CAPath)) then

    11984. 

  11984.         raise ESslContextException.Create('Directory not found "' + CAPath + '"');

    11985. 

  11985. 

    11986. 

  11986.     if CAPath <> '' then

    11987. 

  11987.         PCAPath := PAnsiChar(AnsiString(CAPath))

    11988. 

  11988.     else

    11989. 

  11989.         PCAPath := nil;

    11990. 

  11990.     if CAFile <> '' then

    11991. 

  11991.         PCAFile := PAnsiChar(AnsiString(CAFile))

    11992. 

  11992.     else

    11993. 

  11993.         PCAFile := nil;

    11994. 

  11994.     if ((PCAFile <> nil) or (PCAPath <> nil)) and

    11995. 

  11995.        (f_SSL_CTX_load_verify_locations(FSslCtx,

    11996. 

  11996.                                         PCAFile, PCAPath) = 0) then

    11997. 

  11997.         RaiseLastOpenSslError(ESslContextException, TRUE,

    11998. 

  11998.                               'Can''t read CA File "' +

    11999. 

  11999.                               FSslCAFile + '" or ' +

    12000. 

  12000.                               'CA Path "' + CAPath + '"');

    12001. 

  12001.     if (PCAFile = nil) and (PCAPath = nil) and

    12002. 

  12002.        (f_SSL_CTX_set_default_verify_paths(FSslCtx) <> 1) then

    12003. 

  12003.         RaiseLastOpenSslError(ESslContextException, TRUE,

    12004. 

  12004.                               'Error loading default CA file ' +

    12005. 

  12005.                               'and/or directory');

    12006. 

  12006. end;

    12007. 

  12007. 

    12008. 

  12008. 

    12009. 

  12009. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    12010. 

  12010. procedure TSslContext.LoadCertFromChainFile(const FileName: String);

    12011. 

  12011. begin

    12012. 

  12012.     if not Assigned(FSslCtx) then

    12013. 

  12013.         raise ESslContextException.Create(msgSslCtxNotInit);

    12014. 

  12014.     if (FileName <> '') and (not _FileExists(FileName)) then

    12015. 

  12015.         raise ESslContextException.Create('File not found "' + FileName + '"');

    12016. 

  12016.     if (FileName <> '') and

    12017. 

  12017.        (f_SSL_CTX_use_certificate_chain_file(FSslCtx,

    12018. 

  12018.                                              PAnsiChar(AnsiString(FileName))) = 0) then begin

    12019. 

  12019. {$IFNDEF NO_DEBUG_LOG}

    12020. 

  12020.         if CheckLogOptions(loSslErr) then  { V5.21 } { replaces $IFDEF DEBUG_OUTPUT  }

    12021. 

  12021.             DebugLog(loSslErr, String(LastOpenSslErrMsg(TRUE)));

    12022. 

  12022. {$ELSE}

    12023. 

  12023.         f_ERR_clear_error;

    12024. 

  12024. {$ENDIF}

    12025. 

  12025.         RaiseLastOpenSslError(ESslContextException, TRUE,

    12026. 

  12026.                               'Can''t read certificate ' +

    12027. 

  12027.                               'file "' + FileName + '"');

    12028. 

  12028.     end;

    12029. 

  12029. end;

    12030. 

  12030. 

    12031. 

  12031. 

    12032. 

  12032. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    12033. 

  12033. procedure TSslContext.LoadPKeyFromFile(const FileName: String);

    12034. 

  12034. begin

    12035. 

  12035.     if not Assigned(FSslCtx) then

    12036. 

  12036.         raise ESslContextException.Create(msgSslCtxNotInit);

    12037. 

  12037.     if (FileName <> '') and (not _FileExists(FileName)) then

    12038. 

  12038.         raise ESslContextException.Create('File not found "' + FileName + '"');

    12039. 

  12039.     if (FileName <> '') and

    12040. 

  12040.        (f_SSL_CTX_use_PrivateKey_file(FSslCtx, PAnsiChar(AnsiString(FileName)),

    12041. 

  12041.                                       SSL_FILETYPE_PEM) = 0) then begin

    12042. 

  12042. {$IFNDEF NO_DEBUG_LOG}

    12043. 

  12043.         if CheckLogOptions(loSslInfo) then  { V5.21 } { replaces $IFDEF DEBUG_OUTPUT  }

    12044. 

  12044.             DebugLog(loSslInfo, String(LastOpenSslErrMsg(TRUE)));

    12045. 

  12045. {$ELSE}

    12046. 

  12046.         f_ERR_clear_error;

    12047. 

  12047. {$ENDIF}

    12048. 

  12048.         RaiseLastOpenSslError(ESslContextException, TRUE,

    12049. 

  12049.                               'Can''t load private key ' +

    12050. 

  12050.                               'file "' + FileName + '"');

    12051. 

  12051.     end;

    12052. 

  12052. end;

    12053. 

  12053. 

    12054. 

  12054. 

    12055. 

  12055. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    12056. 

  12056. {$IFNDEF OPENSSL_NO_ENGINE}

    12057. 

  12057. procedure TSslContext.Notification(

    12058. 

  12058.     AComponent : TComponent;

    12059. 

  12059.     Operation  : TOperation);

    12060. 

  12060. begin

    12061. 

  12061.     inherited Notification(AComponent, Operation);

    12062. 

  12062.     if Operation = opRemove then begin

    12063. 

  12063.         if AComponent = FCtxEngine then

    12064. 

  12064.             FCtxEngine := nil;

    12065. 

  12065.     end;

    12066. 

  12066. end;

    12067. 

  12067. 

    12068. 

  12068. 

    12069. 

  12069. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    12070. 

  12070. procedure TSslContext.SetCtxEngine(const Value: TSslEngine);

    12071. 

  12071. begin

    12072. 

  12072.     FCtxEngine := Value;

    12073. 

  12073.     if Value <> nil then

    12074. 

  12074.         Value.FreeNotification(Self);

    12075. 

  12075. end;

    12076. 

  12076. 

    12077. 

  12077. 

    12078. 

  12078. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    12079. 

  12079. procedure TSslContext.LoadPKeyFromEngine(CtxEngine: TSslEngine);

    12080. 

  12080. var

    12081. 

  12081.     PKey : PEVP_PKEY;

    12082. 

  12082.     Uim  : PUI_METHOD;

    12083. 

  12083. begin

    12084. 

  12084.     if not Assigned(FSslCtx) then

    12085. 

  12085.         raise ESslContextException.Create(msgSslCtxNotInit);

    12086. 

  12086.     if (CtxEngine = nil) or (CtxEngine.KeyID = '') then

    12087. 

  12087.         raise ESslContextException.Create('Engine and KeyID may not be empty');

    12088. 

  12088. 

    12089. 

  12089.     if CtxEngine.State <> esInit then

    12090. 

  12090.         if not CtxEngine.Init then

    12091. 

  12091.             raise ESslContextException.Create(CtxEngine.LastErrorMsg);

    12092. 

  12092.         Uim := f_UI_create_method(PAnsiChar('ICS WIN32 UI'));

    12093. 

  12093.         f_UI_method_set_reader(Uim, PinCallback);

    12094. 

  12094.         PKey := f_ENGINE_load_private_key(CtxEngine.E,

    12095. 

  12095.                                           PAnsiChar(AnsiString(CtxEngine.KeyID)),

    12096. 

  12096.                                           Uim, Pointer(Self));

    12097. 

  12097. 

    12098. 

  12098.         if PKey = nil then

    12099. 

  12099.             RaiseLastOpenSslError(ESslContextException, TRUE,

    12100. 

  12100.                               'Can''t load private key from Engine');

    12101. 

  12101. 

    12102. 

  12102.         if f_SSL_CTX_use_PrivateKey(FSslCtx, PKey) = 0 then

    12103. 

  12103.             RaiseLastOpenSslError(ESslContextException, TRUE,

    12104. 

  12104.                                   'Can''t use private key');

    12105. 

  12105. end;

    12106. 

  12106. {$ENDIF OPENSSL_NO_ENGINE}

    12107. 

  12107. 

    12108. 

  12108. 

    12109. 

  12109. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    12110. 

  12110. { Open a PEM CA certificate file and add the CA name extracted              }

    12111. 

  12111. { to the list of CAs sent to the client when requesting a client            }

    12112. 

  12112. { certificate, usefull only in server mode.                                 }

    12113. 

  12113. procedure TSslContext.AddClientCAFromFile(const FileName: String);

    12114. 

  12114. var

    12115. 

  12115.     X : TX509Base;

    12116. 

  12116. begin

    12117. 

  12117.     if not Assigned(FSslCtx) then

    12118. 

  12118.         raise ESslContextException.Create(msgSslCtxNotInit);

    12119. 

  12119.     if (Filename <> '') and (not _FileExists(Filename)) then

    12120. 

  12120.         raise ESslContextException.Create('Certificate file not found "' +

    12121. 

  12121.                                           Filename + '"');

    12122. 

  12122.     if Filename <> '' then begin

    12123. 

  12123.         X := TX509Base.Create(nil);

    12124. 

  12124.         try

    12125. 

  12125.             X.LoadFromPemFile(FileName);

    12126. 

  12126.             if f_SSL_CTX_add_client_CA(FSslCtx, X.X509) <> 1 then

    12127. 

  12127.                 RaiseLastOpenSslError(ESslContextException, TRUE,

    12128. 

  12128.                                       'Can''t load client CA ' +

    12129. 

  12129.                                       'file "' + FileName + '"');

    12130. 

  12130.         finally

    12131. 

  12131.             X.Free;

    12132. 

  12132.         end;

    12133. 

  12133.     end;

    12134. 

  12134. end;

    12135. 

  12135. 

    12136. 

  12136. 

    12137. 

  12137. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    12138. 

  12138. { Scan all certificates in a PEM CAfile and list their names as acceptable  }

    12139. 

  12139. { CAs sent to the client when we request a client certificate. Usefull only }

    12140. 

  12140. { in server mode.                                                           }

    12141. 

  12141. procedure TSslContext.SetClientCAListFromFile(const FileName: String);

    12142. 

  12142. var

    12143. 

  12143.     Sk : PSTACK_OF_X509_NAME;

    12144. 

  12144. begin

    12145. 

  12145.     if not Assigned(FSslCtx) then

    12146. 

  12146.         raise ESslContextException.Create(msgSslCtxNotInit);

    12147. 

  12147.     if (Filename <> '') and (not _FileExists(Filename)) then

    12148. 

  12148.         raise ESslContextException.Create('Certificate file not found "' +

    12149. 

  12149.                                           Filename + '"');

    12150. 

  12150.     if Filename <> '' then begin

    12151. 

  12151.         Sk := f_SSL_load_client_CA_file(PAnsiChar(AnsiString(FileName)));

    12152. 

  12152.         if not Assigned(Sk) then

    12153. 

  12153.             raise ESslContextException.Create('Error on reading certificate ' +

    12154. 

  12154.                                               'file "' + Filename + '"');

    12155. 

  12155.         f_SSL_CTX_set_client_CA_list(FSslCTX, Sk); // frees Sk

    12156. 

  12156.     end;    

    12157. 

  12157. end;

    12158. 

  12158. 

    12159. 

  12159. 

    12160. 

  12160. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    12161. 

  12161. procedure TSslContext.InitContext;

    12162. 

  12162. var

    12163. 

  12163.     SslSessCacheModes : TSslSessCacheModes;

    12164. 

  12164. begin

    12165. 

  12165.     InitializeSsl; //loads libs

    12166. 

  12166. {$IFNDEF NO_SSL_MT}

    12167. 

  12167.     Lock;

    12168. 

  12168.     try

    12169. 

  12169. {$ENDIF}

    12170. 

  12170.     {$IFNDEF NO_DEBUG_LOG}

    12171. 

  12171.         if CheckLogOptions(loSslInfo) then

    12172. 

  12172.          DebugLog(loSslInfo, 'InitCtx> OpenSSL version: ' + OpenSslVersion);

    12173. 

  12173.     {$ENDIF}

    12174. 

  12174.     {$IFNDEF OPENSSL_NO_ENGINE}

    12175. 

  12175.         if (not GSslRegisterAllCompleted) and FAutoEnableBuiltinEngines then

    12176. 

  12176.         begin

    12177. 

  12177.             // Register all of them for every algorithm they collectively implement /

    12178. 

  12178.             f_ENGINE_register_all_complete;

    12179. 

  12179.             GSslRegisterAllCompleted := TRUE;

    12180. 

  12180.         end;

    12181. 

  12181.     {$ENDIF}

    12182. 

  12182. 

    12183. 

  12183.         if not Assigned(FSslCtx) then begin

    12184. 

  12184.             // Create new context

    12185. 

  12185.             FSslCtx := InitializeCtx;

    12186. 

  12186.             if not Assigned(FSslCtx) then

    12187. 

  12187.                 raise ESslContextException.Create('Failed to initialize context');

    12188. 

  12188.         end;

    12189. 

  12189. 

    12190. 

  12190.         try

    12191. 

  12191.             if Assigned(FOnBeforeInit) then

    12192. 

  12192.                 FOnBeforeInit(Self);

    12193. 

  12193. 

    12194. 

  12194.             // Load our key and certificate

    12195. 

  12195.         {$IFNDEF OPENSSL_NO_ENGINE}

    12196. 

  12196.             if (FCtxEngine <> nil) and

    12197. 

  12197.                (eccLoadPrivKey in FCtxEngine.CtxCapabilities) then

    12198. 

  12198.                 LoadPKeyFromEngine(FCtxEngine)

    12199. 

  12199.             else begin

    12200. 

  12200.         {$ENDIF}

    12201. 

  12201.                 // Set the password callback and our custom user data

    12202. 

  12202.                 f_SSL_CTX_set_default_passwd_cb(FSslCtx, PasswordCallBack);

    12203. 

  12203.                 f_SSL_CTX_set_default_passwd_cb_userdata(FSslCtx, Self);

    12204. 

  12204. 

    12205. 

  12205.                 LoadPKeyFromFile(FSslPrivKeyFile);

    12206. 

  12206.         {$IFNDEF OPENSSL_NO_ENGINE}

    12207. 

  12207.             end;

    12208. 

  12208.         {$ENDIF}

    12209. 

  12209. 

    12210. 

  12210.             LoadCertFromChainFile(FSslCertFile);

    12211. 

  12211. 

    12212. 

  12212.             // See notes in the procedure

    12213. 

  12213.             LoadVerifyLocations(FSslCAFile, FSslCAPath);

    12214. 

  12214. 

    12215. 

  12215.             LoadCRLFromFile(FSslCRLFile);

    12216. 

  12216.             LoadCRLFromPath(FSslCRLPath);

    12217. 

  12217.             //f_SSL_CTX_ctrl(FSslCtx, SSL_CTRL_MODE, SSL_MODE_ENABLE_PARTIAL_WRITE, nil); // Test

    12218. 

  12218. 

    12219. 

  12219.             //raise Exception.Create('Test');

    12220. 

  12220. 

    12221. 

  12221.             // Now the verify stuff

    12222. 

  12222.             SetSslVerifyPeerModes(SslVerifyPeerModes);

    12223. 

  12223.             {if FSslX509Trust <> ssl_X509_TRUST_NOT_DEFINED then

    12224. 

  12224.                 if f_SSL_CTX_set_trust(FSslCtx, Integer(FSslX509Trust)) = 0 then

    12225. 

  12225.                     raise Exception.Create('Error setting trust'); }

    12226. 

  12226. 

    12227. 

  12227.             if FSslOptionsValue <> 0 then

    12228. 

  12228.             { adds the options set via bitmask in options to ssl. }

    12229. 

  12229.             { Options already set before are not cleared! }

    12230. 

  12230.                 f_SSL_CTX_set_options(FSslCtx, FSslOptionsValue);

    12231. 

  12231. 

    12232. 

  12232.             if FSslCipherList <> '' then begin

    12233. 

  12233.                 if f_SSL_CTX_set_cipher_list(FSslCtx,

    12234. 

  12234.                                              PAnsiChar(AnsiString(FSslCipherList))) = 0 then

    12235. 

  12235.                     RaiseLastOpenSslError(ESslContextException, TRUE,

    12236. 

  12236.                                           'Error loading cipher list');

    12237. 

  12237.             end

    12238. 

  12238.             else

    12239. 

  12239.                 raise ESslContextException.Create('Cipher list empty');

    12240. 

  12240. 

    12241. 

  12241.             // Session caching stuff

    12242. 

  12242.             SslSessCacheModes := GetSslSessCacheModes;

    12243. 

  12243. 

    12244. 

  12244.             //if SslSessCacheModes <> [] then   // AG 03/03/06 internal cache is ON by default 

    12245. 

  12245.                 f_SSL_CTX_set_session_cache_mode(FSslCtx, FSslSessCacheModeValue);

    12246. 

  12246. 

    12247. 

  12247.             if not (sslSESS_CACHE_NO_INTERNAL_STORE in SslSessCacheModes) then begin

    12248. 

  12248.                 { Exdata needed in RemoveCallback only }

    12249. 

  12249.                 if f_SSL_CTX_set_ex_data(FSslCtx, 0, PAnsiChar(Self)) = 0 then

    12250. 

  12250.                     RaiseLastOpenSslError(ESslContextException, TRUE,

    12251. 

  12251.                                           'SSL_CTX_set_ex_data failed');

    12252. 

  12252.                 f_SSL_CTX_sess_set_remove_cb(FSslCtx, RemoveSessionCallback);

    12253. 

  12253.                 if FSslSessionCacheSize <> SSL_SESSION_CACHE_MAX_SIZE_DEFAULT then

    12254. 

  12254.                     f_SSL_CTX_sess_set_cache_size(FSslCtx, FSslSessionCacheSize);

    12255. 

  12255.             end;

    12256. 

  12256.             if (sslSESS_CACHE_SERVER in SslSessCacheModes) then begin

    12257. 

  12257.                 { Set the timeout for newly created sessions                }

    12258. 

  12258.                 if FSslSessionTimeout > 0 then

    12259. 

  12259.                     f_SSL_CTX_set_timeout(FSslCtx, FSslSessionTimeout);

    12260. 

  12260.                 { Set session callbacks, ssl server mode only               }

    12261. 

  12261.                 f_SSL_CTX_sess_set_new_cb(FSslCtx, NewSessionCallback);

    12262. 

  12262.                 f_SSL_CTX_sess_set_get_cb(FSslCtx, GetSessionCallback);

    12263. 

  12263.                 if Length(FSslDefaultSessionIDContext) > 0 then

    12264. 

  12264.                     if f_SSL_CTX_set_session_id_context(FSslCtx,

    12265. 

  12265.                                   @FSslDefaultSessionIDContext[1],

    12266. 

  12266.                                   Length(FSslDefaultSessionIDContext)) = 0 then

    12267. 

  12267.                         RaiseLastOpenSslError(ESslContextException, TRUE,

    12268. 

  12268.                                               'ssl_ctx_set_session_id_context ' +

    12269. 

  12269.                                               'failed');

    12270. 

  12270.             end;

    12271. 

  12271.         except

    12272. 

  12272.             if Assigned(FSslCtx) then begin

    12273. 

  12273.                 f_SSL_CTX_free(FSslCtx);

    12274. 

  12274.                 FSslCtx := nil;

    12275. 

  12275.             end;

    12276. 

  12276.             raise

    12277. 

  12277.         end;

    12278. 

  12278. {$IFNDEF NO_SSL_MT}        

    12279. 

  12279.     finally

    12280. 

  12280.         Unlock

    12281. 

  12281.     end;

    12282. 

  12282. {$ENDIF}

    12283. 

  12283. end;

    12284. 

  12284. 

    12285. 

  12285. 

    12286. 

  12286. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    12287. 

  12287. procedure TSslContext.DeInitContext;

    12288. 

  12288. begin

    12289. 

  12289. {$IFNDEF NO_SSL_MT}

    12290. 

  12290.     Lock;

    12291. 

  12291.     try

    12292. 

  12292. {$ENDIF}

    12293. 

  12293.         if Assigned(FSslCtx) then begin

    12294. 

  12294.             { The context lives as long as there are open sessions associated }

    12295. 

  12295.             { even when we called f_SSL_CTX_free(), so some cleanup is needed }

    12296. 

  12296.             f_SSL_CTX_set_ex_data(FSslCtx, 0, nil);    //MainFix    // AG 12/25/07

    12297. 

  12297.             { It may be a good idea to disable all callbacks as well }

    12298. 

  12298.             { before freeing the context pointer, should not hurt,   }

    12299. 

  12299.             { otherwise please let me know }

    12300. 

  12300.             f_SSL_CTX_sess_set_remove_cb(FSslCtx, nil);             // AG 12/25/07

    12301. 

  12301.             f_SSL_CTX_sess_set_new_cb(FSslCtx, nil);                // AG 12/25/07

    12302. 

  12302.             f_SSL_CTX_sess_set_get_cb(FSslCtx, nil);                // AG 12/25/07

    12303. 

  12303.             f_SSL_CTX_set_default_passwd_cb(FSslCtx, nil);          // AG 12/25/07

    12304. 

  12304.             f_SSL_CTX_set_default_passwd_cb_userdata(FSslCtx, nil); // AG 12/25/07

    12305. 

  12305.             f_SSL_CTX_free(FSslCtx);

    12306. 

  12306.             FSslCtx := nil;

    12307. 

  12307.         end;

    12308. 

  12308. {$IFNDEF NO_SSL_MT}

    12309. 

  12309.     finally

    12310. 

  12310.         Unlock;

    12311. 

  12311.     end;

    12312. 

  12312. {$ENDIF}    

    12313. 

  12313.     FinalizeSsl;

    12314. 

  12314. end; 

    12315. 

  12315. 

    12316. 

  12316. 

    12317. 

  12317. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    12318. 

  12318. procedure TSslContext.SetSslCAFile(const Value: String);

    12319. 

  12319. begin

    12320. 

  12320. {$IFNDEF NO_SSL_MT}

    12321. 

  12321.     Lock;

    12322. 

  12322.     try

    12323. 

  12323. {$ENDIF}

    12324. 

  12324.         if _CompareStr(FSslCAFile, Value) = 0 then

    12325. 

  12325.             Exit;

    12326. 

  12326.         FSslCAFile := Value;

    12327. 

  12327.         if Assigned(FSslCtx) then

    12328. 

  12328.             LoadVerifyLocations(FSslCAFile, FSslCAPath);

    12329. 

  12329. {$IFNDEF NO_SSL_MT}

    12330. 

  12330.     finally

    12331. 

  12331.         Unlock

    12332. 

  12332.     end;

    12333. 

  12333. {$ENDIF}    

    12334. 

  12334. end;

    12335. 

  12335. 

    12336. 

  12336. 

    12337. 

  12337. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    12338. 

  12338. procedure TSslContext.SetSslCAPath(const Value: String);

    12339. 

  12339. begin

    12340. 

  12340. {$IFNDEF NO_SSL_MT}

    12341. 

  12341.     Lock;

    12342. 

  12342.     try

    12343. 

  12343. {$ENDIF}

    12344. 

  12344.         if _CompareStr(FSslCAPath, Value) = 0 then

    12345. 

  12345.             Exit;

    12346. 

  12346.         FSslCAPath := Value;

    12347. 

  12347.         if Assigned(FSslCtx) then

    12348. 

  12348.             LoadVerifyLocations(FSslCAFile, FSslCAPath);

    12349. 

  12349. {$IFNDEF NO_SSL_MT}        

    12350. 

  12350.     finally

    12351. 

  12351.         Unlock

    12352. 

  12352.     end;

    12353. 

  12353. {$ENDIF}

    12354. 

  12354. end;

    12355. 

  12355. 

    12356. 

  12356. 

    12357. 

  12357. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    12358. 

  12358. procedure TSslContext.SetSslCertFile(const Value: String);

    12359. 

  12359. begin

    12360. 

  12360. {$IFNDEF NO_SSL_MT}

    12361. 

  12361.     Lock;

    12362. 

  12362.     try

    12363. 

  12363. {$ENDIF}

    12364. 

  12364.         if _CompareStr(Value, FSslCertFile) = 0 then

    12365. 

  12365.             Exit;

    12366. 

  12366.         FSslCertFile := Value;

    12367. 

  12367.         if Assigned(FSslCtx) then

    12368. 

  12368.             LoadCertFromChainFile(FSslCertFile);

    12369. 

  12369. {$IFNDEF NO_SSL_MT}        

    12370. 

  12370.     finally

    12371. 

  12371.         Unlock

    12372. 

  12372.     end;

    12373. 

  12373. {$ENDIF}    

    12374. 

  12374. end;

    12375. 

  12375. 

    12376. 

  12376. 

    12377. 

  12377. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    12378. 

  12378. procedure TSslContext.SetSslCRLFile(const Value: String);

    12379. 

  12379. begin

    12380. 

  12380. {$IFNDEF NO_SSL_MT}

    12381. 

  12381.     Lock;

    12382. 

  12382.     try

    12383. 

  12383. {$ENDIF}

    12384. 

  12384.         FSslCRLFile := Value

    12385. 

  12385. {$IFNDEF NO_SSL_MT}        

    12386. 

  12386.     finally

    12387. 

  12387.         Unlock

    12388. 

  12388.     end;

    12389. 

  12389. {$ENDIF}    

    12390. 

  12390. end;

    12391. 

  12391. 

    12392. 

  12392. 

    12393. 

  12393. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    12394. 

  12394. procedure TSslContext.SetSslCRLPath(const Value: String);

    12395. 

  12395. begin

    12396. 

  12396. {$IFNDEF NO_SSL_MT}

    12397. 

  12397.     Lock;

    12398. 

  12398.     try

    12399. 

  12399. {$ENDIF}

    12400. 

  12400.         FSslCRLPath := Value

    12401. 

  12401. {$IFNDEF NO_SSL_MT}

    12402. 

  12402.     finally

    12403. 

  12403.         Unlock

    12404. 

  12404.     end;

    12405. 

  12405. {$ENDIF}    

    12406. 

  12406. end;

    12407. 

  12407. 

    12408. 

  12408. 

    12409. 

  12409. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    12410. 

  12410. procedure TSslContext.SetSslPassPhrase(const Value: String);

    12411. 

  12411. begin

    12412. 

  12412. {$IFNDEF NO_SSL_MT}

    12413. 

  12413.     Lock;

    12414. 

  12414.     try

    12415. 

  12415. {$ENDIF}

    12416. 

  12416.         FSslPassPhrase := Value

    12417. 

  12417. {$IFNDEF NO_SSL_MT}

    12418. 

  12418.     finally

    12419. 

  12419.         Unlock

    12420. 

  12420.     end;

    12421. 

  12421. {$ENDIF}

    12422. 

  12422. end;

    12423. 

  12423. 

    12424. 

  12424. 

    12425. 

  12425. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    12426. 

  12426. procedure TSslContext.SetSslPrivKeyFile(const Value: String);

    12427. 

  12427. begin

    12428. 

  12428. {$IFNDEF NO_SSL_MT}

    12429. 

  12429.     Lock;

    12430. 

  12430.     try

    12431. 

  12431. {$ENDIF}

    12432. 

  12432.         if (_CompareStr(Value, FSslPrivKeyFile) = 0) then

    12433. 

  12433.             Exit;

    12434. 

  12434.         FSslPrivKeyFile := Value;

    12435. 

  12435.         if Assigned(FSslCtx) then

    12436. 

  12436.             LoadPKeyFromFile(FSslPrivKeyFile);

    12437. 

  12437. {$IFNDEF NO_SSL_MT}

    12438. 

  12438.     finally

    12439. 

  12439.         Unlock

    12440. 

  12440.     end;

    12441. 

  12441. {$ENDIF}    

    12442. 

  12442. end;

    12443. 

  12443. 

    12444. 

  12444. 

    12445. 

  12445. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    12446. 

  12446. procedure TSslContext.SetSslSessionCacheSize(Value: Longint);

    12447. 

  12447. begin

    12448. 

  12448. {$IFNDEF NO_SSL_MT}

    12449. 

  12449.     Lock;

    12450. 

  12450.     try

    12451. 

  12451. {$ENDIF}

    12452. 

  12452.         FSslSessionCacheSize := Value

    12453. 

  12453. {$IFNDEF NO_SSL_MT}

    12454. 

  12454.     finally

    12455. 

  12455.         Unlock

    12456. 

  12456.     end;

    12457. 

  12457. {$ENDIF}    

    12458. 

  12458. end;

    12459. 

  12459. 

    12460. 

  12460. 

    12461. 

  12461. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    12462. 

  12462. procedure TSslContext.SetSslSessionTimeout(Value: Longword);

    12463. 

  12463. begin

    12464. 

  12464. {$IFNDEF NO_SSL_MT}

    12465. 

  12465.     Lock;

    12466. 

  12466.     try

    12467. 

  12467. {$ENDIF}

    12468. 

  12468.         FSslSessionTimeout := Value

    12469. 

  12469. {$IFNDEF NO_SSL_MT}

    12470. 

  12470.     finally

    12471. 

  12471.         Unlock

    12472. 

  12472.     end;

    12473. 

  12473. {$ENDIF}    

    12474. 

  12474. end;

    12475. 

  12475. 

    12476. 

  12476. 

    12477. 

  12477. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    12478. 

  12478. procedure TSslContext.SetSslVersionMethod(Value: TSslVersionMethod);

    12479. 

  12479. begin

    12480. 

  12480. {$IFNDEF NO_SSL_MT}

    12481. 

  12481.     Lock;

    12482. 

  12482.     try

    12483. 

  12483. {$ENDIF}

    12484. 

  12484.         FSslVersionMethod := Value

    12485. 

  12485. {$IFNDEF NO_SSL_MT}

    12486. 

  12486.     finally

    12487. 

  12487.         Unlock

    12488. 

  12488.     end;

    12489. 

  12489. {$ENDIF}    

    12490. 

  12490. end;

    12491. 

  12491. 

    12492. 

  12492. 

    12493. 

  12493. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    12494. 

  12494. function TSslContext.GetSslOptions: TSslOptions; { V7.30 }

    12495. 

  12495. var 

    12496. 

  12496.     Opt: TSslOption;

    12497. 

  12497. begin

    12498. 

  12498. {$IFNDEF NO_SSL_MT}

    12499. 

  12499.     Lock;

    12500. 

  12500.     try

    12501. 

  12501. {$ENDIF}

    12502. 

  12502.         Result := [];

    12503. 

  12503.         for Opt := Low(TSslOption) to High(TSslOption) do

    12504. 

  12504.             if (FSslOptionsValue and SslIntOptions[Opt]) <> 0 then

    12505. 

  12505.                 Include(Result, Opt);

    12506. 

  12506. {$IFNDEF NO_SSL_MT}

    12507. 

  12507.     finally

    12508. 

  12508.         Unlock

    12509. 

  12509.     end;

    12510. 

  12510. {$ENDIF}    

    12511. 

  12511. end;

    12512. 

  12512. 

    12513. 

  12513. 

    12514. 

  12514. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    12515. 

  12515. procedure TSslContext.SetSslOptions(Value: TSslOptions); { V7.30 }

    12516. 

  12516. var 

    12517. 

  12517.     Opt: TSslOption;

    12518. 

  12518. begin

    12519. 

  12519. {$IFNDEF NO_SSL_MT}

    12520. 

  12520.     Lock;

    12521. 

  12521.     try

    12522. 

  12522. {$ENDIF}

    12523. 

  12523.         FSslOptionsValue := 0;

    12524. 

  12524.         for Opt := Low(TSslOption) to High(TSslOption) do

    12525. 

  12525.             if Opt in Value then

    12526. 

  12526.                 FSslOptionsValue := FSslOptionsValue or SslIntOptions[Opt];

    12527. 

  12527. {$IFNDEF NO_SSL_MT}

    12528. 

  12528.     finally

    12529. 

  12529.         Unlock;

    12530. 

  12530.     end;

    12531. 

  12531. {$ENDIF}    

    12532. 

  12532. end;

    12533. 

  12533. 

    12534. 

  12534. 

    12535. 

  12535. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    12536. 

  12536. procedure TSslContext.SetSslSessCacheModes(Value: TSslSessCacheModes); { V7.30 }

    12537. 

  12537. var 

    12538. 

  12538.     SessMode: TSslSessCacheMode;

    12539. 

  12539. begin

    12540. 

  12540. {$IFNDEF NO_SSL_MT}

    12541. 

  12541.     Lock;

    12542. 

  12542.     try

    12543. 

  12543. {$ENDIF}

    12544. 

  12544.         FSslSessCacheModeValue := SSL_SESS_CACHE_OFF;

    12545. 

  12545.         for SessMode := Low(TSslSessCacheMode) to High(TSslSessCacheMode) do

    12546. 

  12546.             if SessMode in Value then

    12547. 

  12547.                 FSslSessCacheModeValue := FSslSessCacheModeValue or SslIntSessCacheModes[SessMode];

    12548. 

  12548. {$IFNDEF NO_SSL_MT}

    12549. 

  12549.     finally

    12550. 

  12550.         Unlock;

    12551. 

  12551.     end;

    12552. 

  12552. {$ENDIF}

    12553. 

  12553. end;

    12554. 

  12554. 

    12555. 

  12555. 

    12556. 

  12556. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    12557. 

  12557. function TSslContext.GetSslSessCacheModes: TSslSessCacheModes; { V7.30 }

    12558. 

  12558. var 

    12559. 

  12559.     SessMode: TSslSessCacheMode;

    12560. 

  12560. begin

    12561. 

  12561. {$IFNDEF NO_SSL_MT}

    12562. 

  12562.     Lock;

    12563. 

  12563.     try

    12564. 

  12564. {$ENDIF}

    12565. 

  12565.         Result := [];

    12566. 

  12566.         for SessMode := Low(TSslSessCacheMode) to High(TSslSessCacheMode) do

    12567. 

  12567.             if FSslSessCacheModeValue and SslIntSessCacheModes[SessMode] <> 0 then

    12568. 

  12568.                 Include(Result, SessMode);

    12569. 

  12569. 

    12570. 

  12570. {$IFNDEF NO_SSL_MT}            

    12571. 

  12571.     finally

    12572. 

  12572.         Unlock;

    12573. 

  12573.     end;

    12574. 

  12574. {$ENDIF}    

    12575. 

  12575. end;

    12576. 

  12576. 

    12577. 

  12577. 

    12578. 

  12578. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    12579. 

  12579. procedure TSslContext.SetSslCipherList(const Value: String);

    12580. 

  12580. begin

    12581. 

  12581. {$IFNDEF NO_SSL_MT}

    12582. 

  12582.     Lock;

    12583. 

  12583.     try

    12584. 

  12584. {$ENDIF}

    12585. 

  12585.         if FSslCipherList = Value then

    12586. 

  12586.             Exit;   // No change, do nothing

    12587. 

  12587.         // Now should check the syntax. Will do later :-)

    12588. 

  12588.         FSslCipherList := Value;

    12589. 

  12589. {$IFNDEF NO_SSL_MT}        

    12590. 

  12590.     finally

    12591. 

  12591.         Unlock

    12592. 

  12592.     end;

    12593. 

  12593. {$ENDIF}

    12594. 

  12594. end;

    12595. 

  12595. 

    12596. 

  12596. 

    12597. 

  12597. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    12598. 

  12598. procedure TSslContext.SetSslVerifyPeerModes(

    12599. 

  12599.     const Value: TSslVerifyPeerModes);

    12600. 

  12600. begin

    12601. 

  12601. {$IFNDEF NO_SSL_MT}

    12602. 

  12602.     Lock;

    12603. 

  12603.     try

    12604. 

  12604. {$ENDIF}

    12605. 

  12605.         if Value <> FSslVerifyPeerModes then begin

    12606. 

  12606.             FSslVerifyPeerModesValue := 0;

    12607. 

  12607.             if (SslVerifyMode_NONE in Value) then

    12608. 

  12608.                 FSslVerifyPeerModesValue := FSslVerifyPeerModesValue or SSL_VERIFY_NONE;

    12609. 

  12609.             if (SslVerifyMode_PEER in Value) then

    12610. 

  12610.                 FSslVerifyPeerModesValue := FSslVerifyPeerModesValue or SSL_VERIFY_PEER;

    12611. 

  12611.             if (SslVerifyMode_FAIL_IF_NO_PEER_CERT in Value) then

    12612. 

  12612.                 FSslVerifyPeerModesValue := FSslVerifyPeerModesValue or SSL_VERIFY_FAIL_IF_NO_PEER_CERT;

    12613. 

  12613.             if (SslVerifyMode_CLIENT_ONCE in Value) then

    12614. 

  12614.                 FSslVerifyPeerModesValue := FSslVerifyPeerModesValue or SSL_VERIFY_CLIENT_ONCE;

    12615. 

  12615.             FSslVerifyPeerModes := Value;

    12616. 

  12616.         end;

    12617. 

  12617. 

    12618. 

  12618.         if not Assigned(FSslCtx) then

    12619. 

  12619.             Exit;

    12620. 

  12620. 

    12621. 

  12621.         { We may change these settings any time since they won't change active Ssl's }

    12622. 

  12622.         if FSslVerifyPeer then begin

    12623. 

  12623.             if f_SSL_CTX_get_verify_mode(FSslCtx) <> FSslVerifyPeerModesValue then begin

    12624. 

  12624.                 f_SSL_CTX_set_verify(FSslCtx, FSslVerifyPeerModesValue, PeerVerifyCallback);

    12625. 

  12625. {$IFDEF OPENSSL_VERSION_NUMBER_LESS_THAN_0x00905100L}

    12626. 

  12626.                 f_SSL_CTX_set_verify_depth(FSslCtx, 1);

    12627. 

  12627. {$ELSE}

    12628. 

  12628.                 f_SSL_CTX_set_verify_depth(FSslCtx, FSslVerifyDepth);

    12629. 

  12629. {$ENDIF}

    12630. 

  12630.             end;

    12631. 

  12631.         end

    12632. 

  12632.         else begin

    12633. 

  12633.             f_SSL_CTX_set_verify(FSslCtx, 0, nil);

    12634. 

  12634.             f_SSL_CTX_set_verify_depth(FSslCtx, 0);

    12635. 

  12635.         end;

    12636. 

  12636. {$IFNDEF NO_SSL_MT}

    12637. 

  12637.     finally

    12638. 

  12638.         Unlock;

    12639. 

  12639.     end;

    12640. 

  12640. {$ENDIF}

    12641. 

  12641. end;

    12642. 

  12642. 

    12643. 

  12643. 

    12644. 

  12644. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    12645. 

  12645. procedure TSslContext.SetSslVerifyPeer(const Value: Boolean);

    12646. 

  12646. begin

    12647. 

  12647. {$IFNDEF NO_SSL_MT}

    12648. 

  12648.     Lock;

    12649. 

  12649.     try

    12650. 

  12650. {$ENDIF}

    12651. 

  12651.         if Value <> FSslVerifyPeer then begin

    12652. 

  12652.             FSslVerifyPeer := Value;

    12653. 

  12653.             SetSslVerifyPeerModes(FSslVerifyPeerModes);

    12654. 

  12654.         end;

    12655. 

  12655. {$IFNDEF NO_SSL_MT}        

    12656. 

  12656.     finally

    12657. 

  12657.         Unlock;

    12658. 

  12658.     end;

    12659. 

  12659. {$ENDIF}    

    12660. 

  12660. end;

    12661. 

  12661. 

    12662. 

  12662. 

    12663. 

  12663. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    12664. 

  12664. procedure TSslContext.SetSslDefaultSessionIDContext(

    12665. 

  12665.     Value: TSslSessionIdContext);

    12666. 

  12666. begin

    12667. 

  12667. {$IFNDEF NO_SSL_MT}

    12668. 

  12668.     Lock;

    12669. 

  12669.     try

    12670. 

  12670. {$ENDIF}

    12671. 

  12671.         if Length(Value) > SSL_MAX_SSL_SESSION_ID_LENGTH then

    12672. 

  12672.             SetLength(Value, SSL_MAX_SSL_SESSION_ID_LENGTH);

    12673. 

  12673.         if FSslDefaultSessionIDContext <> Value then begin

    12674. 

  12674.             FSslDefaultSessionIDContext := Value;

    12675. 

  12675.             if Assigned(FSslCtx) and (SSL_SESS_CACHE_SERVER and

    12676. 

  12676.                FSslSessCacheModeValue <> 1) then begin

    12677. 

  12677.                 if Length(Value) > 0 then

    12678. 

  12678.                     f_SSL_CTX_set_session_id_context(FSslCtx,

    12679. 

  12679.                                                      @Value[1],

    12680. 

  12680.                                                      Length(Value))

    12681. 

  12681.                 else

    12682. 

  12682.                     f_SSL_CTX_set_session_id_context(FSslCtx, nil, 0);

    12683. 

  12683.             end;

    12684. 

  12684.         end;

    12685. 

  12685. {$IFNDEF NO_SSL_MT}

    12686. 

  12686.     finally

    12687. 

  12687.         Unlock

    12688. 

  12688.     end;

    12689. 

  12689. {$ENDIF}    

    12690. 

  12690. end;

    12691. 

  12691. 

    12692. 

  12692. 

    12693. 

  12693. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    12694. 

  12694. {procedure TSslContext.SetSslX509Trust(const Value: TSslX509Trust);

    12695. 

  12695. begin

    12696. 

  12696.     if Value <> FSslX509Trust then begin

    12697. 

  12697.         FSslX509Trust := Value;

    12698. 

  12698.         if Assigned(FSslCtx) then

    12699. 

  12699.             if FSslX509Trust <> ssl_X509_TRUST_NOT_DEFINED then

    12700. 

  12700.                 if f_SSL_CTX_set_trust(FSslCtx, Integer(FSslX509Trust)) = 0 then

    12701. 

  12701.                     raise Exception.Create('Error setting trust');

    12702. 

  12702.     end;

    12703. 

  12703. end; }

    12704. 

  12704. 

    12705. 

  12705. 

    12706. 

  12706. 

    12707. 

  12707. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    12708. 

  12708. (*

    12709. 

  12709. { TX509Stack }

    12710. 

  12710. constructor TX509Stack.Create;

    12711. 

  12711. begin

    12712. 

  12712.     inherited Create;

    12713. 

  12713.     FStack := nil;

    12714. 

  12714.     FStack := f_sk_new_null;

    12715. 

  12715.     FCount := 0;

    12716. 

  12716. end;

    12717. 

  12717. 

    12718. 

  12718. 

    12719. 

  12719. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    12720. 

  12720. destructor TX509Stack.Destroy;

    12721. 

  12721. begin

    12722. 

  12722.     if Assigned(FStack) then begin

    12723. 

  12723.         Clear;

    12724. 

  12724.         f_sk_free(FStack);

    12725. 

  12725.         FStack := nil;

    12726. 

  12726.     end;

    12727. 

  12727.     inherited Destroy;

    12728. 

  12728. end;

    12729. 

  12729. 

    12730. 

  12730. 

    12731. 

  12731. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    12732. 

  12732. function TX509Stack.Add(Cert: PX509): Integer;

    12733. 

  12733. begin

    12734. 

  12734.     Result := InternalInsert(Cert, f_sk_num(FStack)) - 1;

    12735. 

  12735. end;

    12736. 

  12736. 

    12737. 

  12737. 

    12738. 

  12738. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    12739. 

  12739. procedure TX509Stack.Clear;

    12740. 

  12740. begin

    12741. 

  12741.      while FCount > 0 do

    12742. 

  12742.         Delete(0);

    12743. 

  12743. end;

    12744. 

  12744. 

    12745. 

  12745. 

    12746. 

  12746. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    12747. 

  12747. procedure TX509Stack.SetStack(const Value: PSTACK);

    12748. 

  12748. var

    12749. 

  12749.     I: Integer;

    12750. 

  12750. begin

    12751. 

  12751.     Clear;

    12752. 

  12752.     if Value <> nil then

    12753. 

  12753.         for I := 0 to f_sk_num(Value) - 1 do

    12754. 

  12754.             Add(PX509(f_sk_value(Value, I)));

    12755. 

  12755. end;

    12756. 

  12756. 

    12757. 

  12757. 

    12758. 

  12758. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    12759. 

  12759. procedure TX509Stack.Delete(Index: Integer);

    12760. 

  12760. var

    12761. 

  12761.     P : PChar;

    12762. 

  12762. begin

    12763. 

  12763.     P := nil;

    12764. 

  12764.     P := f_sk_delete(FStack, Index);

    12765. 

  12765.     if P <> nil then begin

    12766. 

  12766.         Dec(FCount);

    12767. 

  12767.         f_X509_free(PX509(P));

    12768. 

  12768.     end else

    12769. 

  12769.         raise EX509Exception.Create('Delete failed');

    12770. 

  12770. end;

    12771. 

  12771. 

    12772. 

  12772. 

    12773. 

  12773. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    12774. 

  12774. function TX509Stack.IndexOf(Cert: PX509): Integer;

    12775. 

  12775. begin

    12776. 

  12776.     Result := 0;

    12777. 

  12777.     while (Result < FCount) and

    12778. 

  12778.           (PX509(f_sk_value(FStack, Result)) <> Cert) do

    12779. 

  12779.         Inc(Result);

    12780. 

  12780.     if Result = FCount then

    12781. 

  12781.         Result := -1;

    12782. 

  12782. end;

    12783. 

  12783. 

    12784. 

  12784. 

    12785. 

  12785. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    12786. 

  12786. procedure TX509Stack.Insert(Cert: PX509; Index: Integer);

    12787. 

  12787. begin

    12788. 

  12788.     InternalInsert(Cert, Index)

    12789. 

  12789. end;

    12790. 

  12790. 

    12791. 

  12791. 

    12792. 

  12792. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    12793. 

  12793. function TX509Stack.InternalInsert(Cert: PX509; Index: Integer): Integer;

    12794. 

  12794. var

    12795. 

  12795.     P : PX509;

    12796. 

  12796. begin

    12797. 

  12797.     if (Index < 0) then

    12798. 

  12798.         raise EX509Exception.Create('Invalid index');

    12799. 

  12799.     if Cert = nil then

    12800. 

  12800.         raise EX509Exception.Create('Cert not assigned');

    12801. 

  12801.     P := nil;

    12802. 

  12802.     P := f_X509_dup(Cert);  // increment reference count

    12803. 

  12803.     if P = nil then

    12804. 

  12804.         raise EX509Exception.Create('X509_dup failed');

    12805. 

  12805.     Result := f_sk_insert(FStack, PChar(P), Index);

    12806. 

  12806.     if Result = 0 then

    12807. 

  12807.         f_X509_free(P)

    12808. 

  12808.     else

    12809. 

  12809.         FCount := Result;

    12810. 

  12810. end;

    12811. 

  12811. 

    12812. 

  12812. 

    12813. 

  12813. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    12814. 

  12814. function TX509Stack.GetCert(Index: Integer): PX509;

    12815. 

  12815. begin

    12816. 

  12816.     Result := PX509(f_sk_value(FStack, Index));

    12817. 

  12817. end;

    12818. 

  12818. 

    12819. 

  12819. 

    12820. 

  12820. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    12821. 

  12821. procedure TX509Stack.SetCert(Index: Integer; const Value: PX509);

    12822. 

  12822. begin

    12823. 

  12823.     if (Index < 0) or (Index >= FCount) then

    12824. 

  12824.         raise EX509Exception.Create('Invalid index');

    12825. 

  12825.     Delete(Index);

    12826. 

  12826.     InternalInsert(Value, Index);

    12827. 

  12827. end;

    12828. 

  12828. 

    12829. 

  12829. *)

    12830. 

  12830. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    12831. 

  12831. constructor TX509Base.Create(AOwner: TComponent; X509: Pointer = nil);

    12832. 

  12832. begin

    12833. 

  12833.     inherited Create(AOwner);

    12834. 

  12834.     FPrivateKey := nil;

    12835. 

  12835.     AssignDefaults;

    12836. 

  12836.     if Assigned(X509) then begin

    12837. 

  12837.         InitializeSsl;

    12838. 

  12838.         FX509     := f_X509_dup(X509);

    12839. 

  12839.         FSha1Hash := GetSha1Hash;

    12840. 

  12840.     end;

    12841. 

  12841. end;

    12842. 

  12842. 

    12843. 

  12843. 

    12844. 

  12844. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    12845. 

  12845. destructor TX509Base.Destroy;

    12846. 

  12846. begin

    12847. 

  12847.     FreeAndNilX509;

    12848. 

  12848.     if Assigned(FPrivateKey) then begin

    12849. 

  12849.         f_EVP_PKEY_free(FPrivateKey);

    12850. 

  12850.         FPrivateKey := nil;

    12851. 

  12851.     end;

    12852. 

  12852.     inherited Destroy;

    12853. 

  12853. end;

    12854. 

  12854. 

    12855. 

  12855. 

    12856. 

  12856. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    12857. 

  12857. procedure TX509Base.FreeAndNilX509;

    12858. 

  12858. begin

    12859. 

  12859.     if Assigned(FX509) then begin

    12860. 

  12860.         f_X509_free(FX509);

    12861. 

  12861.         FX509 := nil;

    12862. 

  12862.     end;

    12863. 

  12863. end;

    12864. 

  12864. 

    12865. 

  12865. 

    12866. 

  12866. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    12867. 

  12867. procedure TX509Base.SetX509(X509: Pointer);

    12868. 

  12868. begin

    12869. 

  12869.     InitializeSsl;

    12870. 

  12870.     FreeAndNilX509;

    12871. 

  12871.     AssignDefaults;

    12872. 

  12872.     if Assigned(X509) then begin

    12873. 

  12873.         FX509     := f_X509_dup(X509);

    12874. 

  12874.         FSha1Hash := GetSha1Hash;

    12875. 

  12875.     end;

    12876. 

  12876. end;

    12877. 

  12877. 

    12878. 

  12878. 

    12879. 

  12879. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    12880. 

  12880. procedure TX509Base.SetPrivateKey(PKey: Pointer);

    12881. 

  12881. begin

    12882. 

  12882.     InitializeSsl;

    12883. 

  12883.     if Assigned(FPrivateKey) then begin

    12884. 

  12884.         f_EVP_PKEY_free(FPrivateKey);

    12885. 

  12885.         FPrivateKey := nil;

    12886. 

  12886.     end;

    12887. 

  12887.     if Assigned(PKey) then

    12888. 

  12888.         FPrivateKey := Ics_EVP_PKEY_dup(PKey);

    12889. 

  12889. end;

    12890. 

  12890. 

    12891. 

  12891. 

    12892. 

  12892. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    12893. 

  12893. function TX509Base.GetPublicKey: Pointer;                       {AG 11/08/07}

    12894. 

  12894. begin

    12895. 

  12895.     if Assigned(FX509) then

    12896. 

  12896.         Result := f_X509_get_pubkey(FX509)

    12897. 

  12897.     else

    12898. 

  12898.         Result := nil;

    12899. 

  12899. end;

    12900. 

  12900. 

    12901. 

  12901. 

    12902. 

  12902. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    12903. 

  12903. function TX509Base.GetExtensionCount: Integer;

    12904. 

  12904. begin

    12905. 

  12905.     if Assigned(FX509) then

    12906. 

  12906.         Result := f_X509_get_ext_count(FX509)

    12907. 

  12907.     else

    12908. 

  12908.         Result := 0;

    12909. 

  12909. end;

    12910. 

  12910. 

    12911. 

  12911. 

    12912. 

  12912. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    12913. 

  12913. function TX509Base.ExtByName(const ShortName: String): Integer;

    12914. 

  12914. var

    12915. 

  12915.     Ext     : PX509_EXTENSION;

    12916. 

  12916.     Count   : Integer;

    12917. 

  12917.     I       : Integer;

    12918. 

  12918.     Len     : Integer;

    12919. 

  12919.     ExtStr  : PAnsiChar;

    12920. 

  12920.     B       : PBIO;

    12921. 

  12921.     Nid     : Integer;

    12922. 

  12922. begin

    12923. 

  12923.     Result := -1;

    12924. 

  12924.     if Assigned(FX509) then begin

    12925. 

  12925.         Count := GetExtensionCount;

    12926. 

  12926.         for I := 0 to Count -1 do begin

    12927. 

  12927.             //Ext := nil;

    12928. 

  12928.             Ext := f_X509_get_ext(FX509, I);

    12929. 

  12929.             if not Assigned(Ext) then

    12930. 

  12930.                 Continue;

    12931. 

  12931.             Nid := f_OBJ_obj2nid(f_X509_EXTENSION_get_object(Ext));

    12932. 

  12932.             if Nid <> NID_undef then begin

    12933. 

  12933.                 ExtStr := f_OBJ_nid2sn(Nid);

    12934. 

  12934.                 if _StrLIComp(ExtStr, PAnsiChar(AnsiString(ShortName)), 255) = 0 then begin

    12935. 

  12935.                     Result := I;

    12936. 

  12936.                     Exit;

    12937. 

  12937.                 end;

    12938. 

  12938.             end

    12939. 

  12939.             else begin // custom extension

    12940. 

  12940.                 //B := nil;

    12941. 

  12941.                 B := f_BIO_new(f_BIO_s_mem);

    12942. 

  12942.                 if Assigned(B) then begin

    12943. 

  12943.                     try

    12944. 

  12944.                         f_i2a_ASN1_OBJECT(B, f_X509_EXTENSION_get_object(Ext));

    12945. 

  12945.                         Len := f_BIO_ctrl(B, BIO_CTRL_PENDING, 0, nil);

    12946. 

  12946.                         if Len > 0 then begin

    12947. 

  12947.                             GetMem(ExtStr, Len);

    12948. 

  12948.                             try

    12949. 

  12949.                                 f_Bio_read(B, ExtStr, Len);

    12950. 

  12950.                                 if _StrLIComp(ExtStr, PAnsiChar(AnsiString(ShortName)), 255) = 0 then begin

    12951. 

  12951.                                     Result := I;

    12952. 

  12952.                                     Exit;

    12953. 

  12953.                                 end;

    12954. 

  12954.                             finally

    12955. 

  12955.                                 FreeMem(ExtStr);

    12956. 

  12956.                             end;

    12957. 

  12957.                         end;

    12958. 

  12958.                     finally

    12959. 

  12959.                         f_bio_free(B);

    12960. 

  12960.                     end;

    12961. 

  12961.                 end;

    12962. 

  12962.             end;

    12963. 

  12963.         end;

    12964. 

  12964.     end

    12965. 

  12965. end;

    12966. 

  12966. 

    12967. 

  12967. 

    12968. 

  12968. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    12969. 

  12969. function TX509Base.GetIssuerOneLine: String;

    12970. 

  12970. var

    12971. 

  12971.     Str : AnsiString;

    12972. 

  12972. begin

    12973. 

  12973.     Result := '';

    12974. 

  12974.     if not Assigned(FX509) then

    12975. 

  12975.         Exit;

    12976. 

  12976. 

    12977. 

  12977.     SetLength(Str, 512);

    12978. 

  12978.     Str := f_X509_NAME_oneline(f_X509_get_issuer_name(FX509),

    12979. 

  12979.                                PAnsiChar(Str),

    12980. 

  12980.                                Length(Str));

    12981. 

  12981.     SetLength(Str, _StrLen(PAnsiChar(Str)));

    12982. 

  12982.     Result := String(Str);

    12983. 

  12983. end;

    12984. 

  12984. 

    12985. 

  12985. 

    12986. 

  12986. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    12987. 

  12987. function TX509Base.GetSerialNum: Integer;

    12988. 

  12988. begin

    12989. 

  12989.     if Assigned(FX509) then

    12990. 

  12990.         Result := f_ASN1_INTEGER_get(f_X509_get_serialNumber(FX509))

    12991. 

  12991.     else

    12992. 

  12992.         Result := -1;

    12993. 

  12993. end;

    12994. 

  12994. 

    12995. 

  12995. 

    12996. 

  12996. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    12997. 

  12997. function TX509Base.GetSha1Hash: AnsiString; { V7.31 }

    12998. 

  12998. var

    12999. 

  12999.     Len : Integer;

    13000. 

  13000. begin

    13001. 

  13001.     if Assigned(FX509) then begin

    13002. 

  13002.         SetLength(Result, 20);

    13003. 

  13003.         if f_X509_digest(FX509, f_EVP_sha1, PAnsiChar(Result), @Len) = 0 then

    13004. 

  13004.             Result := '';    

    13005. 

  13005.     end

    13006. 

  13006.     else

    13007. 

  13007.         Result := '';

    13008. 

  13008. end;

    13009. 

  13009. 

    13010. 

  13010. 

    13011. 

  13011. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    13012. 

  13012. function TX509Base.UnknownExtDataToStr(Ext: PX509_Extension) : String;

    13013. 

  13013. {var

    13014. 

  13014.     B   : PBIO;

    13015. 

  13015.     Len : Integer; }

    13016. 

  13016. begin

    13017. 

  13017.     Result := Asn1ToString(PASN1_STRING(f_X509_EXTENSION_get_data(Ext)));

    13018. 

  13018.     {B := f_BIO_new(f_BIO_s_mem);

    13019. 

  13019.     if Assigned(B) then begin

    13020. 

  13020.         try

    13021. 

  13021.             f_ASN1_STRING_print(B, PASN1_STRING(f_X509_EXTENSION_get_data(Ext)));

    13022. 

  13022.             Len := f_BIO_ctrl(B, BIO_CTRL_PENDING, 0, nil);

    13023. 

  13023.             SetLength(Result, Len);

    13024. 

  13024.             if Len > 0 then begin

    13025. 

  13025.                 f_Bio_read(B, PChar(Result), Len);

    13026. 

  13026.                 SetLength(Result, StrLen(PChar(Result)));

    13027. 

  13027.             end;

    13028. 

  13028.         finally

    13029. 

  13029.             f_BIO_free(B);

    13030. 

  13030.         end;

    13031. 

  13031.     end

    13032. 

  13032.     else

    13033. 

  13033.         Result := '';}

    13034. 

  13034. end;

    13035. 

  13035. 

    13036. 

  13036. 

    13037. 

  13037. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

    13038. 

  13038. function TX509Base.GetExtension(Index: Integer): TExtension;

    13039. 

  13039. var

    13040. 

  13040.     ExtCount : Integer;

    13041. 

  13041.     J        : Integer;

    13042. 

  13042.     Ext      : PX509_EXTENSION;

    13043. 

  13043.     Value    : PAnsiChar;

    13044. 

  13044.     Meth     : PX509V3_EXT_METHOD;

    13045. 

  13045.     Data     : PAnsiChar;

    13046. 

  13046.     Val      : PSTACK;

    13047. 

  13047.     NVal     : PCONF_VALUE;

    13048. 

  13048.     ext_str  : Pointer;

    13049. 

  13049.     B        : PBIO;

    13050. 

  13050.     Nid      : Integer;

    13051. 

  13051.     ABuf     : AnsiString;

    13052. 

  13052. begin

    13053. 

  13053.     Result.Critical  := FALSE;

    13054. 

  13054.     Result.ShortName := '';

    13055. 

  13055.     Result.Value     := '';

    13056. 

  13056.     if not Assigned(FX509) then

    13057. 

  13057.         Exit;

    13058. 

  13058.     ExtCount := ExtensionCount;

    13059. 

  13059.     if (Index < 0) or (Index > ExtCount -1) then

    13060. 

  13060.         raise EX509Exception.Create('Extension index out of bounds');

    13061. 

  13061.     Value   := nil;

    13062. 

  13062.     Meth    := nil;

    13063. 

  13063.     Val     := nil;

    13064. 

  13064.     ext_str := nil;

    13065. 

  13065.     //Ext   := nil;

    13066. 

  13066.     Ext     := f_X509_get_ext(FX509, Index);

    13067. 

  13067.     if not Assigned(Ext) then

    13068. 

  13068.         raise EX509Exception.Create('Extension not assigned');

    13069. 

  13069.     Result.Critical := f_X509_EXTENSION_get_critical(Ext) > 0;

    13070. 

  13070.     Nid := f_OBJ_obj2nid(f_X509_EXTENSION_get_object(Ext));

    13071. 

  13071.     if Nid <> NID_undef then

    13072. 

  13072.         Result.ShortName := String(_StrPas(f_OBJ_nid2sn(Nid)))

    13073. 

  13073.     else begin // custom extension

    13074. 

  13074.         //B := nil;

    13075. 

  13075.         B := f_BIO_new(f_BIO_s_mem);

    13076. 

  13076.         if Assigned(B) then begin

    13077. 

  13077.             try

    13078. 

  13078.                 f_i2a_ASN1_OBJECT(B, f_X509_EXTENSION_get_object(Ext));

    13079. 

  13079.                 J := f_BIO_ctrl(B, BIO_CTRL_PENDING, 0, nil);

    13080. 

  13080.                 SetLength(ABuf, J);

    13081. 

  13081.                 if J > 0 then begin

    13082. 

  13082.                     f_Bio_read(B, PAnsiChar(ABuf), J);

    13083. 

  13083.                     SetLength(ABuf, _StrLen(PAnsiChar(ABuf)));

    13084. 

  13084.                     Result.ShortName := String(ABuf);

    13085. 

  13085.                 end;

    13086. 

  13086.             finally

    13087. 

  13087.                 f_bio_free(B);

    13088. 

  13088.             end;

    13089. 

  13089.         end;

    13090. 

  13090.     end;

    13091. 

  13091. 

    13092. 

  13092.     try

    13093. 

  13093.         Meth := f_X509V3_EXT_get(Ext);

    13094. 

  13094.         if Meth = nil then begin

    13095. 

  13095.             Result.Value := UnknownExtDataToStr(Ext);

    13096. 

  13096.             Exit;

    13097. 

  13097.         end;

    13098. 

  13098.         Data := Ext^.value^.data;

    13099. 

  13099.         if Assigned(Meth^.it) then

    13100. 

  13100.             ext_str := f_ASN1_item_d2i(nil,

    13101. 

  13101.             
    13102.