source: trunk/Packages/synapse/blcksock.pas

Last change on this file was 5, checked in by chronos, 13 years ago
  • Added: Required packages.
File size: 125.3 KB
Line 
1{==============================================================================|
2| Project : Ararat Synapse | 009.006.000 |
3|==============================================================================|
4| Content: Library base |
5|==============================================================================|
6| Copyright (c)1999-2008, Lukas Gebauer |
7| All rights reserved. |
8| |
9| Redistribution and use in source and binary forms, with or without |
10| modification, are permitted provided that the following conditions are met: |
11| |
12| Redistributions of source code must retain the above copyright notice, this |
13| list of conditions and the following disclaimer. |
14| |
15| Redistributions in binary form must reproduce the above copyright notice, |
16| this list of conditions and the following disclaimer in the documentation |
17| and/or other materials provided with the distribution. |
18| |
19| Neither the name of Lukas Gebauer nor the names of its contributors may |
20| be used to endorse or promote products derived from this software without |
21| specific prior written permission. |
22| |
23| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" |
24| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
25| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
26| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR |
27| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
28| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR |
29| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER |
30| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
31| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
32| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH |
33| DAMAGE. |
34|==============================================================================|
35| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
36| Portions created by Lukas Gebauer are Copyright (c)1999-2008. |
37| All Rights Reserved. |
38|==============================================================================|
39| Contributor(s): |
40|==============================================================================|
41| History: see HISTORY.HTM from distribution package |
42| (Found at URL: http://www.ararat.cz/synapse/) |
43|==============================================================================}
44
45{
46Special thanks to Gregor Ibic <gregor.ibic@intelicom.si>
47 (Intelicom d.o.o., http://www.intelicom.si)
48 for good inspiration about SSL programming.
49}
50
51{$DEFINE ONCEWINSOCK}
52{Note about define ONCEWINSOCK:
53If you remove this compiler directive, then socket interface is loaded and
54initialized on constructor of TBlockSocket class for each socket separately.
55Socket interface is used only if your need it.
56
57If you leave this directive here, then socket interface is loaded and
58initialized only once at start of your program! It boost performace on high
59count of created and destroyed sockets. It eliminate possible small resource
60leak on Windows systems too.
61}
62
63//{$DEFINE RAISEEXCEPT}
64{When you enable this define, then is Raiseexcept property is on by default
65}
66
67{:@abstract(Synapse's library core)
68
69Core with implementation basic socket classes.
70}
71
72{$IFDEF FPC}
73 {$MODE DELPHI}
74{$ENDIF}
75{$IFDEF VER125}
76 {$DEFINE BCB}
77{$ENDIF}
78{$IFDEF BCB}
79 {$ObjExportAll On}
80{$ENDIF}
81{$Q-}
82{$H+}
83{$M+}
84
85unit blcksock;
86
87interface
88
89uses
90 SysUtils, Classes,
91 synafpc,
92 synsock, synautil, synacode, synaip
93{$IFDEF CIL}
94 ,System.Net
95 ,System.Net.Sockets
96 ,System.Text
97{$ENDIF}
98 ;
99
100const
101
102 SynapseRelease = '38';
103
104 cLocalhost = '127.0.0.1';
105 cAnyHost = '0.0.0.0';
106 cBroadcast = '255.255.255.255';
107 c6Localhost = '::1';
108 c6AnyHost = '::0';
109 c6Broadcast = 'ffff::1';
110 cAnyPort = '0';
111 CR = #$0d;
112 LF = #$0a;
113 CRLF = CR + LF;
114 c64k = 65536;
115
116type
117
118 {:@abstract(Exception clas used by Synapse)
119 When you enable generating of exceptions, this exception is raised by
120 Synapse's units.}
121 ESynapseError = class(Exception)
122 private
123 FErrorCode: Integer;
124 FErrorMessage: string;
125 published
126 {:Code of error. Value depending on used operating system}
127 property ErrorCode: Integer read FErrorCode Write FErrorCode;
128 {:Human readable description of error.}
129 property ErrorMessage: string read FErrorMessage Write FErrorMessage;
130 end;
131
132 {:Types of OnStatus events}
133 THookSocketReason = (
134 {:Resolving is begin. Resolved IP and port is in parameter in format like:
135 'localhost.somewhere.com:25'.}
136 HR_ResolvingBegin,
137 {:Resolving is done. Resolved IP and port is in parameter in format like:
138 'localhost.somewhere.com:25'. It is always same as in HR_ResolvingBegin!}
139 HR_ResolvingEnd,
140 {:Socket created by CreateSocket method. It reporting Family of created
141 socket too!}
142 HR_SocketCreate,
143 {:Socket closed by CloseSocket method.}
144 HR_SocketClose,
145 {:Socket binded to IP and Port. Binded IP and Port is in parameter in format
146 like: 'localhost.somewhere.com:25'.}
147 HR_Bind,
148 {:Socket connected to IP and Port. Connected IP and Port is in parameter in
149 format like: 'localhost.somewhere.com:25'.}
150 HR_Connect,
151 {:Called when CanRead method is used with @True result.}
152 HR_CanRead,
153 {:Called when CanWrite method is used with @True result.}
154 HR_CanWrite,
155 {:Socket is swithed to Listen mode. (TCP socket only)}
156 HR_Listen,
157 {:Socket Accepting client connection. (TCP socket only)}
158 HR_Accept,
159 {:report count of bytes readed from socket. Number is in parameter string.
160 If you need is in integer, you must use StrToInt function!}
161 HR_ReadCount,
162 {:report count of bytes writed to socket. Number is in parameter string. If
163 you need is in integer, you must use StrToInt function!}
164 HR_WriteCount,
165 {:If is limiting of bandwidth on, then this reason is called when sending or
166 receiving is stopped for satisfy bandwidth limit. Parameter is count of
167 waiting milliseconds.}
168 HR_Wait,
169 {:report situation where communication error occured. When raiseexcept is
170 @true, then exception is called after this Hook reason.}
171 HR_Error
172 );
173
174 {:Procedural type for OnStatus event. Sender is calling TBlockSocket object,
175 Reason is one of set Status events and value is optional data.}
176 THookSocketStatus = procedure(Sender: TObject; Reason: THookSocketReason;
177 const Value: String) of object;
178
179 {:This procedural type is used for DataFilter hooks.}
180 THookDataFilter = procedure(Sender: TObject; var Value: AnsiString) of object;
181
182 {:This procedural type is used for hook OnCreateSocket. By this hook you can
183 insert your code after initialisation of socket. (you can set special socket
184 options, etc.)}
185 THookCreateSocket = procedure(Sender: TObject) of object;
186
187 {:This procedural type is used for monitoring of communication.}
188 THookMonitor = procedure(Sender: TObject; Writing: Boolean;
189 const Buffer: TMemory; Len: Integer) of object;
190
191 {:This procedural type is used for hook OnAfterConnect. By this hook you can
192 insert your code after TCP socket has been sucessfully connected.}
193 THookAfterConnect = procedure(Sender: TObject) of object;
194
195 {:This procedural type is used for hook OnHeartbeat. By this hook you can
196 call your code repeately during long socket operations.
197 You must enable heartbeats by @Link(HeartbeatRate) property!}
198 THookHeartbeat = procedure(Sender: TObject) of object;
199
200 {:Specify family of socket.}
201 TSocketFamily = (
202 {:Default mode. Socket family is defined by target address for connection.
203 It allows instant access to IPv4 and IPv6 nodes. When you need IPv6 address
204 as destination, then is used IPv6 mode. othervise is used IPv4 mode.
205 However this mode not working properly with preliminary IPv6 supports!}
206 SF_Any,
207 {:Turn this class to pure IPv4 mode. This mode is totally compatible with
208 previous Synapse releases.}
209 SF_IP4,
210 {:Turn to only IPv6 mode.}
211 SF_IP6
212 );
213
214 {:specify possible values of SOCKS modes.}
215 TSocksType = (
216 ST_Socks5,
217 ST_Socks4
218 );
219
220 {:Specify requested SSL/TLS version for secure connection.}
221 TSSLType = (
222 LT_all,
223 LT_SSLv2,
224 LT_SSLv3,
225 LT_TLSv1,
226 LT_TLSv1_1,
227 LT_SSHv2
228 );
229
230 {:Specify type of socket delayed option.}
231 TSynaOptionType = (
232 SOT_Linger,
233 SOT_RecvBuff,
234 SOT_SendBuff,
235 SOT_NonBlock,
236 SOT_RecvTimeout,
237 SOT_SendTimeout,
238 SOT_Reuse,
239 SOT_TTL,
240 SOT_Broadcast,
241 SOT_MulticastTTL,
242 SOT_MulticastLoop
243 );
244
245 {:@abstract(this object is used for remember delayed socket option set.)}
246 TSynaOption = class(TObject)
247 public
248 Option: TSynaOptionType;
249 Enabled: Boolean;
250 Value: Integer;
251 end;
252
253 TCustomSSL = class;
254 TSSLClass = class of TCustomSSL;
255
256 {:@abstract(Basic IP object.)
257 This is parent class for other class with protocol implementations. Do not
258 use this class directly! Use @link(TICMPBlockSocket), @link(TRAWBlockSocket),
259 @link(TTCPBlockSocket) or @link(TUDPBlockSocket) instead.}
260 TBlockSocket = class(TObject)
261 private
262 FOnStatus: THookSocketStatus;
263 FOnReadFilter: THookDataFilter;
264 FOnCreateSocket: THookCreateSocket;
265 FOnMonitor: THookMonitor;
266 FOnHeartbeat: THookHeartbeat;
267 FLocalSin: TVarSin;
268 FRemoteSin: TVarSin;
269 FTag: integer;
270 FBuffer: AnsiString;
271 FRaiseExcept: Boolean;
272 FNonBlockMode: Boolean;
273 FMaxLineLength: Integer;
274 FMaxSendBandwidth: Integer;
275 FNextSend: LongWord;
276 FMaxRecvBandwidth: Integer;
277 FNextRecv: LongWord;
278 FConvertLineEnd: Boolean;
279 FLastCR: Boolean;
280 FLastLF: Boolean;
281 FBinded: Boolean;
282 FFamily: TSocketFamily;
283 FFamilySave: TSocketFamily;
284 FIP6used: Boolean;
285 FPreferIP4: Boolean;
286 FDelayedOptions: TList;
287 FInterPacketTimeout: Boolean;
288 {$IFNDEF CIL}
289 FFDSet: TFDSet;
290 {$ENDIF}
291 FRecvCounter: Integer;
292 FSendCounter: Integer;
293 FSendMaxChunk: Integer;
294 FStopFlag: Boolean;
295 FNonblockSendTimeout: Integer;
296 FHeartbeatRate: integer;
297 function GetSizeRecvBuffer: Integer;
298 procedure SetSizeRecvBuffer(Size: Integer);
299 function GetSizeSendBuffer: Integer;
300 procedure SetSizeSendBuffer(Size: Integer);
301 procedure SetNonBlockMode(Value: Boolean);
302 procedure SetTTL(TTL: integer);
303 function GetTTL:integer;
304 procedure SetFamily(Value: TSocketFamily); virtual;
305 procedure SetSocket(Value: TSocket); virtual;
306 function GetWsaData: TWSAData;
307 function FamilyToAF(f: TSocketFamily): TAddrFamily;
308 protected
309 FSocket: TSocket;
310 FLastError: Integer;
311 FLastErrorDesc: string;
312 procedure SetDelayedOption(const Value: TSynaOption);
313 procedure DelayedOption(const Value: TSynaOption);
314 procedure ProcessDelayedOptions;
315 procedure InternalCreateSocket(Sin: TVarSin);
316 procedure SetSin(var Sin: TVarSin; IP, Port: string);
317 function GetSinIP(Sin: TVarSin): string;
318 function GetSinPort(Sin: TVarSin): Integer;
319 procedure DoStatus(Reason: THookSocketReason; const Value: string);
320 procedure DoReadFilter(Buffer: TMemory; var Len: Integer);
321 procedure DoMonitor(Writing: Boolean; const Buffer: TMemory; Len: Integer);
322 procedure DoCreateSocket;
323 procedure DoHeartbeat;
324 procedure LimitBandwidth(Length: Integer; MaxB: integer; var Next: LongWord);
325 procedure SetBandwidth(Value: Integer);
326 function TestStopFlag: Boolean;
327 procedure InternalSendStream(const Stream: TStream; WithSize, Indy: boolean); virtual;
328 function InternalCanRead(Timeout: Integer): Boolean; virtual;
329 public
330 constructor Create;
331
332 {:Create object and load all necessary socket library. What library is
333 loaded is described by STUB parameter. If STUB is empty string, then is
334 loaded default libraries.}
335 constructor CreateAlternate(Stub: string);
336 destructor Destroy; override;
337
338 {:If @link(family) is not SF_Any, then create socket with type defined in
339 @link(Family) property. If family is SF_Any, then do nothing! (socket is
340 created automaticly when you know what type of socket you need to create.
341 (i.e. inside @link(Connect) or @link(Bind) call.) When socket is created,
342 then is aplyed all stored delayed socket options.}
343 procedure CreateSocket;
344
345 {:It create socket. Address resolving of Value tells what type of socket is
346 created. If Value is resolved as IPv4 IP, then is created IPv4 socket. If
347 value is resolved as IPv6 address, then is created IPv6 socket.}
348 procedure CreateSocketByName(const Value: String);
349
350 {:Destroy socket in use. This method is also automatically called from
351 object destructor.}
352 procedure CloseSocket; virtual;
353
354 {:Abort any work on Socket and destroy them.}
355 procedure AbortSocket; virtual;
356
357 {:Connects socket to local IP address and PORT. IP address may be numeric or
358 symbolic ('192.168.74.50', 'cosi.nekde.cz', 'ff08::1'). The same for PORT
359 - it may be number or mnemonic port ('23', 'telnet').
360
361 If port value is '0', system chooses itself and conects unused port in the
362 range 1024 to 4096 (this depending by operating system!). Structure
363 LocalSin is filled after calling this method.
364
365 Note: If you call this on non-created socket, then socket is created
366 automaticly.
367
368 Warning: when you call : Bind('0.0.0.0','0'); then is nothing done! In this
369 case is used implicit system bind instead.}
370 procedure Bind(IP, Port: string);
371
372 {:Connects socket to remote IP address and PORT. The same rules as with
373 @link(BIND) method are valid. The only exception is that PORT with 0 value
374 will not be connected!
375
376 Structures LocalSin and RemoteSin will be filled with valid values.
377
378 When you call this on non-created socket, then socket is created
379 automaticly. Type of created socket is by @link(Family) property. If is
380 used SF_IP4, then is created socket for IPv4. If is used SF_IP6, then is
381 created socket for IPv6. When you have family on SF_Any (default!), then
382 type of created socket is determined by address resolving of destination
383 address. (Not work properly on prilimitary winsock IPv6 support!)}
384 procedure Connect(IP, Port: string); virtual;
385
386 {:Sends data of LENGTH from BUFFER address via connected socket. System
387 automatically splits data to packets.}
388 function SendBuffer(Buffer: Tmemory; Length: Integer): Integer; virtual;
389
390 {:One data BYTE is sent via connected socket.}
391 procedure SendByte(Data: Byte); virtual;
392
393 {:Send data string via connected socket. Any terminator is not added! If you
394 need send true string with CR-LF termination, you must add CR-LF characters
395 to sended string! Because any termination is not added automaticly, you can
396 use this function for sending any binary data in binary string.}
397 procedure SendString(Data: AnsiString); virtual;
398
399 {:Send integer as four bytes to socket.}
400 procedure SendInteger(Data: integer); virtual;
401
402 {:Send data as one block to socket. Each block begin with 4 bytes with
403 length of data in block. This 4 bytes is added automaticly by this
404 function.}
405 procedure SendBlock(const Data: AnsiString); virtual;
406
407 {:Send data from stream to socket.}
408 procedure SendStreamRaw(const Stream: TStream); virtual;
409
410 {:Send content of stream to socket. It using @link(SendBlock) method}
411 procedure SendStream(const Stream: TStream); virtual;
412
413 {:Send content of stream to socket. It using @link(SendBlock) method and
414 this is compatible with streams in Indy library.}
415 procedure SendStreamIndy(const Stream: TStream); virtual;
416
417 {:Note: This is low-level receive function. You must be sure if data is
418 waiting for read before call this function for avoid deadlock!
419
420 Waits until allocated buffer is filled by received data. Returns number of
421 data received, which equals to LENGTH value under normal operation. If it
422 is not equal the communication channel is possibly broken.
423
424 On stream oriented sockets if is received 0 bytes, it mean 'socket is
425 closed!"
426
427 On datagram socket is readed first waiting datagram.}
428 function RecvBuffer(Buffer: TMemory; Length: Integer): Integer; virtual;
429
430 {:Note: This is high-level receive function. It using internal
431 @link(LineBuffer) and you can combine this function freely with other
432 high-level functions!
433
434 Method waits until data is received. If no data is received within TIMEOUT
435 (in milliseconds) period, @link(LastError) is set to WSAETIMEDOUT. Methods
436 serves for reading any size of data (i.e. one megabyte...). This method is
437 preffered for reading from stream sockets (like TCP).}
438 function RecvBufferEx(Buffer: Tmemory; Len: Integer;
439 Timeout: Integer): Integer; virtual;
440
441 {:Similar to @link(RecvBufferEx), but readed data is stored in binary
442 string, not in memory buffer.}
443 function RecvBufferStr(Len: Integer; Timeout: Integer): AnsiString; virtual;
444
445 {:Note: This is high-level receive function. It using internal
446 @link(LineBuffer) and you can combine this function freely with other
447 high-level functions.
448
449 Waits until one data byte is received which is also returned as function
450 result. If no data is received within TIMEOUT (in milliseconds)period,
451 @link(LastError) is set to WSAETIMEDOUT and result have value 0.}
452 function RecvByte(Timeout: Integer): Byte; virtual;
453
454 {:Note: This is high-level receive function. It using internal
455 @link(LineBuffer) and you can combine this function freely with other
456 high-level functions.
457
458 Waits until one four bytes are received and return it as one Ineger Value.
459 If no data is received within TIMEOUT (in milliseconds)period,
460 @link(LastError) is set to WSAETIMEDOUT and result have value 0.}
461 function RecvInteger(Timeout: Integer): Integer; virtual;
462
463 {:Note: This is high-level receive function. It using internal
464 @link(LineBuffer) and you can combine this function freely with other
465 high-level functions.
466
467 Method waits until data string is received. This string is terminated by
468 CR-LF characters. The resulting string is returned without this termination
469 (CR-LF)! If @link(ConvertLineEnd) is used, then CR-LF sequence may not be
470 exactly CR-LF. See @link(ConvertLineEnd) description. If no data is
471 received within TIMEOUT (in milliseconds) period, @link(LastError) is set
472 to WSAETIMEDOUT. You may also specify maximum length of reading data by
473 @link(MaxLineLength) property.}
474 function RecvString(Timeout: Integer): AnsiString; virtual;
475
476 {:Note: This is high-level receive function. It using internal
477 @link(LineBuffer) and you can combine this function freely with other
478 high-level functions.
479
480 Method waits until data string is received. This string is terminated by
481 Terminator string. The resulting string is returned without this
482 termination. If no data is received within TIMEOUT (in milliseconds)
483 period, @link(LastError) is set to WSAETIMEDOUT. You may also specify
484 maximum length of reading data by @link(MaxLineLength) property.}
485 function RecvTerminated(Timeout: Integer; const Terminator: AnsiString): AnsiString; virtual;
486
487 {:Note: This is high-level receive function. It using internal
488 @link(LineBuffer) and you can combine this function freely with other
489 high-level functions.
490
491 Method reads all data waiting for read. If no data is received within
492 TIMEOUT (in milliseconds) period, @link(LastError) is set to WSAETIMEDOUT.
493 Methods serves for reading unknown size of data. Because before call this
494 function you don't know size of received data, returned data is stored in
495 dynamic size binary string. This method is preffered for reading from
496 stream sockets (like TCP). It is very goot for receiving datagrams too!
497 (UDP protocol)}
498 function RecvPacket(Timeout: Integer): AnsiString; virtual;
499
500 {:Read one block of data from socket. Each block begin with 4 bytes with
501 length of data in block. This function read first 4 bytes for get lenght,
502 then it wait for reported count of bytes.}
503 function RecvBlock(Timeout: Integer): AnsiString; virtual;
504
505 {:Read all data from socket to stream until socket is closed (or any error
506 occured.)}
507 procedure RecvStreamRaw(const Stream: TStream; Timeout: Integer); virtual;
508 {:Read requested count of bytes from socket to stream.}
509 procedure RecvStreamSize(const Stream: TStream; Timeout: Integer; Size: Integer);
510
511 {:Receive data to stream. It using @link(RecvBlock) method.}
512 procedure RecvStream(const Stream: TStream; Timeout: Integer); virtual;
513
514 {:Receive data to stream. This function is compatible with similar function
515 in Indy library. It using @link(RecvBlock) method.}
516 procedure RecvStreamIndy(const Stream: TStream; Timeout: Integer); virtual;
517
518 {:Same as @link(RecvBuffer), but readed data stays in system input buffer.
519 Warning: this function not respect data in @link(LineBuffer)! Is not
520 recommended to use this function!}
521 function PeekBuffer(Buffer: TMemory; Length: Integer): Integer; virtual;
522
523 {:Same as @link(RecvByte), but readed data stays in input system buffer.
524 Warning: this function not respect data in @link(LineBuffer)! Is not
525 recommended to use this function!}
526 function PeekByte(Timeout: Integer): Byte; virtual;
527
528 {:On stream sockets it returns number of received bytes waiting for picking.
529 0 is returned when there is no such data. On datagram socket it returns
530 length of the first waiting datagram. Returns 0 if no datagram is waiting.}
531 function WaitingData: Integer; virtual;
532
533 {:Same as @link(WaitingData), but if exists some of data in @link(Linebuffer),
534 return their length instead.}
535 function WaitingDataEx: Integer;
536
537 {:Clear all waiting data for read from buffers.}
538 procedure Purge;
539
540 {:Sets linger. Enabled linger means that the system waits another LINGER
541 (in milliseconds) time for delivery of sent data. This function is only for
542 stream type of socket! (TCP)}
543 procedure SetLinger(Enable: Boolean; Linger: Integer);
544
545 {:Actualize values in @link(LocalSin).}
546 procedure GetSinLocal;
547
548 {:Actualize values in @link(RemoteSin).}
549 procedure GetSinRemote;
550
551 {:Actualize values in @link(LocalSin) and @link(RemoteSin).}
552 procedure GetSins;
553
554 {:Reset @link(LastError) and @link(LastErrorDesc) to non-error state.}
555 procedure ResetLastError;
556
557 {:If you "manually" call Socket API functions, forward their return code as
558 parameter to this function, which evaluates it, eventually calls
559 GetLastError and found error code returns and stores to @link(LastError).}
560 function SockCheck(SockResult: Integer): Integer; virtual;
561
562 {:If @link(LastError) contains some error code and @link(RaiseExcept)
563 property is @true, raise adequate exception.}
564 procedure ExceptCheck;
565
566 {:Returns local computer name as numerical or symbolic value. It try get
567 fully qualified domain name. Name is returned in the format acceptable by
568 functions demanding IP as input parameter.}
569 function LocalName: string;
570
571 {:Try resolve name to all possible IP address. i.e. If you pass as name
572 result of @link(LocalName) method, you get all IP addresses used by local
573 system.}
574 procedure ResolveNameToIP(Name: string; const IPList: TStrings);
575
576 {:Try resolve name to primary IP address. i.e. If you pass as name result of
577 @link(LocalName) method, you get primary IP addresses used by local system.}
578 function ResolveName(Name: string): string;
579
580 {:Try resolve IP to their primary domain name. If IP not have domain name,
581 then is returned original IP.}
582 function ResolveIPToName(IP: string): string;
583
584 {:Try resolve symbolic port name to port number. (i.e. 'Echo' to 8)}
585 function ResolvePort(Port: string): Word;
586
587 {:Set information about remote side socket. It is good for seting remote
588 side for sending UDP packet, etc.}
589 procedure SetRemoteSin(IP, Port: string);
590
591 {:Picks IP socket address from @link(LocalSin).}
592 function GetLocalSinIP: string; virtual;
593
594 {:Picks IP socket address from @link(RemoteSin).}
595 function GetRemoteSinIP: string; virtual;
596
597 {:Picks socket PORT number from @link(LocalSin).}
598 function GetLocalSinPort: Integer; virtual;
599
600 {:Picks socket PORT number from @link(RemoteSin).}
601 function GetRemoteSinPort: Integer; virtual;
602
603 {:Return @TRUE, if you can read any data from socket or is incoming
604 connection on TCP based socket. Status is tested for time Timeout (in
605 milliseconds). If value in Timeout is 0, status is only tested and
606 continue. If value in Timeout is -1, run is breaked and waiting for read
607 data maybe forever.
608
609 This function is need only on special cases, when you need use
610 @link(RecvBuffer) function directly! read functioms what have timeout as
611 calling parameter, calling this function internally.}
612 function CanRead(Timeout: Integer): Boolean; virtual;
613
614 {:Same as @link(CanRead), but additionally return @TRUE if is some data in
615 @link(LineBuffer).}
616 function CanReadEx(Timeout: Integer): Boolean; virtual;
617
618 {:Return @TRUE, if you can to socket write any data (not full sending
619 buffer). Status is tested for time Timeout (in milliseconds). If value in
620 Timeout is 0, status is only tested and continue. If value in Timeout is
621 -1, run is breaked and waiting for write data maybe forever.
622
623 This function is need only on special cases!}
624 function CanWrite(Timeout: Integer): Boolean; virtual;
625
626 {:Same as @link(SendBuffer), but send datagram to address from
627 @link(RemoteSin). Usefull for sending reply to datagram received by
628 function @link(RecvBufferFrom).}
629 function SendBufferTo(Buffer: TMemory; Length: Integer): Integer; virtual;
630
631 {:Note: This is low-lever receive function. You must be sure if data is
632 waiting for read before call this function for avoid deadlock!
633
634 Receives first waiting datagram to allocated buffer. If there is no waiting
635 one, then waits until one comes. Returns length of datagram stored in
636 BUFFER. If length exceeds buffer datagram is truncated. After this
637 @link(RemoteSin) structure contains information about sender of UDP packet.}
638 function RecvBufferFrom(Buffer: TMemory; Length: Integer): Integer; virtual;
639{$IFNDEF CIL}
640 {:This function is for check for incoming data on set of sockets. Whitch
641 sockets is checked is decribed by SocketList Tlist with TBlockSocket
642 objects. TList may have maximal number of objects defined by FD_SETSIZE
643 constant. Return @TRUE, if you can from some socket read any data or is
644 incoming connection on TCP based socket. Status is tested for time Timeout
645 (in milliseconds). If value in Timeout is 0, status is only tested and
646 continue. If value in Timeout is -1, run is breaked and waiting for read
647 data maybe forever. If is returned @TRUE, CanReadList TList is filled by all
648 TBlockSocket objects what waiting for read.}
649 function GroupCanRead(const SocketList: TList; Timeout: Integer;
650 const CanReadList: TList): Boolean;
651{$ENDIF}
652 {:By this method you may turn address reuse mode for local @link(bind). It
653 is good specially for UDP protocol. Using this with TCP protocol is
654 hazardous!}
655 procedure EnableReuse(Value: Boolean);
656
657 {:Try set timeout for all sending and receiving operations, if socket
658 provider can do it. (It not supported by all socket providers!)}
659 procedure SetTimeout(Timeout: Integer);
660
661 {:Try set timeout for all sending operations, if socket provider can do it.
662 (It not supported by all socket providers!)}
663 procedure SetSendTimeout(Timeout: Integer);
664
665 {:Try set timeout for all receiving operations, if socket provider can do
666 it. (It not supported by all socket providers!)}
667 procedure SetRecvTimeout(Timeout: Integer);
668
669 {:Return value of socket type.}
670 function GetSocketType: integer; Virtual;
671
672 {:Return value of protocol type for socket creation.}
673 function GetSocketProtocol: integer; Virtual;
674
675 {:WSA structure with information about socket provider. On linux is this
676 structure simulated!}
677 property WSAData: TWSADATA read GetWsaData;
678
679 {:Structure describing local socket side.}
680 property LocalSin: TVarSin read FLocalSin write FLocalSin;
681
682 {:Structure describing remote socket side.}
683 property RemoteSin: TVarSin read FRemoteSin write FRemoteSin;
684
685 {:Socket handler. Suitable for "manual" calls to socket API or manual
686 connection of socket to a previously created socket (i.e by Accept method
687 on TCP socket)}
688 property Socket: TSocket read FSocket write SetSocket;
689
690 {:Last socket operation error code. Error codes are described in socket
691 documentation. Human readable error description is stored in
692 @link(LastErrorDesc) property.}
693 property LastError: Integer read FLastError;
694
695 {:Human readable error description of @link(LastError) code.}
696 property LastErrorDesc: string read FLastErrorDesc;
697
698 {:Buffer used by all high-level receiving functions. This buffer is used for
699 optimized reading of data from socket. In normal cases you not need access
700 to this buffer directly!}
701 property LineBuffer: AnsiString read FBuffer write FBuffer;
702
703 {:Size of Winsock receive buffer. If it is not supported by socket provider,
704 it return as size one kilobyte.}
705 property SizeRecvBuffer: Integer read GetSizeRecvBuffer write SetSizeRecvBuffer;
706
707 {:Size of Winsock send buffer. If it is not supported by socket provider, it
708 return as size one kilobyte.}
709 property SizeSendBuffer: Integer read GetSizeSendBuffer write SetSizeSendBuffer;
710
711 {:If @True, turn class to non-blocking mode. Not all functions are working
712 properly in this mode, you must know exactly what you are doing! However
713 when you have big experience with non-blocking programming, then you can
714 optimise your program by non-block mode!}
715 property NonBlockMode: Boolean read FNonBlockMode Write SetNonBlockMode;
716
717 {:Set Time-to-live value. (if system supporting it!)}
718 property TTL: Integer read GetTTL Write SetTTL;
719
720 {:If is @true, then class in in IPv6 mode.}
721 property IP6used: Boolean read FIP6used;
722
723 {:Return count of received bytes on this socket from begin of current
724 connection.}
725 property RecvCounter: Integer read FRecvCounter;
726
727 {:Return count of sended bytes on this socket from begin of current
728 connection.}
729 property SendCounter: Integer read FSendCounter;
730 published
731 {:Return descriptive string for given error code. This is class function.
732 You may call it without created object!}
733 class function GetErrorDesc(ErrorCode: Integer): string;
734
735 {:Return descriptive string for @link(LastError).}
736 function GetErrorDescEx: string; virtual;
737
738 {:this value is for free use.}
739 property Tag: Integer read FTag write FTag;
740
741 {:If @true, winsock errors raises exception. Otherwise is setted
742 @link(LastError) value only and you must check it from your program! Default
743 value is @false.}
744 property RaiseExcept: Boolean read FRaiseExcept write FRaiseExcept;
745
746 {:Define maximum length in bytes of @link(LineBuffer) for high-level
747 receiving functions. If this functions try to read more data then this
748 limit, error is returned! If value is 0 (default), no limitation is used.
749 This is very good protection for stupid attacks to your server by sending
750 lot of data without proper terminator... until all your memory is allocated
751 by LineBuffer!
752
753 Note: This maximum length is checked only in functions, what read unknown
754 number of bytes! (like @link(RecvString) or @link(RecvTerminated))}
755 property MaxLineLength: Integer read FMaxLineLength Write FMaxLineLength;
756
757 {:Define maximal bandwidth for all sending operations in bytes per second.
758 If value is 0 (default), bandwidth limitation is not used.}
759 property MaxSendBandwidth: Integer read FMaxSendBandwidth Write FMaxSendBandwidth;
760
761 {:Define maximal bandwidth for all receiving operations in bytes per second.
762 If value is 0 (default), bandwidth limitation is not used.}
763 property MaxRecvBandwidth: Integer read FMaxRecvBandwidth Write FMaxRecvBandwidth;
764
765 {:Define maximal bandwidth for all sending and receiving operations in bytes
766 per second. If value is 0 (default), bandwidth limitation is not used.}
767 property MaxBandwidth: Integer Write SetBandwidth;
768
769 {:Do a conversion of non-standard line terminators to CRLF. (Off by default)
770 If @True, then terminators like sigle CR, single LF or LFCR are converted
771 to CRLF internally. This have effect only in @link(RecvString) method!}
772 property ConvertLineEnd: Boolean read FConvertLineEnd Write FConvertLineEnd;
773
774 {:Specified Family of this socket. When you are using Windows preliminary
775 support for IPv6, then I recommend to set this property!}
776 property Family: TSocketFamily read FFamily Write SetFamily;
777
778 {:When resolving of domain name return both IPv4 and IPv6 addresses, then
779 specify if is used IPv4 (dafault - @true) or IPv6.}
780 property PreferIP4: Boolean read FPreferIP4 Write FPreferIP4;
781
782 {:By default (@true) is all timeouts used as timeout between two packets in
783 reading operations. If you set this to @false, then Timeouts is for overall
784 reading operation!}
785 property InterPacketTimeout: Boolean read FInterPacketTimeout Write FInterPacketTimeout;
786
787 {:All sended datas was splitted by this value.}
788 property SendMaxChunk: Integer read FSendMaxChunk Write FSendMaxChunk;
789
790 {:By setting this property to @true you can stop any communication. You can
791 use this property for soft abort of communication.}
792 property StopFlag: Boolean read FStopFlag Write FStopFlag;
793
794 {:Timeout for data sending by non-blocking socket mode.}
795 property NonblockSendTimeout: Integer read FNonblockSendTimeout Write FNonblockSendTimeout;
796
797 {:This event is called by various reasons. It is good for monitoring socket,
798 create gauges for data transfers, etc.}
799 property OnStatus: THookSocketStatus read FOnStatus write FOnStatus;
800
801 {:this event is good for some internal thinks about filtering readed datas.
802 It is used by telnet client by example.}
803 property OnReadFilter: THookDataFilter read FOnReadFilter write FOnReadFilter;
804
805 {:This event is called after real socket creation for setting special socket
806 options, because you not know when socket is created. (it is depended on
807 Ipv4, IPv6 or automatic mode)}
808 property OnCreateSocket: THookCreateSocket read FOnCreateSocket write FOnCreateSocket;
809
810 {:This event is good for monitoring content of readed or writed datas.}
811 property OnMonitor: THookMonitor read FOnMonitor write FOnMonitor;
812
813 {:This event is good for calling your code during long socket operations.
814 (Example, for refresing UI if class in not called within the thread.)
815 Rate of heartbeats can be modified by @link(HeartbeatRate) property.}
816 property OnHeartbeat: THookHeartbeat read FOnHeartbeat write FOnHeartbeat;
817
818 {:Specify typical rate of @link(OnHeartbeat) event and @link(StopFlag) testing.
819 Default value 0 disabling heartbeats! Value is in milliseconds.
820 Real rate can be higher or smaller then this value, because it depending
821 on real socket operations too!
822 Note: Each heartbeat slowing socket processing.}
823 property HeartbeatRate: integer read FHeartbeatRate Write FHeartbeatRate;
824 end;
825
826 {:@abstract(Support for SOCKS4 and SOCKS5 proxy)
827 Layer with definition all necessary properties and functions for
828 implementation SOCKS proxy client. Do not use this class directly.}
829 TSocksBlockSocket = class(TBlockSocket)
830 protected
831 FSocksIP: string;
832 FSocksPort: string;
833 FSocksTimeout: integer;
834 FSocksUsername: string;
835 FSocksPassword: string;
836 FUsingSocks: Boolean;
837 FSocksResolver: Boolean;
838 FSocksLastError: integer;
839 FSocksResponseIP: string;
840 FSocksResponsePort: string;
841 FSocksLocalIP: string;
842 FSocksLocalPort: string;
843 FSocksRemoteIP: string;
844 FSocksRemotePort: string;
845 FBypassFlag: Boolean;
846 FSocksType: TSocksType;
847 function SocksCode(IP, Port: string): Ansistring;
848 function SocksDecode(Value: Ansistring): integer;
849 public
850 constructor Create;
851
852 {:Open connection to SOCKS proxy and if @link(SocksUsername) is set, do
853 authorisation to proxy. This is needed only in special cases! (it is called
854 internally!)}
855 function SocksOpen: Boolean;
856
857 {:Send specified request to SOCKS proxy. This is needed only in special
858 cases! (it is called internally!)}
859 function SocksRequest(Cmd: Byte; const IP, Port: string): Boolean;
860
861 {:Receive response to previosly sended request. This is needed only in
862 special cases! (it is called internally!)}
863 function SocksResponse: Boolean;
864
865 {:Is @True when class is using SOCKS proxy.}
866 property UsingSocks: Boolean read FUsingSocks;
867
868 {:If SOCKS proxy failed, here is error code returned from SOCKS proxy.}
869 property SocksLastError: integer read FSocksLastError;
870 published
871 {:Address of SOCKS server. If value is empty string, SOCKS support is
872 disabled. Assingning any value to this property enable SOCKS mode.
873 Warning: You cannot combine this mode with HTTP-tunneling mode!}
874 property SocksIP: string read FSocksIP write FSocksIP;
875
876 {:Port of SOCKS server. Default value is '1080'.}
877 property SocksPort: string read FSocksPort write FSocksPort;
878
879 {:If you need authorisation on SOCKS server, set username here.}
880 property SocksUsername: string read FSocksUsername write FSocksUsername;
881
882 {:If you need authorisation on SOCKS server, set password here.}
883 property SocksPassword: string read FSocksPassword write FSocksPassword;
884
885 {:Specify timeout for communicatin with SOCKS server. Default is one minute.}
886 property SocksTimeout: integer read FSocksTimeout write FSocksTimeout;
887
888 {:If @True, all symbolic names of target hosts is not translated to IP's
889 locally, but resolving is by SOCKS proxy. Default is @True.}
890 property SocksResolver: Boolean read FSocksResolver write FSocksResolver;
891
892 {:Specify SOCKS type. By default is used SOCKS5, but you can use SOCKS4 too.
893 When you select SOCKS4, then if @link(SOCKSResolver) is enabled, then is
894 used SOCKS4a. Othervise is used pure SOCKS4.}
895 property SocksType: TSocksType read FSocksType write FSocksType;
896 end;
897
898 {:@abstract(Implementation of TCP socket.)
899 Supported features: IPv4, IPv6, SSL/TLS or SSH (depending on used plugin),
900 SOCKS5 proxy (outgoing connections and limited incomming), SOCKS4/4a proxy
901 (outgoing connections and limited incomming), TCP through HTTP proxy tunnel.}
902 TTCPBlockSocket = class(TSocksBlockSocket)
903 protected
904 FOnAfterConnect: THookAfterConnect;
905 FSSL: TCustomSSL;
906 FHTTPTunnelIP: string;
907 FHTTPTunnelPort: string;
908 FHTTPTunnel: Boolean;
909 FHTTPTunnelRemoteIP: string;
910 FHTTPTunnelRemotePort: string;
911 FHTTPTunnelUser: string;
912 FHTTPTunnelPass: string;
913 FHTTPTunnelTimeout: integer;
914 procedure SocksDoConnect(IP, Port: string);
915 procedure HTTPTunnelDoConnect(IP, Port: string);
916 procedure DoAfterConnect;
917 public
918 {:Create TCP socket class with default plugin for SSL/TSL/SSH implementation
919 (see @link(SSLImplementation))}
920 constructor Create;
921
922 {:Create TCP socket class with desired plugin for SSL/TSL/SSH implementation}
923 constructor CreateWithSSL(SSLPlugin: TSSLClass);
924 destructor Destroy; override;
925
926 {:Return descriptive string for @link(LastError). On case of error
927 in SSL/TLS subsystem, it returns right error description.}
928 function GetErrorDescEx: string; override;
929
930 {:See @link(TBlockSocket.CloseSocket)}
931 procedure CloseSocket; override;
932
933 {:See @link(TBlockSocket.WaitingData)}
934 function WaitingData: Integer; override;
935
936 {:Sets socket to receive mode for new incoming connections. It is necessary
937 to use @link(TBlockSocket.BIND) function call before this method to select
938 receiving port!
939
940 If you use SOCKS, activate incoming TCP connection by this proxy. (By BIND
941 method of SOCKS.)}
942 procedure Listen; virtual;
943
944 {:Waits until new incoming connection comes. After it comes a new socket is
945 automatically created (socket handler is returned by this function as
946 result).
947
948 If you use SOCKS, new socket is not created! In this case is used same
949 socket as socket for listening! So, you can accept only one connection in
950 SOCKS mode.}
951 function Accept: TSocket;
952
953 {:Connects socket to remote IP address and PORT. The same rules as with
954 @link(TBlockSocket.BIND) method are valid. The only exception is that PORT
955 with 0 value will not be connected. After call to this method
956 a communication channel between local and remote socket is created. Local
957 socket is assigned automatically if not controlled by previous call to
958 @link(TBlockSocket.BIND) method. Structures @link(TBlockSocket.LocalSin)
959 and @link(TBlockSocket.RemoteSin) will be filled with valid values.
960
961 If you use SOCKS, activate outgoing TCP connection by SOCKS proxy specified
962 in @link(TSocksBlockSocket.SocksIP). (By CONNECT method of SOCKS.)
963
964 If you use HTTP-tunnel mode, activate outgoing TCP connection by HTTP
965 tunnel specified in @link(HTTPTunnelIP). (By CONNECT method of HTTP
966 protocol.)
967
968 Note: If you call this on non-created socket, then socket is created
969 automaticly.}
970 procedure Connect(IP, Port: string); override;
971
972 {:If you need upgrade existing TCP connection to SSL/TLS (or SSH2, if plugin
973 allows it) mode, then call this method. This method switch this class to
974 SSL mode and do SSL/TSL handshake.}
975 procedure SSLDoConnect;
976
977 {:By this method you can downgrade existing SSL/TLS connection to normal TCP
978 connection.}
979 procedure SSLDoShutdown;
980
981 {:If you need use this component as SSL/TLS TCP server, then after accepting
982 of inbound connection you need start SSL/TLS session by this method. Before
983 call this function, you must have assigned all neeeded certificates and
984 keys!}
985 function SSLAcceptConnection: Boolean;
986
987 {:See @link(TBlockSocket.GetLocalSinIP)}
988 function GetLocalSinIP: string; override;
989
990 {:See @link(TBlockSocket.GetRemoteSinIP)}
991 function GetRemoteSinIP: string; override;
992
993 {:See @link(TBlockSocket.GetLocalSinPort)}
994 function GetLocalSinPort: Integer; override;
995
996 {:See @link(TBlockSocket.GetRemoteSinPort)}
997 function GetRemoteSinPort: Integer; override;
998
999 {:See @link(TBlockSocket.SendBuffer)}
1000 function SendBuffer(Buffer: TMemory; Length: Integer): Integer; override;
1001
1002 {:See @link(TBlockSocket.RecvBuffer)}
1003 function RecvBuffer(Buffer: TMemory; Len: Integer): Integer; override;
1004
1005 {:Return value of socket type. For TCP return SOCK_STREAM.}
1006 function GetSocketType: integer; override;
1007
1008 {:Return value of protocol type for socket creation. For TCP return
1009 IPPROTO_TCP.}
1010 function GetSocketProtocol: integer; override;
1011
1012 {:Class implementing SSL/TLS support. It is allways some descendant
1013 of @link(TCustomSSL) class. When programmer not select some SSL plugin
1014 class, then is used @link(TSSLNone)}
1015 property SSL: TCustomSSL read FSSL;
1016
1017 {:@True if is used HTTP tunnel mode.}
1018 property HTTPTunnel: Boolean read FHTTPTunnel;
1019 published
1020 {:Specify IP address of HTTP proxy. Assingning non-empty value to this
1021 property enable HTTP-tunnel mode. This mode is for tunnelling any outgoing
1022 TCP connection through HTTP proxy server. (If policy on HTTP proxy server
1023 allow this!) Warning: You cannot combine this mode with SOCK5 mode!}
1024 property HTTPTunnelIP: string read FHTTPTunnelIP Write FHTTPTunnelIP;
1025
1026 {:Specify port of HTTP proxy for HTTP-tunneling.}
1027 property HTTPTunnelPort: string read FHTTPTunnelPort Write FHTTPTunnelPort;
1028
1029 {:Specify authorisation username for access to HTTP proxy in HTTP-tunnel
1030 mode. If you not need authorisation, then let this property empty.}
1031 property HTTPTunnelUser: string read FHTTPTunnelUser Write FHTTPTunnelUser;
1032
1033 {:Specify authorisation password for access to HTTP proxy in HTTP-tunnel
1034 mode.}
1035 property HTTPTunnelPass: string read FHTTPTunnelPass Write FHTTPTunnelPass;
1036
1037 {:Specify timeout for communication with HTTP proxy in HTTPtunnel mode.}
1038 property HTTPTunnelTimeout: integer read FHTTPTunnelTimeout Write FHTTPTunnelTimeout;
1039
1040 {:This event is called after sucessful TCP socket connection.}
1041 property OnAfterConnect: THookAfterConnect read FOnAfterConnect write FOnAfterConnect;
1042 end;
1043
1044 {:@abstract(Datagram based communication)
1045 This class implementing datagram based communication instead default stream
1046 based communication style.}
1047 TDgramBlockSocket = class(TSocksBlockSocket)
1048 public
1049 {:Fill @link(TBlockSocket.RemoteSin) structure. This address is used for
1050 sending data.}
1051 procedure Connect(IP, Port: string); override;
1052
1053 {:Silently redirected to @link(TBlockSocket.SendBufferTo).}
1054 function SendBuffer(Buffer: TMemory; Length: Integer): Integer; override;
1055
1056 {:Silently redirected to @link(TBlockSocket.RecvBufferFrom).}
1057 function RecvBuffer(Buffer: TMemory; Length: Integer): Integer; override;
1058 end;
1059
1060 {:@abstract(Implementation of UDP socket.)
1061 NOTE: in this class is all receiving redirected to RecvBufferFrom. You can
1062 use for reading any receive function. Preffered is RecvPacket! Similary all
1063 sending is redirected to SendbufferTo. You can use for sending UDP packet any
1064 sending function, like SendString.
1065
1066 Supported features: IPv4, IPv6, unicasts, broadcasts, multicasts, SOCKS5
1067 proxy (only unicasts! Outgoing and incomming.)}
1068 TUDPBlockSocket = class(TDgramBlockSocket)
1069 protected
1070 FSocksControlSock: TTCPBlockSocket;
1071 function UdpAssociation: Boolean;
1072 procedure SetMulticastTTL(TTL: integer);
1073 function GetMulticastTTL:integer;
1074 public
1075 destructor Destroy; override;
1076
1077 {:Enable or disable sending of broadcasts. If seting OK, result is @true.
1078 This method is not supported in SOCKS5 mode! IPv6 does not support
1079 broadcasts! In this case you must use Multicasts instead.}
1080 procedure EnableBroadcast(Value: Boolean);
1081
1082 {:See @link(TBlockSocket.SendBufferTo)}
1083 function SendBufferTo(Buffer: TMemory; Length: Integer): Integer; override;
1084
1085 {:See @link(TBlockSocket.RecvBufferFrom)}
1086 function RecvBufferFrom(Buffer: TMemory; Length: Integer): Integer; override;
1087{$IFNDEF CIL}
1088 {:Add this socket to given multicast group. You cannot use Multicasts in
1089 SOCKS mode!}
1090 procedure AddMulticast(MCastIP:string);
1091
1092 {:Remove this socket from given multicast group.}
1093 procedure DropMulticast(MCastIP:string);
1094{$ENDIF}
1095 {:All sended multicast datagrams is loopbacked to your interface too. (you
1096 can read your sended datas.) You can disable this feature by this function.
1097 This function not working on some Windows systems!}
1098 procedure EnableMulticastLoop(Value: Boolean);
1099
1100 {:Return value of socket type. For UDP return SOCK_DGRAM.}
1101 function GetSocketType: integer; override;
1102
1103 {:Return value of protocol type for socket creation. For UDP return
1104 IPPROTO_UDP.}
1105 function GetSocketProtocol: integer; override;
1106
1107 {:Set Time-to-live value for multicasts packets. It define number of routers
1108 for transfer of datas. If you set this to 1 (dafault system value), then
1109 multicasts packet goes only to you local network. If you need transport
1110 multicast packet to worldwide, then increase this value, but be carefull,
1111 lot of routers on internet does not transport multicasts packets!}
1112 property MulticastTTL: Integer read GetMulticastTTL Write SetMulticastTTL;
1113 end;
1114
1115 {:@abstract(Implementation of RAW ICMP socket.)
1116 For this object you must have rights for creating RAW sockets!}
1117 TICMPBlockSocket = class(TDgramBlockSocket)
1118 public
1119 {:Return value of socket type. For RAW and ICMP return SOCK_RAW.}
1120 function GetSocketType: integer; override;
1121
1122 {:Return value of protocol type for socket creation. For ICMP returns
1123 IPPROTO_ICMP or IPPROTO_ICMPV6}
1124 function GetSocketProtocol: integer; override;
1125 end;
1126
1127 {:@abstract(Implementation of RAW socket.)
1128 For this object you must have rights for creating RAW sockets!}
1129 TRAWBlockSocket = class(TBlockSocket)
1130 public
1131 {:Return value of socket type. For RAW and ICMP return SOCK_RAW.}
1132 function GetSocketType: integer; override;
1133
1134 {:Return value of protocol type for socket creation. For RAW returns
1135 IPPROTO_RAW.}
1136 function GetSocketProtocol: integer; override;
1137 end;
1138
1139 {:@abstract(Parent class for all SSL plugins.)
1140 This is abstract class defining interface for other SSL plugins.
1141
1142 Instance of this class will be created for each @link(TTCPBlockSocket).
1143
1144 Warning: not all methods and propertis can work in all existing SSL plugins!
1145 Please, read documentation of used SSL plugin.}
1146 TCustomSSL = class(TObject)
1147 protected
1148 FSocket: TTCPBlockSocket;
1149 FSSLEnabled: Boolean;
1150 FLastError: integer;
1151 FLastErrorDesc: string;
1152 FSSLType: TSSLType;
1153 FKeyPassword: string;
1154 FCiphers: string;
1155 FCertificateFile: string;
1156 FPrivateKeyFile: string;
1157 FCertificate: Ansistring;
1158 FPrivateKey: Ansistring;
1159 FPFX: Ansistring;
1160 FPFXfile: string;
1161 FCertCA: Ansistring;
1162 FCertCAFile: string;
1163 FTrustCertificate: Ansistring;
1164 FTrustCertificateFile: string;
1165 FVerifyCert: Boolean;
1166 FUsername: string;
1167 FPassword: string;
1168 FSSHChannelType: string;
1169 FSSHChannelArg1: string;
1170 FSSHChannelArg2: string;
1171 procedure ReturnError;
1172 function CreateSelfSignedCert(Host: string): Boolean; virtual;
1173 public
1174 {: Create plugin class. it is called internally from @link(TTCPBlockSocket)}
1175 constructor Create(const Value: TTCPBlockSocket); virtual;
1176
1177 {: Assign settings (certificates and configuration) from another SSL plugin
1178 class.}
1179 procedure Assign(const Value: TCustomSSL); virtual;
1180
1181 {: return description of used plugin. It usually return name and version
1182 of used SSL library.}
1183 function LibVersion: String; virtual;
1184
1185 {: return name of used plugin.}
1186 function LibName: String; virtual;
1187
1188 {: Do not call this directly. It is used internally by @link(TTCPBlockSocket)!
1189
1190 Here is needed code for start SSL connection.}
1191 function Connect: boolean; virtual;
1192
1193 {: Do not call this directly. It is used internally by @link(TTCPBlockSocket)!
1194
1195 Here is needed code for acept new SSL connection.}
1196 function Accept: boolean; virtual;
1197
1198 {: Do not call this directly. It is used internally by @link(TTCPBlockSocket)!
1199
1200 Here is needed code for hard shutdown of SSL connection. (for example,
1201 before socket is closed)}
1202 function Shutdown: boolean; virtual;
1203
1204 {: Do not call this directly. It is used internally by @link(TTCPBlockSocket)!
1205
1206 Here is needed code for soft shutdown of SSL connection. (for example,
1207 when you need to continue with unprotected connection.)}
1208 function BiShutdown: boolean; virtual;
1209
1210 {: Do not call this directly. It is used internally by @link(TTCPBlockSocket)!
1211
1212 Here is needed code for sending some datas by SSL connection.}
1213 function SendBuffer(Buffer: TMemory; Len: Integer): Integer; virtual;
1214
1215 {: Do not call this directly. It is used internally by @link(TTCPBlockSocket)!
1216
1217 Here is needed code for receiving some datas by SSL connection.}
1218 function RecvBuffer(Buffer: TMemory; Len: Integer): Integer; virtual;
1219
1220 {: Do not call this directly. It is used internally by @link(TTCPBlockSocket)!
1221
1222 Here is needed code for getting count of datas what waiting for read.
1223 If SSL plugin not allows this, then it should return 0.}
1224 function WaitingData: Integer; virtual;
1225
1226 {:Return string with identificator of SSL/TLS version of existing
1227 connection.}
1228 function GetSSLVersion: string; virtual;
1229
1230 {:Return subject of remote SSL peer.}
1231 function GetPeerSubject: string; virtual;
1232
1233 {:Return issuer certificate of remote SSL peer.}
1234 function GetPeerIssuer: string; virtual;
1235
1236 {:Return peer name from remote side certificate. This is good for verify,
1237 if certificate is generated for remote side IP name.}
1238 function GetPeerName: string; virtual;
1239
1240 {:Return fingerprint of remote SSL peer.}
1241 function GetPeerFingerprint: string; virtual;
1242
1243 {:Return all detailed information about certificate from remote side of
1244 SSL/TLS connection. Result string can be multilined! Each plugin can return
1245 this informations in different format!}
1246 function GetCertInfo: string; virtual;
1247
1248 {:Return currently used Cipher.}
1249 function GetCipherName: string; virtual;
1250
1251 {:Return currently used number of bits in current Cipher algorythm.}
1252 function GetCipherBits: integer; virtual;
1253
1254 {:Return number of bits in current Cipher algorythm.}
1255 function GetCipherAlgBits: integer; virtual;
1256
1257 {:Return result value of verify remote side certificate. Look to OpenSSL
1258 documentation for possible values. For example 0 is successfuly verified
1259 certificate, or 18 is self-signed certificate.}
1260 function GetVerifyCert: integer; virtual;
1261
1262 {: Resurn @true if SSL mode is enabled on existing cvonnection.}
1263 property SSLEnabled: Boolean read FSSLEnabled;
1264
1265 {:Return error code of last SSL operation. 0 is OK.}
1266 property LastError: integer read FLastError;
1267
1268 {:Return error description of last SSL operation.}
1269 property LastErrorDesc: string read FLastErrorDesc;
1270 published
1271 {:Here you can specify requested SSL/TLS mode. Default is autodetection, but
1272 on some servers autodetection not working properly. In this case you must
1273 specify requested SSL/TLS mode by your hand!}
1274 property SSLType: TSSLType read FSSLType write FSSLType;
1275
1276 {:Password for decrypting of encoded certificate or key.}
1277 property KeyPassword: string read FKeyPassword write FKeyPassword;
1278
1279 {:Username for possible credentials.}
1280 property Username: string read FUsername write FUsername;
1281
1282 {:password for possible credentials.}
1283 property Password: string read FPassword write FPassword;
1284
1285 {:By this property you can modify default set of SSL/TLS ciphers.}
1286 property Ciphers: string read FCiphers write FCiphers;
1287
1288 {:Used for loading certificate from disk file. See to plugin documentation
1289 if this method is supported and how!}
1290 property CertificateFile: string read FCertificateFile write FCertificateFile;
1291
1292 {:Used for loading private key from disk file. See to plugin documentation
1293 if this method is supported and how!}
1294 property PrivateKeyFile: string read FPrivateKeyFile write FPrivateKeyFile;
1295
1296 {:Used for loading certificate from binary string. See to plugin documentation
1297 if this method is supported and how!}
1298 property Certificate: Ansistring read FCertificate write FCertificate;
1299
1300 {:Used for loading private key from binary string. See to plugin documentation
1301 if this method is supported and how!}
1302 property PrivateKey: Ansistring read FPrivateKey write FPrivateKey;
1303
1304 {:Used for loading PFX from binary string. See to plugin documentation
1305 if this method is supported and how!}
1306 property PFX: Ansistring read FPFX write FPFX;
1307
1308 {:Used for loading PFX from disk file. See to plugin documentation
1309 if this method is supported and how!}
1310 property PFXfile: string read FPFXfile write FPFXfile;
1311
1312 {:Used for loading trusted certificates from disk file. See to plugin documentation
1313 if this method is supported and how!}
1314 property TrustCertificateFile: string read FTrustCertificateFile write FTrustCertificateFile;
1315
1316 {:Used for loading trusted certificates from binary string. See to plugin documentation
1317 if this method is supported and how!}
1318 property TrustCertificate: Ansistring read FTrustCertificate write FTrustCertificate;
1319
1320 {:Used for loading CA certificates from binary string. See to plugin documentation
1321 if this method is supported and how!}
1322 property CertCA: Ansistring read FCertCA write FCertCA;
1323
1324 {:Used for loading CA certificates from disk file. See to plugin documentation
1325 if this method is supported and how!}
1326 property CertCAFile: string read FCertCAFile write FCertCAFile;
1327
1328 {:If @true, then is verified client certificate. (it is good for writing
1329 SSL/TLS servers.) When you are not server, but you are client, then if this
1330 property is @true, verify servers certificate.}
1331 property VerifyCert: Boolean read FVerifyCert write FVerifyCert;
1332
1333 {:channel type for possible SSH connections}
1334 property SSHChannelType: string read FSSHChannelType write FSSHChannelType;
1335
1336 {:First argument of channel type for possible SSH connections}
1337 property SSHChannelArg1: string read FSSHChannelArg1 write FSSHChannelArg1;
1338
1339 {:Second argument of channel type for possible SSH connections}
1340 property SSHChannelArg2: string read FSSHChannelArg2 write FSSHChannelArg2;
1341 end;
1342
1343 {:@abstract(Default SSL plugin with no SSL support.)
1344 Dummy SSL plugin implementation for applications without SSL/TLS support.}
1345 TSSLNone = class (TCustomSSL)
1346 public
1347 {:See @inherited}
1348 function LibVersion: String; override;
1349 {:See @inherited}
1350 function LibName: String; override;
1351 end;
1352
1353 {:@abstract(Record with definition of IP packet header.)
1354 For reading data from ICMP or RAW sockets.}
1355 TIPHeader = record
1356 VerLen: Byte;
1357 TOS: Byte;
1358 TotalLen: Word;
1359 Identifer: Word;
1360 FragOffsets: Word;
1361 TTL: Byte;
1362 Protocol: Byte;
1363 CheckSum: Word;
1364 SourceIp: LongWord;
1365 DestIp: LongWord;
1366 Options: LongWord;
1367 end;
1368
1369 {:@abstract(Parent class of application protocol implementations.)
1370 By this class is defined common properties.}
1371 TSynaClient = Class(TObject)
1372 protected
1373 FTargetHost: string;
1374 FTargetPort: string;
1375 FIPInterface: string;
1376 FTimeout: integer;
1377 FUserName: string;
1378 FPassword: string;
1379 public
1380 constructor Create;
1381 published
1382 {:Specify terget server IP (or symbolic name). Default is 'localhost'.}
1383 property TargetHost: string read FTargetHost Write FTargetHost;
1384
1385 {:Specify terget server port (or symbolic name).}
1386 property TargetPort: string read FTargetPort Write FTargetPort;
1387
1388 {:Defined local socket address. (outgoing IP address). By default is used
1389 '0.0.0.0' as wildcard for default IP.}
1390 property IPInterface: string read FIPInterface Write FIPInterface;
1391
1392 {:Specify default timeout for socket operations.}
1393 property Timeout: integer read FTimeout Write FTimeout;
1394
1395 {:If protocol need user authorization, then fill here username.}
1396 property UserName: string read FUserName Write FUserName;
1397
1398 {:If protocol need user authorization, then fill here password.}
1399 property Password: string read FPassword Write FPassword;
1400 end;
1401
1402var
1403 {:Selected SSL plugin. Default is @link(TSSLNone).
1404
1405 Do not change this value directly!!!
1406
1407 Just add your plugin unit to your project uses instead. Each plugin unit have
1408 initialization code what modify this variable.}
1409 SSLImplementation: TSSLClass = TSSLNone;
1410
1411implementation
1412
1413{$IFDEF ONCEWINSOCK}
1414var
1415 WsaDataOnce: TWSADATA;
1416 e: ESynapseError;
1417{$ENDIF}
1418
1419
1420constructor TBlockSocket.Create;
1421begin
1422 CreateAlternate('');
1423end;
1424
1425constructor TBlockSocket.CreateAlternate(Stub: string);
1426{$IFNDEF ONCEWINSOCK}
1427var
1428 e: ESynapseError;
1429{$ENDIF}
1430begin
1431 inherited Create;
1432 FDelayedOptions := TList.Create;
1433 FRaiseExcept := False;
1434{$IFDEF RAISEEXCEPT}
1435 FRaiseExcept := True;
1436{$ENDIF}
1437 FSocket := INVALID_SOCKET;
1438 FBuffer := '';
1439 FLastCR := False;
1440 FLastLF := False;
1441 FBinded := False;
1442 FNonBlockMode := False;
1443 FMaxLineLength := 0;
1444 FMaxSendBandwidth := 0;
1445 FNextSend := 0;
1446 FMaxRecvBandwidth := 0;
1447 FNextRecv := 0;
1448 FConvertLineEnd := False;
1449 FFamily := SF_Any;
1450 FFamilySave := SF_Any;
1451 FIP6used := False;
1452 FPreferIP4 := True;
1453 FInterPacketTimeout := True;
1454 FRecvCounter := 0;
1455 FSendCounter := 0;
1456 FSendMaxChunk := c64k;
1457 FStopFlag := False;
1458 FNonblockSendTimeout := 15000;
1459 FHeartbeatRate := 0;
1460{$IFNDEF ONCEWINSOCK}
1461 if Stub = '' then
1462 Stub := DLLStackName;
1463 if not InitSocketInterface(Stub) then
1464 begin
1465 e := ESynapseError.Create('Error loading Socket interface (' + Stub + ')!');
1466 e.ErrorCode := 0;
1467 e.ErrorMessage := 'Error loading Socket interface (' + Stub + ')!';
1468 raise e;
1469 end;
1470 SockCheck(synsock.WSAStartup(WinsockLevel, FWsaDataOnce));
1471 ExceptCheck;
1472{$ENDIF}
1473end;
1474
1475destructor TBlockSocket.Destroy;
1476var
1477 n: integer;
1478 p: TSynaOption;
1479begin
1480 CloseSocket;
1481{$IFNDEF ONCEWINSOCK}
1482 synsock.WSACleanup;
1483 DestroySocketInterface;
1484{$ENDIF}
1485 for n := FDelayedOptions.Count - 1 downto 0 do
1486 begin
1487 p := TSynaOption(FDelayedOptions[n]);
1488 p.Free;
1489 end;
1490 FDelayedOptions.Free;
1491 inherited Destroy;
1492end;
1493
1494function TBlockSocket.FamilyToAF(f: TSocketFamily): TAddrFamily;
1495begin
1496 case f of
1497 SF_ip4:
1498 Result := AF_INET;
1499 SF_ip6:
1500 Result := AF_INET6;
1501 else
1502 Result := AF_UNSPEC;
1503 end;
1504end;
1505
1506procedure TBlockSocket.SetDelayedOption(const Value: TSynaOption);
1507var
1508 li: TLinger;
1509 x: integer;
1510 buf: TMemory;
1511{$IFNDEF WIN32}
1512 timeval: TTimeval;
1513{$ENDIF}
1514begin
1515 case value.Option of
1516 SOT_Linger:
1517 begin
1518 {$IFDEF CIL}
1519 li := TLinger.Create(Value.Enabled, Value.Value div 1000);
1520 synsock.SetSockOptObj(FSocket, integer(SOL_SOCKET), integer(SO_LINGER), li);
1521 {$ELSE}
1522 li.l_onoff := Ord(Value.Enabled);
1523 li.l_linger := Value.Value div 1000;
1524 buf := @li;
1525 synsock.SetSockOpt(FSocket, integer(SOL_SOCKET), integer(SO_LINGER), buf, SizeOf(li));
1526 {$ENDIF}
1527 end;
1528 SOT_RecvBuff:
1529 begin
1530 {$IFDEF CIL}
1531 buf := System.BitConverter.GetBytes(value.Value);
1532 {$ELSE}
1533 buf := @Value.Value;
1534 {$ENDIF}
1535 synsock.SetSockOpt(FSocket, integer(SOL_SOCKET), integer(SO_RCVBUF),
1536 buf, SizeOf(Value.Value));
1537 end;
1538 SOT_SendBuff:
1539 begin
1540 {$IFDEF CIL}
1541 buf := System.BitConverter.GetBytes(value.Value);
1542 {$ELSE}
1543 buf := @Value.Value;
1544 {$ENDIF}
1545 synsock.SetSockOpt(FSocket, integer(SOL_SOCKET), integer(SO_SNDBUF),
1546 buf, SizeOf(Value.Value));
1547 end;
1548 SOT_NonBlock:
1549 begin
1550 FNonBlockMode := Value.Enabled;
1551 x := Ord(FNonBlockMode);
1552 synsock.IoctlSocket(FSocket, FIONBIO, x);
1553 end;
1554 SOT_RecvTimeout:
1555 begin
1556 {$IFDEF CIL}
1557 buf := System.BitConverter.GetBytes(value.Value);
1558 synsock.SetSockOpt(FSocket, integer(SOL_SOCKET), integer(SO_RCVTIMEO),
1559 buf, SizeOf(Value.Value));
1560 {$ELSE}
1561 {$IFDEF WIN32}
1562 buf := @Value.Value;
1563 synsock.SetSockOpt(FSocket, integer(SOL_SOCKET), integer(SO_RCVTIMEO),
1564 buf, SizeOf(Value.Value));
1565 {$ELSE}
1566 timeval.tv_sec:=Value.Value div 1000;
1567 timeval.tv_usec:=(Value.Value mod 1000) * 1000;
1568 synsock.SetSockOpt(FSocket, integer(SOL_SOCKET), integer(SO_RCVTIMEO),
1569 @timeval, SizeOf(timeval));
1570 {$ENDIF}
1571 {$ENDIF}
1572 end;
1573 SOT_SendTimeout:
1574 begin
1575 {$IFDEF CIL}
1576 buf := System.BitConverter.GetBytes(value.Value);
1577 {$ELSE}
1578 {$IFDEF WIN32}
1579 buf := @Value.Value;
1580 synsock.SetSockOpt(FSocket, integer(SOL_SOCKET), integer(SO_SNDTIMEO),
1581 buf, SizeOf(Value.Value));
1582 {$ELSE}
1583 timeval.tv_sec:=Value.Value div 1000;
1584 timeval.tv_usec:=(Value.Value mod 1000) * 1000;
1585 synsock.SetSockOpt(FSocket, integer(SOL_SOCKET), integer(SO_SNDTIMEO),
1586 @timeval, SizeOf(timeval));
1587 {$ENDIF}
1588 {$ENDIF}
1589 end;
1590 SOT_Reuse:
1591 begin
1592 x := Ord(Value.Enabled);
1593 {$IFDEF CIL}
1594 buf := System.BitConverter.GetBytes(x);
1595 {$ELSE}
1596 buf := @x;
1597 {$ENDIF}
1598 synsock.SetSockOpt(FSocket, integer(SOL_SOCKET), integer(SO_REUSEADDR), buf, SizeOf(x));
1599 end;
1600 SOT_TTL:
1601 begin
1602 {$IFDEF CIL}
1603 buf := System.BitConverter.GetBytes(value.Value);
1604 {$ELSE}
1605 buf := @Value.Value;
1606 {$ENDIF}
1607 if FIP6Used then
1608 synsock.SetSockOpt(FSocket, integer(IPPROTO_IPV6), integer(IPV6_UNICAST_HOPS),
1609 buf, SizeOf(Value.Value))
1610 else
1611 synsock.SetSockOpt(FSocket, integer(IPPROTO_IP), integer(IP_TTL),
1612 buf, SizeOf(Value.Value));
1613 end;
1614 SOT_Broadcast:
1615 begin
1616//#todo1 broadcasty na IP6
1617 x := Ord(Value.Enabled);
1618 {$IFDEF CIL}
1619 buf := System.BitConverter.GetBytes(x);
1620 {$ELSE}
1621 buf := @x;
1622 {$ENDIF}
1623 synsock.SetSockOpt(FSocket, integer(SOL_SOCKET), integer(SO_BROADCAST), buf, SizeOf(x));
1624 end;
1625 SOT_MulticastTTL:
1626 begin
1627 {$IFDEF CIL}
1628 buf := System.BitConverter.GetBytes(value.Value);
1629 {$ELSE}
1630 buf := @Value.Value;
1631 {$ENDIF}
1632 if FIP6Used then
1633 synsock.SetSockOpt(FSocket, integer(IPPROTO_IPV6), integer(IPV6_MULTICAST_HOPS),
1634 buf, SizeOf(Value.Value))
1635 else
1636 synsock.SetSockOpt(FSocket, integer(IPPROTO_IP), integer(IP_MULTICAST_TTL),
1637 buf, SizeOf(Value.Value));
1638 end;
1639 SOT_MulticastLoop:
1640 begin
1641 x := Ord(Value.Enabled);
1642 {$IFDEF CIL}
1643 buf := System.BitConverter.GetBytes(x);
1644 {$ELSE}
1645 buf := @x;
1646 {$ENDIF}
1647 if FIP6Used then
1648 synsock.SetSockOpt(FSocket, integer(IPPROTO_IPV6), integer(IPV6_MULTICAST_LOOP), buf, SizeOf(x))
1649 else
1650 synsock.SetSockOpt(FSocket, integer(IPPROTO_IP), integer(IP_MULTICAST_LOOP), buf, SizeOf(x));
1651 end;
1652 end;
1653 Value.free;
1654end;
1655
1656procedure TBlockSocket.DelayedOption(const Value: TSynaOption);
1657begin
1658 if FSocket = INVALID_SOCKET then
1659 begin
1660 FDelayedOptions.Insert(0, Value);
1661 end
1662 else
1663 SetDelayedOption(Value);
1664end;
1665
1666procedure TBlockSocket.ProcessDelayedOptions;
1667var
1668 n: integer;
1669 d: TSynaOption;
1670begin
1671 for n := FDelayedOptions.Count - 1 downto 0 do
1672 begin
1673 d := TSynaOption(FDelayedOptions[n]);
1674 SetDelayedOption(d);
1675 end;
1676 FDelayedOptions.Clear;
1677end;
1678
1679procedure TBlockSocket.SetSin(var Sin: TVarSin; IP, Port: string);
1680var
1681 f: TSocketFamily;
1682begin
1683 DoStatus(HR_ResolvingBegin, IP + ':' + Port);
1684 ResetLastError;
1685 //if socket exists, then use their type, else use users selection
1686 f := SF_Any;
1687 if (FSocket = INVALID_SOCKET) and (FFamily = SF_any) then
1688 begin
1689 if IsIP(IP) then
1690 f := SF_IP4
1691 else
1692 if IsIP6(IP) then
1693 f := SF_IP6;
1694 end
1695 else
1696 f := FFamily;
1697 FLastError := synsock.SetVarSin(sin, ip, port, FamilyToAF(f),
1698 GetSocketprotocol, GetSocketType, FPreferIP4);
1699 DoStatus(HR_ResolvingEnd, GetSinIP(sin) + ':' + IntTostr(GetSinPort(sin)));
1700end;
1701
1702function TBlockSocket.GetSinIP(Sin: TVarSin): string;
1703begin
1704 Result := synsock.GetSinIP(sin);
1705end;
1706
1707function TBlockSocket.GetSinPort(Sin: TVarSin): Integer;
1708begin
1709 Result := synsock.GetSinPort(sin);
1710end;
1711
1712procedure TBlockSocket.CreateSocket;
1713var
1714 sin: TVarSin;
1715begin
1716 //dummy for SF_Any Family mode
1717 ResetLastError;
1718 if (FFamily <> SF_Any) and (FSocket = INVALID_SOCKET) then
1719 begin
1720 {$IFDEF CIL}
1721 if FFamily = SF_IP6 then
1722 sin := TVarSin.Create(IPAddress.Parse('::0'), 0)
1723 else
1724 sin := TVarSin.Create(IPAddress.Parse('0.0.0.0'), 0);
1725 {$ELSE}
1726 FillChar(Sin, Sizeof(Sin), 0);
1727 if FFamily = SF_IP6 then
1728 sin.sin_family := AF_INET6
1729 else
1730 sin.sin_family := AF_INET;
1731 {$ENDIF}
1732 InternalCreateSocket(Sin);
1733 end;
1734end;
1735
1736procedure TBlockSocket.CreateSocketByName(const Value: String);
1737var
1738 sin: TVarSin;
1739begin
1740 ResetLastError;
1741 if FSocket = INVALID_SOCKET then
1742 begin
1743 SetSin(sin, value, '0');
1744 if FLastError = 0 then
1745 InternalCreateSocket(Sin);
1746 end;
1747end;
1748
1749procedure TBlockSocket.InternalCreateSocket(Sin: TVarSin);
1750begin
1751 FStopFlag := False;
1752 FRecvCounter := 0;
1753 FSendCounter := 0;
1754 ResetLastError;
1755 if FSocket = INVALID_SOCKET then
1756 begin
1757 FBuffer := '';
1758 FBinded := False;
1759 FIP6Used := Sin.AddressFamily = AF_INET6;
1760 FSocket := synsock.Socket(integer(Sin.AddressFamily), GetSocketType, GetSocketProtocol);
1761 if FSocket = INVALID_SOCKET then
1762 FLastError := synsock.WSAGetLastError;
1763 {$IFNDEF CIL}
1764 FD_ZERO(FFDSet);
1765 FD_SET(FSocket, FFDSet);
1766 {$ENDIF}
1767 ExceptCheck;
1768 if FIP6used then
1769 DoStatus(HR_SocketCreate, 'IPv6')
1770 else
1771 DoStatus(HR_SocketCreate, 'IPv4');
1772 ProcessDelayedOptions;
1773 DoCreateSocket;
1774 end;
1775end;
1776
1777procedure TBlockSocket.CloseSocket;
1778begin
1779 AbortSocket;
1780end;
1781
1782procedure TBlockSocket.AbortSocket;
1783var
1784 n: integer;
1785 p: TSynaOption;
1786begin
1787 if FSocket <> INVALID_SOCKET then
1788 synsock.CloseSocket(FSocket);
1789 FSocket := INVALID_SOCKET;
1790 for n := FDelayedOptions.Count - 1 downto 0 do
1791 begin
1792 p := TSynaOption(FDelayedOptions[n]);
1793 p.Free;
1794 end;
1795 FDelayedOptions.Clear;
1796 FFamily := FFamilySave;
1797 DoStatus(HR_SocketClose, '');
1798end;
1799
1800procedure TBlockSocket.Bind(IP, Port: string);
1801var
1802 Sin: TVarSin;
1803begin
1804 ResetLastError;
1805 if (FSocket <> INVALID_SOCKET)
1806 or not((FFamily = SF_ANY) and (IP = cAnyHost) and (Port = cAnyPort)) then
1807 begin
1808 SetSin(Sin, IP, Port);
1809 if FLastError = 0 then
1810 begin
1811 if FSocket = INVALID_SOCKET then
1812 InternalCreateSocket(Sin);
1813 SockCheck(synsock.Bind(FSocket, Sin));
1814 GetSinLocal;
1815 FBuffer := '';
1816 FBinded := True;
1817 end;
1818 ExceptCheck;
1819 DoStatus(HR_Bind, IP + ':' + Port);
1820 end;
1821end;
1822
1823procedure TBlockSocket.Connect(IP, Port: string);
1824var
1825 Sin: TVarSin;
1826begin
1827 SetSin(Sin, IP, Port);
1828 if FLastError = 0 then
1829 begin
1830 if FSocket = INVALID_SOCKET then
1831 InternalCreateSocket(Sin);
1832 SockCheck(synsock.Connect(FSocket, Sin));
1833 if FLastError = 0 then
1834 GetSins;
1835 FBuffer := '';
1836 FLastCR := False;
1837 FLastLF := False;
1838 end;
1839 ExceptCheck;
1840 DoStatus(HR_Connect, IP + ':' + Port);
1841end;
1842
1843procedure TBlockSocket.GetSinLocal;
1844begin
1845 synsock.GetSockName(FSocket, FLocalSin);
1846end;
1847
1848procedure TBlockSocket.GetSinRemote;
1849begin
1850 synsock.GetPeerName(FSocket, FRemoteSin);
1851end;
1852
1853procedure TBlockSocket.GetSins;
1854begin
1855 GetSinLocal;
1856 GetSinRemote;
1857end;
1858
1859procedure TBlockSocket.SetBandwidth(Value: Integer);
1860begin
1861 MaxSendBandwidth := Value;
1862 MaxRecvBandwidth := Value;
1863end;
1864
1865procedure TBlockSocket.LimitBandwidth(Length: Integer; MaxB: integer; var Next: LongWord);
1866var
1867 x: LongWord;
1868 y: LongWord;
1869 n: integer;
1870begin
1871 if FStopFlag then
1872 exit;
1873 if MaxB > 0 then
1874 begin
1875 y := GetTick;
1876 if Next > y then
1877 begin
1878 x := Next - y;
1879 if x > 0 then
1880 begin
1881 DoStatus(HR_Wait, IntToStr(x));
1882 sleep(x mod 250);
1883 for n := 1 to x div 250 do
1884 if FStopFlag then
1885 Break
1886 else
1887 sleep(250);
1888 end;
1889 end;
1890 Next := GetTick + Trunc((Length / MaxB) * 1000);
1891 end;
1892end;
1893
1894function TBlockSocket.TestStopFlag: Boolean;
1895begin
1896 DoHeartbeat;
1897 Result := FStopFlag;
1898 if Result then
1899 begin
1900 FStopFlag := False;
1901 FLastError := WSAECONNABORTED;
1902 ExceptCheck;
1903 end;
1904end;
1905
1906
1907function TBlockSocket.SendBuffer(Buffer: TMemory; Length: Integer): Integer;
1908{$IFNDEF CIL}
1909var
1910 x, y: integer;
1911 l, r: integer;
1912 p: Pointer;
1913{$ENDIF}
1914begin
1915 Result := 0;
1916 if TestStopFlag then
1917 Exit;
1918 DoMonitor(True, Buffer, Length);
1919{$IFDEF CIL}
1920 Result := synsock.Send(FSocket, Buffer, Length, 0);
1921{$ELSE}
1922 l := Length;
1923 x := 0;
1924 while x < l do
1925 begin
1926 y := l - x;
1927 if y > FSendMaxChunk then
1928 y := FSendMaxChunk;
1929 if y > 0 then
1930 begin
1931 LimitBandwidth(y, FMaxSendBandwidth, FNextsend);
1932 p := IncPoint(Buffer, x);
1933 r := synsock.Send(FSocket, p, y, MSG_NOSIGNAL);
1934 SockCheck(r);
1935 if FLastError = WSAEWOULDBLOCK then
1936 begin
1937 if CanWrite(FNonblockSendTimeout) then
1938 begin
1939 r := synsock.Send(FSocket, p, y, MSG_NOSIGNAL);
1940 SockCheck(r);
1941 end
1942 else
1943 FLastError := WSAETIMEDOUT;
1944 end;
1945 if FLastError <> 0 then
1946 Break;
1947 Inc(x, r);
1948 Inc(Result, r);
1949 Inc(FSendCounter, r);
1950 DoStatus(HR_WriteCount, IntToStr(r));
1951 end
1952 else
1953 break;
1954 end;
1955{$ENDIF}
1956 ExceptCheck;
1957end;
1958
1959procedure TBlockSocket.SendByte(Data: Byte);
1960{$IFDEF CIL}
1961var
1962 buf: TMemory;
1963{$ENDIF}
1964begin
1965{$IFDEF CIL}
1966 setlength(buf, 1);
1967 buf[0] := Data;
1968 SendBuffer(buf, 1);
1969{$ELSE}
1970 SendBuffer(@Data, 1);
1971{$ENDIF}
1972end;
1973
1974procedure TBlockSocket.SendString(Data: AnsiString);
1975var
1976 buf: TMemory;
1977begin
1978 {$IFDEF CIL}
1979 buf := BytesOf(Data);
1980 {$ELSE}
1981 buf := Pointer(data);
1982 {$ENDIF}
1983 SendBuffer(buf, Length(Data));
1984end;
1985
1986procedure TBlockSocket.SendInteger(Data: integer);
1987var
1988 buf: TMemory;
1989begin
1990 {$IFDEF CIL}
1991 buf := System.BitConverter.GetBytes(Data);
1992 {$ELSE}
1993 buf := @Data;
1994 {$ENDIF}
1995 SendBuffer(buf, SizeOf(Data));
1996end;
1997
1998procedure TBlockSocket.SendBlock(const Data: AnsiString);
1999var
2000 i: integer;
2001begin
2002 i := SwapBytes(Length(data));
2003 SendString(Codelongint(i) + Data);
2004end;
2005
2006procedure TBlockSocket.InternalSendStream(const Stream: TStream; WithSize, Indy: boolean);
2007var
2008 l: integer;
2009 yr: integer;
2010 s: AnsiString;
2011 b: boolean;
2012{$IFDEF CIL}
2013 buf: TMemory;
2014{$ENDIF}
2015begin
2016 b := true;
2017 if WithSize then
2018 begin
2019 l := Stream.Size - Stream.Position;;
2020 if Indy then
2021 l := SwapBytes(l);
2022 end;
2023 repeat
2024 {$IFDEF CIL}
2025 Setlength(buf, FSendMaxChunk);
2026 yr := Stream.read(buf, FSendMaxChunk);
2027 if yr > 0 then
2028 begin
2029 if WithSize and b then
2030 begin
2031 b := false;
2032 SendString(CodeLongInt(l));
2033 end;
2034 SendBuffer(buf, yr);
2035 if FLastError <> 0 then
2036 break;
2037 end
2038 {$ELSE}
2039 Setlength(s, FSendMaxChunk);
2040 yr := Stream.read(Pointer(s)^, FSendMaxChunk);
2041 if yr > 0 then
2042 begin
2043 SetLength(s, yr);
2044 if WithSize and b then
2045 begin
2046 b := false;
2047 SendString(CodeLongInt(l) + s);
2048 end
2049 else
2050 SendString(s);
2051 if FLastError <> 0 then
2052 break;
2053 end
2054 {$ENDIF}
2055 until yr <= 0;
2056end;
2057
2058procedure TBlockSocket.SendStreamRaw(const Stream: TStream);
2059begin
2060 InternalSendStream(Stream, false, false);
2061end;
2062
2063procedure TBlockSocket.SendStreamIndy(const Stream: TStream);
2064begin
2065 InternalSendStream(Stream, true, true);
2066end;
2067
2068procedure TBlockSocket.SendStream(const Stream: TStream);
2069begin
2070 InternalSendStream(Stream, true, false);
2071end;
2072
2073function TBlockSocket.RecvBuffer(Buffer: TMemory; Length: Integer): Integer;
2074begin
2075 Result := 0;
2076 if TestStopFlag then
2077 Exit;
2078 LimitBandwidth(Length, FMaxRecvBandwidth, FNextRecv);
2079// Result := synsock.Recv(FSocket, Buffer^, Length, MSG_NOSIGNAL);
2080 Result := synsock.Recv(FSocket, Buffer, Length, MSG_NOSIGNAL);
2081 if Result = 0 then
2082 FLastError := WSAECONNRESET
2083 else
2084 SockCheck(Result);
2085 ExceptCheck;
2086 if Result > 0 then
2087 begin
2088 Inc(FRecvCounter, Result);
2089 DoStatus(HR_ReadCount, IntToStr(Result));
2090 DoMonitor(False, Buffer, Result);
2091 DoReadFilter(Buffer, Result);
2092 end;
2093end;
2094
2095function TBlockSocket.RecvBufferEx(Buffer: TMemory; Len: Integer;
2096 Timeout: Integer): Integer;
2097var
2098 s: AnsiString;
2099 rl, l: integer;
2100 ti: LongWord;
2101{$IFDEF CIL}
2102 n: integer;
2103 b: TMemory;
2104{$ENDIF}
2105begin
2106 ResetLastError;
2107 Result := 0;
2108 if Len > 0 then
2109 begin
2110 rl := 0;
2111 repeat
2112 ti := GetTick;
2113 s := RecvPacket(Timeout);
2114 l := Length(s);
2115 if (rl + l) > Len then
2116 l := Len - rl;
2117 {$IFDEF CIL}
2118 b := BytesOf(s);
2119 for n := 0 to l do
2120 Buffer[rl + n] := b[n];
2121 {$ELSE}
2122 Move(Pointer(s)^, IncPoint(Buffer, rl)^, l);
2123 {$ENDIF}
2124 rl := rl + l;
2125 if FLastError <> 0 then
2126 Break;
2127 if rl >= Len then
2128 Break;
2129 if not FInterPacketTimeout then
2130 begin
2131 Timeout := Timeout - integer(TickDelta(ti, GetTick));
2132 if Timeout <= 0 then
2133 begin
2134 FLastError := WSAETIMEDOUT;
2135 Break;
2136 end;
2137 end;
2138 until False;
2139 delete(s, 1, l);
2140 FBuffer := s;
2141 Result := rl;
2142 end;
2143end;
2144
2145function TBlockSocket.RecvBufferStr(Len: Integer; Timeout: Integer): AnsiString;
2146var
2147 x: integer;
2148{$IFDEF CIL}
2149 buf: Tmemory;
2150{$ENDIF}
2151begin
2152 Result := '';
2153 if Len > 0 then
2154 begin
2155 {$IFDEF CIL}
2156 Setlength(Buf, Len);
2157 x := RecvBufferEx(buf, Len , Timeout);
2158 if FLastError = 0 then
2159 begin
2160 SetLength(Buf, x);
2161 Result := StringOf(buf);
2162 end
2163 else
2164 Result := '';
2165 {$ELSE}
2166 Setlength(Result, Len);
2167 x := RecvBufferEx(Pointer(Result), Len , Timeout);
2168 if FLastError = 0 then
2169 SetLength(Result, x)
2170 else
2171 Result := '';
2172 {$ENDIF}
2173 end;
2174end;
2175
2176function TBlockSocket.RecvPacket(Timeout: Integer): AnsiString;
2177var
2178 x: integer;
2179{$IFDEF CIL}
2180 buf: TMemory;
2181{$ENDIF}
2182begin
2183 Result := '';
2184 ResetLastError;
2185 if FBuffer <> '' then
2186 begin
2187 Result := FBuffer;
2188 FBuffer := '';
2189 end
2190 else
2191 begin
2192 {$IFDEF WIN32}
2193 //not drain CPU on large downloads...
2194 Sleep(0);
2195 {$ENDIF}
2196 x := WaitingData;
2197 if x > 0 then
2198 begin
2199 {$IFDEF CIL}
2200 SetLength(Buf, x);
2201 x := RecvBuffer(Buf, x);
2202 if x >= 0 then
2203 begin
2204 SetLength(Buf, x);
2205 Result := StringOf(Buf);
2206 end;
2207 {$ELSE}
2208 SetLength(Result, x);
2209 x := RecvBuffer(Pointer(Result), x);
2210 if x >= 0 then
2211 SetLength(Result, x);
2212 {$ENDIF}
2213 end
2214 else
2215 begin
2216 if CanRead(Timeout) then
2217 begin
2218 x := WaitingData;
2219 if x = 0 then
2220 FLastError := WSAECONNRESET;
2221 if x > 0 then
2222 begin
2223 {$IFDEF CIL}
2224 SetLength(Buf, x);
2225 x := RecvBuffer(Buf, x);
2226 if x >= 0 then
2227 begin
2228 SetLength(Buf, x);
2229 result := StringOf(Buf);
2230 end;
2231 {$ELSE}
2232 SetLength(Result, x);
2233 x := RecvBuffer(Pointer(Result), x);
2234 if x >= 0 then
2235 SetLength(Result, x);
2236 {$ENDIF}
2237 end;
2238 end
2239 else
2240 FLastError := WSAETIMEDOUT;
2241 end;
2242 end;
2243 if FConvertLineEnd and (Result <> '') then
2244 begin
2245 if FLastCR and (Result[1] = LF) then
2246 Delete(Result, 1, 1);
2247 if FLastLF and (Result[1] = CR) then
2248 Delete(Result, 1, 1);
2249 FLastCR := False;
2250 FLastLF := False;
2251 end;
2252 ExceptCheck;
2253end;
2254
2255
2256function TBlockSocket.RecvByte(Timeout: Integer): Byte;
2257begin
2258 Result := 0;
2259 ResetLastError;
2260 if FBuffer = '' then
2261 FBuffer := RecvPacket(Timeout);
2262 if (FLastError = 0) and (FBuffer <> '') then
2263 begin
2264 Result := Ord(FBuffer[1]);
2265 Delete(FBuffer, 1, 1);
2266 end;
2267 ExceptCheck;
2268end;
2269
2270function TBlockSocket.RecvInteger(Timeout: Integer): Integer;
2271var
2272 s: AnsiString;
2273begin
2274 Result := 0;
2275 s := RecvBufferStr(4, Timeout);
2276 if FLastError = 0 then
2277 Result := (ord(s[1]) + ord(s[2]) * 256) + (ord(s[3]) + ord(s[4]) * 256) * 65536;
2278end;
2279
2280function TBlockSocket.RecvTerminated(Timeout: Integer; const Terminator: AnsiString): AnsiString;
2281var
2282 x: Integer;
2283 s: AnsiString;
2284 l: Integer;
2285 CorCRLF: Boolean;
2286 t: AnsiString;
2287 tl: integer;
2288 ti: LongWord;
2289begin
2290 ResetLastError;
2291 Result := '';
2292 l := Length(Terminator);
2293 if l = 0 then
2294 Exit;
2295 tl := l;
2296 CorCRLF := FConvertLineEnd and (Terminator = CRLF);
2297 s := '';
2298 x := 0;
2299 repeat
2300 //get rest of FBuffer or incomming new data...
2301 ti := GetTick;
2302 s := s + RecvPacket(Timeout);
2303 if FLastError <> 0 then
2304 Break;
2305 x := 0;
2306 if Length(s) > 0 then
2307 if CorCRLF then
2308 begin
2309 t := '';
2310 x := PosCRLF(s, t);
2311 tl := Length(t);
2312 if t = CR then
2313 FLastCR := True;
2314 if t = LF then
2315 FLastLF := True;
2316 end
2317 else
2318 begin
2319 x := pos(Terminator, s);
2320 tl := l;
2321 end;
2322 if (FMaxLineLength <> 0) and (Length(s) > FMaxLineLength) then
2323 begin
2324 FLastError := WSAENOBUFS;
2325 Break;
2326 end;
2327 if x > 0 then
2328 Break;
2329 if not FInterPacketTimeout then
2330 begin
2331 Timeout := Timeout - integer(TickDelta(ti, GetTick));
2332 if Timeout <= 0 then
2333 begin
2334 FLastError := WSAETIMEDOUT;
2335 Break;
2336 end;
2337 end;
2338 until False;
2339 if x > 0 then
2340 begin
2341 Result := Copy(s, 1, x - 1);
2342 Delete(s, 1, x + tl - 1);
2343 end;
2344 FBuffer := s;
2345 ExceptCheck;
2346end;
2347
2348function TBlockSocket.RecvString(Timeout: Integer): AnsiString;
2349var
2350 s: AnsiString;
2351begin
2352 Result := '';
2353 s := RecvTerminated(Timeout, CRLF);
2354 if FLastError = 0 then
2355 Result := s;
2356end;
2357
2358function TBlockSocket.RecvBlock(Timeout: Integer): AnsiString;
2359var
2360 x: integer;
2361begin
2362 Result := '';
2363 x := RecvInteger(Timeout);
2364 if FLastError = 0 then
2365 Result := RecvBufferStr(x, Timeout);
2366end;
2367
2368procedure TBlockSocket.RecvStreamRaw(const Stream: TStream; Timeout: Integer);
2369var
2370 s: AnsiString;
2371begin
2372 repeat
2373 s := RecvPacket(Timeout);
2374 if FLastError = 0 then
2375 WriteStrToStream(Stream, s);
2376 until FLastError <> 0;
2377end;
2378
2379procedure TBlockSocket.RecvStreamSize(const Stream: TStream; Timeout: Integer; Size: Integer);
2380var
2381 s: AnsiString;
2382 n: integer;
2383{$IFDEF CIL}
2384 buf: TMemory;
2385{$ENDIF}
2386begin
2387 for n := 1 to (Size div FSendMaxChunk) do
2388 begin
2389 {$IFDEF CIL}
2390 SetLength(buf, FSendMaxChunk);
2391 RecvBufferEx(buf, FSendMaxChunk, Timeout);
2392 if FLastError <> 0 then
2393 Exit;
2394 Stream.Write(buf, FSendMaxChunk);
2395 {$ELSE}
2396 s := RecvBufferStr(FSendMaxChunk, Timeout);
2397 if FLastError <> 0 then
2398 Exit;
2399 WriteStrToStream(Stream, s);
2400 {$ENDIF}
2401 end;
2402 n := Size mod FSendMaxChunk;
2403 if n > 0 then
2404 begin
2405 {$IFDEF CIL}
2406 SetLength(buf, n);
2407 RecvBufferEx(buf, n, Timeout);
2408 if FLastError <> 0 then
2409 Exit;
2410 Stream.Write(buf, n);
2411 {$ELSE}
2412 s := RecvBufferStr(n, Timeout);
2413 if FLastError <> 0 then
2414 Exit;
2415 WriteStrToStream(Stream, s);
2416 {$ENDIF}
2417 end;
2418end;
2419
2420procedure TBlockSocket.RecvStreamIndy(const Stream: TStream; Timeout: Integer);
2421var
2422 x: integer;
2423begin
2424 x := RecvInteger(Timeout);
2425 x := synsock.NToHL(x);
2426 if FLastError = 0 then
2427 RecvStreamSize(Stream, Timeout, x);
2428end;
2429
2430procedure TBlockSocket.RecvStream(const Stream: TStream; Timeout: Integer);
2431var
2432 x: integer;
2433begin
2434 x := RecvInteger(Timeout);
2435 if FLastError = 0 then
2436 RecvStreamSize(Stream, Timeout, x);
2437end;
2438
2439function TBlockSocket.PeekBuffer(Buffer: TMemory; Length: Integer): Integer;
2440begin
2441 {$IFNDEF CIL}
2442// Result := synsock.Recv(FSocket, Buffer^, Length, MSG_PEEK + MSG_NOSIGNAL);
2443 Result := synsock.Recv(FSocket, Buffer, Length, MSG_PEEK + MSG_NOSIGNAL);
2444 SockCheck(Result);
2445 ExceptCheck;
2446 {$ENDIF}
2447end;
2448
2449function TBlockSocket.PeekByte(Timeout: Integer): Byte;
2450var
2451 s: string;
2452begin
2453 {$IFNDEF CIL}
2454 Result := 0;
2455 if CanRead(Timeout) then
2456 begin
2457 SetLength(s, 1);
2458 PeekBuffer(Pointer(s), 1);
2459 if s <> '' then
2460 Result := Ord(s[1]);
2461 end
2462 else
2463 FLastError := WSAETIMEDOUT;
2464 ExceptCheck;
2465 {$ENDIF}
2466end;
2467
2468procedure TBlockSocket.ResetLastError;
2469begin
2470 FLastError := 0;
2471 FLastErrorDesc := '';
2472end;
2473
2474function TBlockSocket.SockCheck(SockResult: Integer): Integer;
2475begin
2476 ResetLastError;
2477 if SockResult = integer(SOCKET_ERROR) then
2478 begin
2479 FLastError := synsock.WSAGetLastError;
2480 FLastErrorDesc := GetErrorDescEx;
2481 end;
2482 Result := FLastError;
2483end;
2484
2485procedure TBlockSocket.ExceptCheck;
2486var
2487 e: ESynapseError;
2488begin
2489 FLastErrorDesc := GetErrorDescEx;
2490 if (LastError <> 0) and (LastError <> WSAEINPROGRESS)
2491 and (LastError <> WSAEWOULDBLOCK) then
2492 begin
2493 DoStatus(HR_Error, IntToStr(FLastError) + ',' + FLastErrorDesc);
2494 if FRaiseExcept then
2495 begin
2496 e := ESynapseError.Create(Format('Synapse TCP/IP Socket error %d: %s',
2497 [FLastError, FLastErrorDesc]));
2498 e.ErrorCode := FLastError;
2499 e.ErrorMessage := FLastErrorDesc;
2500 raise e;
2501 end;
2502 end;
2503end;
2504
2505function TBlockSocket.WaitingData: Integer;
2506var
2507 x: Integer;
2508begin
2509 Result := 0;
2510 if synsock.IoctlSocket(FSocket, FIONREAD, x) = 0 then
2511 Result := x;
2512 if Result > c64k then
2513 Result := c64k;
2514end;
2515
2516function TBlockSocket.WaitingDataEx: Integer;
2517begin
2518 if FBuffer <> '' then
2519 Result := Length(FBuffer)
2520 else
2521 Result := WaitingData;
2522end;
2523
2524procedure TBlockSocket.Purge;
2525begin
2526 Sleep(1);
2527 try
2528 while (Length(FBuffer) > 0) or (WaitingData > 0) do
2529 begin
2530 RecvPacket(0);
2531 if FLastError <> 0 then
2532 break;
2533 end;
2534 except
2535 on exception do;
2536 end;
2537 ResetLastError;
2538end;
2539
2540procedure TBlockSocket.SetLinger(Enable: Boolean; Linger: Integer);
2541var
2542 d: TSynaOption;
2543begin
2544 d := TSynaOption.Create;
2545 d.Option := SOT_Linger;
2546 d.Enabled := Enable;
2547 d.Value := Linger;
2548 DelayedOption(d);
2549end;
2550
2551function TBlockSocket.LocalName: string;
2552begin
2553 Result := synsock.GetHostName;
2554 if Result = '' then
2555 Result := '127.0.0.1';
2556end;
2557
2558procedure TBlockSocket.ResolveNameToIP(Name: string; const IPList: TStrings);
2559begin
2560 IPList.Clear;
2561 synsock.ResolveNameToIP(Name, FamilyToAF(FFamily), GetSocketprotocol, GetSocketType, IPList);
2562 if IPList.Count = 0 then
2563 IPList.Add(cAnyHost);
2564end;
2565
2566function TBlockSocket.ResolveName(Name: string): string;
2567var
2568 l: TStringList;
2569begin
2570 l := TStringList.Create;
2571 try
2572 ResolveNameToIP(Name, l);
2573 Result := l[0];
2574 finally
2575 l.Free;
2576 end;
2577end;
2578
2579function TBlockSocket.ResolvePort(Port: string): Word;
2580begin
2581 Result := synsock.ResolvePort(Port, FamilyToAF(FFamily), GetSocketProtocol, GetSocketType);
2582end;
2583
2584function TBlockSocket.ResolveIPToName(IP: string): string;
2585begin
2586 if not IsIP(IP) or not IsIp6(IP) then
2587 IP := ResolveName(IP);
2588 Result := synsock.ResolveIPToName(IP, FamilyToAF(FFamily), GetSocketProtocol, GetSocketType);
2589end;
2590
2591procedure TBlockSocket.SetRemoteSin(IP, Port: string);
2592begin
2593 SetSin(FRemoteSin, IP, Port);
2594end;
2595
2596function TBlockSocket.GetLocalSinIP: string;
2597begin
2598 Result := GetSinIP(FLocalSin);
2599end;
2600
2601function TBlockSocket.GetRemoteSinIP: string;
2602begin
2603 Result := GetSinIP(FRemoteSin);
2604end;
2605
2606function TBlockSocket.GetLocalSinPort: Integer;
2607begin
2608 Result := GetSinPort(FLocalSin);
2609end;
2610
2611function TBlockSocket.GetRemoteSinPort: Integer;
2612begin
2613 Result := GetSinPort(FRemoteSin);
2614end;
2615
2616function TBlockSocket.InternalCanRead(Timeout: Integer): Boolean;
2617{$IFDEF CIL}
2618begin
2619 Result := FSocket.Poll(Timeout * 1000, SelectMode.SelectRead);
2620{$ELSE}
2621var
2622 TimeVal: PTimeVal;
2623 TimeV: TTimeVal;
2624 x: Integer;
2625 FDSet: TFDSet;
2626begin
2627 TimeV.tv_usec := (Timeout mod 1000) * 1000;
2628 TimeV.tv_sec := Timeout div 1000;
2629 TimeVal := @TimeV;
2630 if Timeout = -1 then
2631 TimeVal := nil;
2632 FDSet := FFdSet;
2633 x := synsock.Select(FSocket + 1, @FDSet, nil, nil, TimeVal);
2634 SockCheck(x);
2635 if FLastError <> 0 then
2636 x := 0;
2637 Result := x > 0;
2638{$ENDIF}
2639end;
2640
2641function TBlockSocket.CanRead(Timeout: Integer): Boolean;
2642var
2643 ti, tr: Integer;
2644 n: integer;
2645begin
2646 if (FHeartbeatRate <> 0) and (Timeout <> -1) then
2647 begin
2648 ti := Timeout div FHeartbeatRate;
2649 tr := Timeout mod FHeartbeatRate;
2650 end
2651 else
2652 begin
2653 ti := 0;
2654 tr := Timeout;
2655 end;
2656 Result := InternalCanRead(tr);
2657 if not Result then
2658 for n := 0 to ti do
2659 begin
2660 DoHeartbeat;
2661 if FStopFlag then
2662 begin
2663 Result := False;
2664 FStopFlag := False;
2665 Break;
2666 end;
2667 Result := InternalCanRead(FHeartbeatRate);
2668 if Result then
2669 break;
2670 end;
2671 ExceptCheck;
2672 if Result then
2673 DoStatus(HR_CanRead, '');
2674end;
2675
2676function TBlockSocket.CanWrite(Timeout: Integer): Boolean;
2677{$IFDEF CIL}
2678begin
2679 Result := FSocket.Poll(Timeout * 1000, SelectMode.SelectWrite);
2680{$ELSE}
2681var
2682 TimeVal: PTimeVal;
2683 TimeV: TTimeVal;
2684 x: Integer;
2685 FDSet: TFDSet;
2686begin
2687 TimeV.tv_usec := (Timeout mod 1000) * 1000;
2688 TimeV.tv_sec := Timeout div 1000;
2689 TimeVal := @TimeV;
2690 if Timeout = -1 then
2691 TimeVal := nil;
2692 FDSet := FFdSet;
2693 x := synsock.Select(FSocket + 1, nil, @FDSet, nil, TimeVal);
2694 SockCheck(x);
2695 if FLastError <> 0 then
2696 x := 0;
2697 Result := x > 0;
2698{$ENDIF}
2699 ExceptCheck;
2700 if Result then
2701 DoStatus(HR_CanWrite, '');
2702end;
2703
2704function TBlockSocket.CanReadEx(Timeout: Integer): Boolean;
2705begin
2706 if FBuffer <> '' then
2707 Result := True
2708 else
2709 Result := CanRead(Timeout);
2710end;
2711
2712function TBlockSocket.SendBufferTo(Buffer: TMemory; Length: Integer): Integer;
2713begin
2714 Result := 0;
2715 if TestStopFlag then
2716 Exit;
2717 DoMonitor(True, Buffer, Length);
2718 LimitBandwidth(Length, FMaxSendBandwidth, FNextsend);
2719 Result := synsock.SendTo(FSocket, Buffer, Length, MSG_NOSIGNAL, FRemoteSin);
2720 SockCheck(Result);
2721 ExceptCheck;
2722 Inc(FSendCounter, Result);
2723 DoStatus(HR_WriteCount, IntToStr(Result));
2724end;
2725
2726function TBlockSocket.RecvBufferFrom(Buffer: TMemory; Length: Integer): Integer;
2727begin
2728 Result := 0;
2729 if TestStopFlag then
2730 Exit;
2731 LimitBandwidth(Length, FMaxRecvBandwidth, FNextRecv);
2732 Result := synsock.RecvFrom(FSocket, Buffer, Length, MSG_NOSIGNAL, FRemoteSin);
2733 SockCheck(Result);
2734 ExceptCheck;
2735 Inc(FRecvCounter, Result);
2736 DoStatus(HR_ReadCount, IntToStr(Result));
2737 DoMonitor(False, Buffer, Result);
2738end;
2739
2740function TBlockSocket.GetSizeRecvBuffer: Integer;
2741var
2742 l: Integer;
2743{$IFDEF CIL}
2744 buf: TMemory;
2745{$ENDIF}
2746begin
2747{$IFDEF CIL}
2748 setlength(buf, 4);
2749 SockCheck(synsock.GetSockOpt(FSocket, integer(SOL_SOCKET), integer(SO_RCVBUF), buf, l));
2750 Result := System.BitConverter.ToInt32(buf,0);
2751{$ELSE}
2752 l := SizeOf(Result);
2753 SockCheck(synsock.GetSockOpt(FSocket, SOL_SOCKET, SO_RCVBUF, @Result, l));
2754 if FLastError <> 0 then
2755 Result := 1024;
2756 ExceptCheck;
2757{$ENDIF}
2758end;
2759
2760procedure TBlockSocket.SetSizeRecvBuffer(Size: Integer);
2761var
2762 d: TSynaOption;
2763begin
2764 d := TSynaOption.Create;
2765 d.Option := SOT_RecvBuff;
2766 d.Value := Size;
2767 DelayedOption(d);
2768end;
2769
2770function TBlockSocket.GetSizeSendBuffer: Integer;
2771var
2772 l: Integer;
2773{$IFDEF CIL}
2774 buf: TMemory;
2775{$ENDIF}
2776begin
2777{$IFDEF CIL}
2778 setlength(buf, 4);
2779 SockCheck(synsock.GetSockOpt(FSocket, integer(SOL_SOCKET), integer(SO_SNDBUF), buf, l));
2780 Result := System.BitConverter.ToInt32(buf,0);
2781{$ELSE}
2782 l := SizeOf(Result);
2783 SockCheck(synsock.GetSockOpt(FSocket, SOL_SOCKET, SO_SNDBUF, @Result, l));
2784 if FLastError <> 0 then
2785 Result := 1024;
2786 ExceptCheck;
2787{$ENDIF}
2788end;
2789
2790procedure TBlockSocket.SetSizeSendBuffer(Size: Integer);
2791var
2792 d: TSynaOption;
2793begin
2794 d := TSynaOption.Create;
2795 d.Option := SOT_SendBuff;
2796 d.Value := Size;
2797 DelayedOption(d);
2798end;
2799
2800procedure TBlockSocket.SetNonBlockMode(Value: Boolean);
2801var
2802 d: TSynaOption;
2803begin
2804 d := TSynaOption.Create;
2805 d.Option := SOT_nonblock;
2806 d.Enabled := Value;
2807 DelayedOption(d);
2808end;
2809
2810procedure TBlockSocket.SetTimeout(Timeout: Integer);
2811begin
2812 SetSendTimeout(Timeout);
2813 SetRecvTimeout(Timeout);
2814end;
2815
2816procedure TBlockSocket.SetSendTimeout(Timeout: Integer);
2817var
2818 d: TSynaOption;
2819begin
2820 d := TSynaOption.Create;
2821 d.Option := SOT_sendtimeout;
2822 d.Value := Timeout;
2823 DelayedOption(d);
2824end;
2825
2826procedure TBlockSocket.SetRecvTimeout(Timeout: Integer);
2827var
2828 d: TSynaOption;
2829begin
2830 d := TSynaOption.Create;
2831 d.Option := SOT_recvtimeout;
2832 d.Value := Timeout;
2833 DelayedOption(d);
2834end;
2835
2836{$IFNDEF CIL}
2837function TBlockSocket.GroupCanRead(const SocketList: TList; Timeout: Integer;
2838 const CanReadList: TList): boolean;
2839var
2840 FDSet: TFDSet;
2841 TimeVal: PTimeVal;
2842 TimeV: TTimeVal;
2843 x, n: Integer;
2844 Max: Integer;
2845begin
2846 TimeV.tv_usec := (Timeout mod 1000) * 1000;
2847 TimeV.tv_sec := Timeout div 1000;
2848 TimeVal := @TimeV;
2849 if Timeout = -1 then
2850 TimeVal := nil;
2851 FD_ZERO(FDSet);
2852 Max := 0;
2853 for n := 0 to SocketList.Count - 1 do
2854 if TObject(SocketList.Items[n]) is TBlockSocket then
2855 begin
2856 if TBlockSocket(SocketList.Items[n]).Socket > Max then
2857 Max := TBlockSocket(SocketList.Items[n]).Socket;
2858 FD_SET(TBlockSocket(SocketList.Items[n]).Socket, FDSet);
2859 end;
2860 x := synsock.Select(Max + 1, @FDSet, nil, nil, TimeVal);
2861 SockCheck(x);
2862 ExceptCheck;
2863 if FLastError <> 0 then
2864 x := 0;
2865 Result := x > 0;
2866 CanReadList.Clear;
2867 if Result then
2868 for n := 0 to SocketList.Count - 1 do
2869 if TObject(SocketList.Items[n]) is TBlockSocket then
2870 if FD_ISSET(TBlockSocket(SocketList.Items[n]).Socket, FDSet) then
2871 CanReadList.Add(TBlockSocket(SocketList.Items[n]));
2872end;
2873{$ENDIF}
2874
2875procedure TBlockSocket.EnableReuse(Value: Boolean);
2876var
2877 d: TSynaOption;
2878begin
2879 d := TSynaOption.Create;
2880 d.Option := SOT_reuse;
2881 d.Enabled := Value;
2882 DelayedOption(d);
2883end;
2884
2885procedure TBlockSocket.SetTTL(TTL: integer);
2886var
2887 d: TSynaOption;
2888begin
2889 d := TSynaOption.Create;
2890 d.Option := SOT_TTL;
2891 d.Value := TTL;
2892 DelayedOption(d);
2893end;
2894
2895function TBlockSocket.GetTTL:integer;
2896var
2897 l: Integer;
2898begin
2899{$IFNDEF CIL}
2900 l := SizeOf(Result);
2901 if FIP6Used then
2902 synsock.GetSockOpt(FSocket, IPPROTO_IPV6, IPV6_UNICAST_HOPS, @Result, l)
2903 else
2904 synsock.GetSockOpt(FSocket, IPPROTO_IP, IP_TTL, @Result, l);
2905{$ENDIF}
2906end;
2907
2908procedure TBlockSocket.SetFamily(Value: TSocketFamily);
2909begin
2910 FFamily := Value;
2911 FFamilySave := Value;
2912end;
2913
2914procedure TBlockSocket.SetSocket(Value: TSocket);
2915begin
2916 FRecvCounter := 0;
2917 FSendCounter := 0;
2918 FSocket := Value;
2919{$IFNDEF CIL}
2920 FD_ZERO(FFDSet);
2921 FD_SET(FSocket, FFDSet);
2922{$ENDIF}
2923 GetSins;
2924 FIP6Used := FRemoteSin.AddressFamily = AF_INET6;
2925end;
2926
2927function TBlockSocket.GetWsaData: TWSAData;
2928begin
2929 Result := WsaDataOnce;
2930end;
2931
2932function TBlockSocket.GetSocketType: integer;
2933begin
2934 Result := 0;
2935end;
2936
2937function TBlockSocket.GetSocketProtocol: integer;
2938begin
2939 Result := integer(IPPROTO_IP);
2940end;
2941
2942procedure TBlockSocket.DoStatus(Reason: THookSocketReason; const Value: string);
2943begin
2944 if assigned(OnStatus) then
2945 OnStatus(Self, Reason, Value);
2946end;
2947
2948procedure TBlockSocket.DoReadFilter(Buffer: TMemory; var Len: Integer);
2949var
2950 s: AnsiString;
2951begin
2952 if assigned(OnReadFilter) then
2953 if Len > 0 then
2954 begin
2955 {$IFDEF CIL}
2956 s := StringOf(Buffer);
2957 {$ELSE}
2958 SetLength(s, Len);
2959 Move(Buffer^, Pointer(s)^, Len);
2960 {$ENDIF}
2961 OnReadFilter(Self, s);
2962 if Length(s) > Len then
2963 SetLength(s, Len);
2964 Len := Length(s);
2965 {$IFDEF CIL}
2966 Buffer := BytesOf(s);
2967 {$ELSE}
2968 Move(Pointer(s)^, Buffer^, Len);
2969 {$ENDIF}
2970 end;
2971end;
2972
2973procedure TBlockSocket.DoCreateSocket;
2974begin
2975 if assigned(OnCreateSocket) then
2976 OnCreateSocket(Self);
2977end;
2978
2979procedure TBlockSocket.DoMonitor(Writing: Boolean; const Buffer: TMemory; Len: Integer);
2980begin
2981 if assigned(OnMonitor) then
2982 begin
2983 OnMonitor(Self, Writing, Buffer, Len);
2984 end;
2985end;
2986
2987procedure TBlockSocket.DoHeartbeat;
2988begin
2989 if assigned(OnHeartbeat) and (FHeartbeatRate <> 0) then
2990 begin
2991 OnHeartbeat(Self);
2992 end;
2993end;
2994
2995function TBlockSocket.GetErrorDescEx: string;
2996begin
2997 Result := GetErrorDesc(FLastError);
2998end;
2999
3000class function TBlockSocket.GetErrorDesc(ErrorCode: Integer): string;
3001begin
3002{$IFDEF CIL}
3003 if ErrorCode = 0 then
3004 Result := ''
3005 else
3006 begin
3007 Result := WSAGetLastErrorDesc;
3008 if Result = '' then
3009 Result := 'Other Winsock error (' + IntToStr(ErrorCode) + ')';
3010 end;
3011{$ELSE}
3012 case ErrorCode of
3013 0:
3014 Result := '';
3015 WSAEINTR: {10004}
3016 Result := 'Interrupted system call';
3017 WSAEBADF: {10009}
3018 Result := 'Bad file number';
3019 WSAEACCES: {10013}
3020 Result := 'Permission denied';
3021 WSAEFAULT: {10014}
3022 Result := 'Bad address';
3023 WSAEINVAL: {10022}
3024 Result := 'Invalid argument';
3025 WSAEMFILE: {10024}
3026 Result := 'Too many open files';
3027 WSAEWOULDBLOCK: {10035}
3028 Result := 'Operation would block';
3029 WSAEINPROGRESS: {10036}
3030 Result := 'Operation now in progress';
3031 WSAEALREADY: {10037}
3032 Result := 'Operation already in progress';
3033 WSAENOTSOCK: {10038}
3034 Result := 'Socket operation on nonsocket';
3035 WSAEDESTADDRREQ: {10039}
3036 Result := 'Destination address required';
3037 WSAEMSGSIZE: {10040}
3038 Result := 'Message too long';
3039 WSAEPROTOTYPE: {10041}
3040 Result := 'Protocol wrong type for Socket';
3041 WSAENOPROTOOPT: {10042}
3042 Result := 'Protocol not available';
3043 WSAEPROTONOSUPPORT: {10043}
3044 Result := 'Protocol not supported';
3045 WSAESOCKTNOSUPPORT: {10044}
3046 Result := 'Socket not supported';
3047 WSAEOPNOTSUPP: {10045}
3048 Result := 'Operation not supported on Socket';
3049 WSAEPFNOSUPPORT: {10046}
3050 Result := 'Protocol family not supported';
3051 WSAEAFNOSUPPORT: {10047}
3052 Result := 'Address family not supported';
3053 WSAEADDRINUSE: {10048}
3054 Result := 'Address already in use';
3055 WSAEADDRNOTAVAIL: {10049}
3056 Result := 'Can''t assign requested address';
3057 WSAENETDOWN: {10050}
3058 Result := 'Network is down';
3059 WSAENETUNREACH: {10051}
3060 Result := 'Network is unreachable';
3061 WSAENETRESET: {10052}
3062 Result := 'Network dropped connection on reset';
3063 WSAECONNABORTED: {10053}
3064 Result := 'Software caused connection abort';
3065 WSAECONNRESET: {10054}
3066 Result := 'Connection reset by peer';
3067 WSAENOBUFS: {10055}
3068 Result := 'No Buffer space available';
3069 WSAEISCONN: {10056}
3070 Result := 'Socket is already connected';
3071 WSAENOTCONN: {10057}
3072 Result := 'Socket is not connected';
3073 WSAESHUTDOWN: {10058}
3074 Result := 'Can''t send after Socket shutdown';
3075 WSAETOOMANYREFS: {10059}
3076 Result := 'Too many references:can''t splice';
3077 WSAETIMEDOUT: {10060}
3078 Result := 'Connection timed out';
3079 WSAECONNREFUSED: {10061}
3080 Result := 'Connection refused';
3081 WSAELOOP: {10062}
3082 Result := 'Too many levels of symbolic links';
3083 WSAENAMETOOLONG: {10063}
3084 Result := 'File name is too long';
3085 WSAEHOSTDOWN: {10064}
3086 Result := 'Host is down';
3087 WSAEHOSTUNREACH: {10065}
3088 Result := 'No route to host';
3089 WSAENOTEMPTY: {10066}
3090 Result := 'Directory is not empty';
3091 WSAEPROCLIM: {10067}
3092 Result := 'Too many processes';
3093 WSAEUSERS: {10068}
3094 Result := 'Too many users';
3095 WSAEDQUOT: {10069}
3096 Result := 'Disk quota exceeded';
3097 WSAESTALE: {10070}
3098 Result := 'Stale NFS file handle';
3099 WSAEREMOTE: {10071}
3100 Result := 'Too many levels of remote in path';
3101 WSASYSNOTREADY: {10091}
3102 Result := 'Network subsystem is unusable';
3103 WSAVERNOTSUPPORTED: {10092}
3104 Result := 'Winsock DLL cannot support this application';
3105 WSANOTINITIALISED: {10093}
3106 Result := 'Winsock not initialized';
3107 WSAEDISCON: {10101}
3108 Result := 'Disconnect';
3109 WSAHOST_NOT_FOUND: {11001}
3110 Result := 'Host not found';
3111 WSATRY_AGAIN: {11002}
3112 Result := 'Non authoritative - host not found';
3113 WSANO_RECOVERY: {11003}
3114 Result := 'Non recoverable error';
3115 WSANO_DATA: {11004}
3116 Result := 'Valid name, no data record of requested type'
3117 else
3118 Result := 'Other Winsock error (' + IntToStr(ErrorCode) + ')';
3119 end;
3120{$ENDIF}
3121end;
3122
3123{======================================================================}
3124
3125constructor TSocksBlockSocket.Create;
3126begin
3127 inherited Create;
3128 FSocksIP:= '';
3129 FSocksPort:= '1080';
3130 FSocksTimeout:= 60000;
3131 FSocksUsername:= '';
3132 FSocksPassword:= '';
3133 FUsingSocks := False;
3134 FSocksResolver := True;
3135 FSocksLastError := 0;
3136 FSocksResponseIP := '';
3137 FSocksResponsePort := '';
3138 FSocksLocalIP := '';
3139 FSocksLocalPort := '';
3140 FSocksRemoteIP := '';
3141 FSocksRemotePort := '';
3142 FBypassFlag := False;
3143 FSocksType := ST_Socks5;
3144end;
3145
3146function TSocksBlockSocket.SocksOpen: boolean;
3147var
3148 Buf: string;
3149 n: integer;
3150begin
3151 Result := False;
3152 FUsingSocks := False;
3153 if FSocksType <> ST_Socks5 then
3154 begin
3155 FUsingSocks := True;
3156 Result := True;
3157 end
3158 else
3159 begin
3160 FBypassFlag := True;
3161 try
3162 if FSocksUsername = '' then
3163 Buf := #5 + #1 + #0
3164 else
3165 Buf := #5 + #2 + #2 +#0;
3166 SendString(Buf);
3167 Buf := RecvBufferStr(2, FSocksTimeout);
3168 if Length(Buf) < 2 then
3169 Exit;
3170 if Buf[1] <> #5 then
3171 Exit;
3172 n := Ord(Buf[2]);
3173 case n of
3174 0: //not need authorisation
3175 ;
3176 2:
3177 begin
3178 Buf := #1 + char(Length(FSocksUsername)) + FSocksUsername
3179 + char(Length(FSocksPassword)) + FSocksPassword;
3180 SendString(Buf);
3181 Buf := RecvBufferStr(2, FSocksTimeout);
3182 if Length(Buf) < 2 then
3183 Exit;
3184 if Buf[2] <> #0 then
3185 Exit;
3186 end;
3187 else
3188 //other authorisation is not supported!
3189 Exit;
3190 end;
3191 FUsingSocks := True;
3192 Result := True;
3193 finally
3194 FBypassFlag := False;
3195 end;
3196 end;
3197end;
3198
3199function TSocksBlockSocket.SocksRequest(Cmd: Byte;
3200 const IP, Port: string): Boolean;
3201var
3202 Buf: string;
3203begin
3204 FBypassFlag := True;
3205 try
3206 if FSocksType <> ST_Socks5 then
3207 Buf := #4 + char(Cmd) + SocksCode(IP, Port)
3208 else
3209 Buf := #5 + char(Cmd) + #0 + SocksCode(IP, Port);
3210 SendString(Buf);
3211 Result := FLastError = 0;
3212 finally
3213 FBypassFlag := False;
3214 end;
3215end;
3216
3217function TSocksBlockSocket.SocksResponse: Boolean;
3218var
3219 Buf, s: string;
3220 x: integer;
3221begin
3222 Result := False;
3223 FBypassFlag := True;
3224 try
3225 FSocksResponseIP := '';
3226 FSocksResponsePort := '';
3227 FSocksLastError := -1;
3228 if FSocksType <> ST_Socks5 then
3229 begin
3230 Buf := RecvBufferStr(8, FSocksTimeout);
3231 if FLastError <> 0 then
3232 Exit;
3233 if Buf[1] <> #0 then
3234 Exit;
3235 FSocksLastError := Ord(Buf[2]);
3236 end
3237 else
3238 begin
3239 Buf := RecvBufferStr(4, FSocksTimeout);
3240 if FLastError <> 0 then
3241 Exit;
3242 if Buf[1] <> #5 then
3243 Exit;
3244 case Ord(Buf[4]) of
3245 1:
3246 s := RecvBufferStr(4, FSocksTimeout);
3247 3:
3248 begin
3249 x := RecvByte(FSocksTimeout);
3250 if FLastError <> 0 then
3251 Exit;
3252 s := char(x) + RecvBufferStr(x, FSocksTimeout);
3253 end;
3254 4:
3255 s := RecvBufferStr(16, FSocksTimeout);
3256 else
3257 Exit;
3258 end;
3259 Buf := Buf + s + RecvBufferStr(2, FSocksTimeout);
3260 if FLastError <> 0 then
3261 Exit;
3262 FSocksLastError := Ord(Buf[2]);
3263 end;
3264 if ((FSocksLastError <> 0) and (FSocksLastError <> 90)) then
3265 Exit;
3266 SocksDecode(Buf);
3267 Result := True;
3268 finally
3269 FBypassFlag := False;
3270 end;
3271end;
3272
3273function TSocksBlockSocket.SocksCode(IP, Port: string): Ansistring;
3274var
3275 ip6: TIp6Bytes;
3276 n: integer;
3277begin
3278 if FSocksType <> ST_Socks5 then
3279 begin
3280 Result := CodeInt(ResolvePort(Port));
3281 if not FSocksResolver then
3282 IP := ResolveName(IP);
3283 if IsIP(IP) then
3284 begin
3285 Result := Result + IPToID(IP);
3286 Result := Result + FSocksUsername + #0;
3287 end
3288 else
3289 begin
3290 Result := Result + IPToID('0.0.0.1');
3291 Result := Result + FSocksUsername + #0;
3292 Result := Result + IP + #0;
3293 end;
3294 end
3295 else
3296 begin
3297 if not FSocksResolver then
3298 IP := ResolveName(IP);
3299 if IsIP(IP) then
3300 Result := #1 + IPToID(IP)
3301 else
3302 if IsIP6(IP) then
3303 begin
3304 ip6 := StrToIP6(IP);
3305 Result := #4;
3306 for n := 0 to 15 do
3307 Result := Result + char(ip6[n]);
3308 end
3309 else
3310 Result := #3 + char(Length(IP)) + IP;
3311 Result := Result + CodeInt(ResolvePort(Port));
3312 end;
3313end;
3314
3315function TSocksBlockSocket.SocksDecode(Value: Ansistring): integer;
3316var
3317 Atyp: Byte;
3318 y, n: integer;
3319 w: Word;
3320 ip6: TIp6Bytes;
3321begin
3322 FSocksResponsePort := '0';
3323 Result := 0;
3324 if FSocksType <> ST_Socks5 then
3325 begin
3326 if Length(Value) < 8 then
3327 Exit;
3328 Result := 3;
3329 w := DecodeInt(Value, Result);
3330 FSocksResponsePort := IntToStr(w);
3331 FSocksResponseIP := Format('%d.%d.%d.%d',
3332 [Ord(Value[5]), Ord(Value[6]), Ord(Value[7]), Ord(Value[8])]);
3333 Result := 9;
3334 end
3335 else
3336 begin
3337 if Length(Value) < 4 then
3338 Exit;
3339 Atyp := Ord(Value[4]);
3340 Result := 5;
3341 case Atyp of
3342 1:
3343 begin
3344 if Length(Value) < 10 then
3345 Exit;
3346 FSocksResponseIP := Format('%d.%d.%d.%d',
3347 [Ord(Value[5]), Ord(Value[6]), Ord(Value[7]), Ord(Value[8])]);
3348 Result := 9;
3349 end;
3350 3:
3351 begin
3352 y := Ord(Value[5]);
3353 if Length(Value) < (5 + y + 2) then
3354 Exit;
3355 for n := 6 to 6 + y - 1 do
3356 FSocksResponseIP := FSocksResponseIP + Value[n];
3357 Result := 5 + y + 1;
3358 end;
3359 4:
3360 begin
3361 if Length(Value) < 22 then
3362 Exit;
3363 for n := 0 to 15 do
3364 ip6[n] := ord(Value[n + 5]);
3365 FSocksResponseIP := IP6ToStr(ip6);
3366 Result := 21;
3367 end;
3368 else
3369 Exit;
3370 end;
3371 w := DecodeInt(Value, Result);
3372 FSocksResponsePort := IntToStr(w);
3373 Result := Result + 2;
3374 end;
3375end;
3376
3377{======================================================================}
3378
3379procedure TDgramBlockSocket.Connect(IP, Port: string);
3380begin
3381 SetRemoteSin(IP, Port);
3382 InternalCreateSocket(FRemoteSin);
3383 FBuffer := '';
3384 DoStatus(HR_Connect, IP + ':' + Port);
3385end;
3386
3387function TDgramBlockSocket.RecvBuffer(Buffer: TMemory; Length: Integer): Integer;
3388begin
3389 Result := RecvBufferFrom(Buffer, Length);
3390end;
3391
3392function TDgramBlockSocket.SendBuffer(Buffer: TMemory; Length: Integer): Integer;
3393begin
3394 Result := SendBufferTo(Buffer, Length);
3395end;
3396
3397{======================================================================}
3398
3399destructor TUDPBlockSocket.Destroy;
3400begin
3401 if Assigned(FSocksControlSock) then
3402 FSocksControlSock.Free;
3403 inherited;
3404end;
3405
3406procedure TUDPBlockSocket.EnableBroadcast(Value: Boolean);
3407var
3408 d: TSynaOption;
3409begin
3410 d := TSynaOption.Create;
3411 d.Option := SOT_Broadcast;
3412 d.Enabled := Value;
3413 DelayedOption(d);
3414end;
3415
3416function TUDPBlockSocket.UdpAssociation: Boolean;
3417var
3418 b: Boolean;
3419begin
3420 Result := True;
3421 FUsingSocks := False;
3422 if FSocksIP <> '' then
3423 begin
3424 Result := False;
3425 if not Assigned(FSocksControlSock) then
3426 FSocksControlSock := TTCPBlockSocket.Create;
3427 FSocksControlSock.CloseSocket;
3428 FSocksControlSock.CreateSocketByName(FSocksIP);
3429 FSocksControlSock.Connect(FSocksIP, FSocksPort);
3430 if FSocksControlSock.LastError <> 0 then
3431 Exit;
3432 // if not assigned local port, assign it!
3433 if not FBinded then
3434 Bind(cAnyHost, cAnyPort);
3435 //open control TCP connection to SOCKS
3436 FSocksControlSock.FSocksUsername := FSocksUsername;
3437 FSocksControlSock.FSocksPassword := FSocksPassword;
3438 b := FSocksControlSock.SocksOpen;
3439 if b then
3440 b := FSocksControlSock.SocksRequest(3, GetLocalSinIP, IntToStr(GetLocalSinPort));
3441 if b then
3442 b := FSocksControlSock.SocksResponse;
3443 if not b and (FLastError = 0) then
3444 FLastError := WSANO_RECOVERY;
3445 FUsingSocks :=FSocksControlSock.UsingSocks;
3446 FSocksRemoteIP := FSocksControlSock.FSocksResponseIP;
3447 FSocksRemotePort := FSocksControlSock.FSocksResponsePort;
3448 Result := b and (FLastError = 0);
3449 end;
3450end;
3451
3452function TUDPBlockSocket.SendBufferTo(Buffer: TMemory; Length: Integer): Integer;
3453var
3454 SIp: string;
3455 SPort: integer;
3456 Buf: Ansistring;
3457begin
3458 Result := 0;
3459 FUsingSocks := False;
3460 if (FSocksIP <> '') and (not UdpAssociation) then
3461 FLastError := WSANO_RECOVERY
3462 else
3463 begin
3464 if FUsingSocks then
3465 begin
3466{$IFNDEF CIL}
3467 Sip := GetRemoteSinIp;
3468 SPort := GetRemoteSinPort;
3469 SetRemoteSin(FSocksRemoteIP, FSocksRemotePort);
3470 SetLength(Buf,Length);
3471 Move(Buffer^, Pointer(Buf)^, Length);
3472 Buf := #0 + #0 + #0 + SocksCode(Sip, IntToStr(SPort)) + Buf;
3473 Result := inherited SendBufferTo(Pointer(Buf), System.Length(buf));
3474 SetRemoteSin(Sip, IntToStr(SPort));
3475{$ENDIF}
3476 end
3477 else
3478 Result := inherited SendBufferTo(Buffer, Length);
3479 end;
3480end;
3481
3482function TUDPBlockSocket.RecvBufferFrom(Buffer: TMemory; Length: Integer): Integer;
3483var
3484 Buf: Ansistring;
3485 x: integer;
3486begin
3487 Result := inherited RecvBufferFrom(Buffer, Length);
3488 if FUsingSocks then
3489 begin
3490{$IFNDEF CIL}
3491 SetLength(Buf, Result);
3492 Move(Buffer^, Pointer(Buf)^, Result);
3493 x := SocksDecode(Buf);
3494 Result := Result - x + 1;
3495 Buf := Copy(Buf, x, Result);
3496 Move(Pointer(Buf)^, Buffer^, Result);
3497 SetRemoteSin(FSocksResponseIP, FSocksResponsePort);
3498{$ENDIF}
3499 end;
3500end;
3501
3502{$IFNDEF CIL}
3503procedure TUDPBlockSocket.AddMulticast(MCastIP: string);
3504var
3505 Multicast: TIP_mreq;
3506 Multicast6: TIPv6_mreq;
3507 n: integer;
3508 ip6: Tip6bytes;
3509begin
3510 if FIP6Used then
3511 begin
3512 ip6 := StrToIp6(MCastIP);
3513 for n := 0 to 15 do
3514 Multicast6.ipv6mr_multiaddr.u6_addr8[n] := Ip6[n];
3515 Multicast6.ipv6mr_interface := 0;
3516 SockCheck(synsock.SetSockOpt(FSocket, IPPROTO_IPV6, IPV6_JOIN_GROUP,
3517 PAnsiChar(@Multicast6), SizeOf(Multicast6)));
3518 end
3519 else
3520 begin
3521 Multicast.imr_multiaddr.S_addr := swapbytes(strtoip(MCastIP));
3522 Multicast.imr_interface.S_addr := INADDR_ANY;
3523 SockCheck(synsock.SetSockOpt(FSocket, IPPROTO_IP, IP_ADD_MEMBERSHIP,
3524 PAnsiChar(@Multicast), SizeOf(Multicast)));
3525 end;
3526 ExceptCheck;
3527end;
3528
3529procedure TUDPBlockSocket.DropMulticast(MCastIP: string);
3530var
3531 Multicast: TIP_mreq;
3532 Multicast6: TIPv6_mreq;
3533 n: integer;
3534 ip6: Tip6bytes;
3535begin
3536 if FIP6Used then
3537 begin
3538 ip6 := StrToIp6(MCastIP);
3539 for n := 0 to 15 do
3540 Multicast6.ipv6mr_multiaddr.u6_addr8[n] := Ip6[n];
3541 Multicast6.ipv6mr_interface := 0;
3542 SockCheck(synsock.SetSockOpt(FSocket, IPPROTO_IPV6, IPV6_LEAVE_GROUP,
3543 PAnsiChar(@Multicast6), SizeOf(Multicast6)));
3544 end
3545 else
3546 begin
3547 Multicast.imr_multiaddr.S_addr := swapbytes(strtoip(MCastIP));
3548 Multicast.imr_interface.S_addr := INADDR_ANY;
3549 SockCheck(synsock.SetSockOpt(FSocket, IPPROTO_IP, IP_DROP_MEMBERSHIP,
3550 PAnsiChar(@Multicast), SizeOf(Multicast)));
3551 end;
3552 ExceptCheck;
3553end;
3554{$ENDIF}
3555
3556procedure TUDPBlockSocket.SetMulticastTTL(TTL: integer);
3557var
3558 d: TSynaOption;
3559begin
3560 d := TSynaOption.Create;
3561 d.Option := SOT_MulticastTTL;
3562 d.Value := TTL;
3563 DelayedOption(d);
3564end;
3565
3566function TUDPBlockSocket.GetMulticastTTL:integer;
3567var
3568 l: Integer;
3569begin
3570{$IFNDEF CIL}
3571 l := SizeOf(Result);
3572 if FIP6Used then
3573 synsock.GetSockOpt(FSocket, IPPROTO_IPV6, IPV6_MULTICAST_HOPS, @Result, l)
3574 else
3575 synsock.GetSockOpt(FSocket, IPPROTO_IP, IP_MULTICAST_TTL, @Result, l);
3576{$ENDIF}
3577end;
3578
3579procedure TUDPBlockSocket.EnableMulticastLoop(Value: Boolean);
3580var
3581 d: TSynaOption;
3582begin
3583 d := TSynaOption.Create;
3584 d.Option := SOT_MulticastLoop;
3585 d.Enabled := Value;
3586 DelayedOption(d);
3587end;
3588
3589function TUDPBlockSocket.GetSocketType: integer;
3590begin
3591 Result := integer(SOCK_DGRAM);
3592end;
3593
3594function TUDPBlockSocket.GetSocketProtocol: integer;
3595begin
3596 Result := integer(IPPROTO_UDP);
3597end;
3598
3599{======================================================================}
3600constructor TTCPBlockSocket.CreateWithSSL(SSLPlugin: TSSLClass);
3601begin
3602 inherited Create;
3603 FSSL := SSLPlugin.Create(self);
3604 FHTTPTunnelIP := '';
3605 FHTTPTunnelPort := '';
3606 FHTTPTunnel := False;
3607 FHTTPTunnelRemoteIP := '';
3608 FHTTPTunnelRemotePort := '';
3609 FHTTPTunnelUser := '';
3610 FHTTPTunnelPass := '';
3611 FHTTPTunnelTimeout := 30000;
3612end;
3613
3614constructor TTCPBlockSocket.Create;
3615begin
3616 CreateWithSSL(SSLImplementation);
3617end;
3618
3619destructor TTCPBlockSocket.Destroy;
3620begin
3621 inherited Destroy;
3622 FSSL.Free;
3623end;
3624
3625function TTCPBlockSocket.GetErrorDescEx: string;
3626begin
3627 Result := inherited GetErrorDescEx;
3628 if (FLastError = WSASYSNOTREADY) and (self.SSL.LastError <> 0) then
3629 begin
3630 Result := self.SSL.LastErrorDesc;
3631 end;
3632end;
3633
3634procedure TTCPBlockSocket.CloseSocket;
3635begin
3636 if FSSL.SSLEnabled then
3637 FSSL.Shutdown;
3638 if (FSocket <> INVALID_SOCKET) and (FLastError = 0) then
3639 begin
3640 Synsock.Shutdown(FSocket, 1);
3641 Purge;
3642 end;
3643 inherited CloseSocket;
3644end;
3645
3646procedure TTCPBlockSocket.DoAfterConnect;
3647begin
3648 if assigned(OnAfterConnect) then
3649 begin
3650 OnAfterConnect(Self);
3651 end;
3652end;
3653
3654function TTCPBlockSocket.WaitingData: Integer;
3655begin
3656 Result := 0;
3657 if FSSL.SSLEnabled and (FSocket <> INVALID_SOCKET) then
3658 Result := FSSL.WaitingData;
3659 if Result = 0 then
3660 Result := inherited WaitingData;
3661end;
3662
3663procedure TTCPBlockSocket.Listen;
3664var
3665 b: Boolean;
3666 Sip,SPort: string;
3667begin
3668 if FSocksIP = '' then
3669 begin
3670 SockCheck(synsock.Listen(FSocket, SOMAXCONN));
3671 GetSins;
3672 end
3673 else
3674 begin
3675 Sip := GetLocalSinIP;
3676 if Sip = cAnyHost then
3677 Sip := LocalName;
3678 SPort := IntToStr(GetLocalSinPort);
3679 inherited Connect(FSocksIP, FSocksPort);
3680 b := SocksOpen;
3681 if b then
3682 b := SocksRequest(2, Sip, SPort);
3683 if b then
3684 b := SocksResponse;
3685 if not b and (FLastError = 0) then
3686 FLastError := WSANO_RECOVERY;
3687 FSocksLocalIP := FSocksResponseIP;
3688 if FSocksLocalIP = cAnyHost then
3689 FSocksLocalIP := FSocksIP;
3690 FSocksLocalPort := FSocksResponsePort;
3691 FSocksRemoteIP := '';
3692 FSocksRemotePort := '';
3693 end;
3694 ExceptCheck;
3695 DoStatus(HR_Listen, '');
3696end;
3697
3698function TTCPBlockSocket.Accept: TSocket;
3699begin
3700 if FUsingSocks then
3701 begin
3702 if not SocksResponse and (FLastError = 0) then
3703 FLastError := WSANO_RECOVERY;
3704 FSocksRemoteIP := FSocksResponseIP;
3705 FSocksRemotePort := FSocksResponsePort;
3706 Result := FSocket;
3707 end
3708 else
3709 begin
3710 Result := synsock.Accept(FSocket, FRemoteSin);
3711/// SockCheck(Result);
3712 end;
3713 ExceptCheck;
3714 DoStatus(HR_Accept, '');
3715end;
3716
3717procedure TTCPBlockSocket.Connect(IP, Port: string);
3718begin
3719 if FSocksIP <> '' then
3720 SocksDoConnect(IP, Port)
3721 else
3722 if FHTTPTunnelIP <> '' then
3723 HTTPTunnelDoConnect(IP, Port)
3724 else
3725 inherited Connect(IP, Port);
3726 if FLasterror = 0 then
3727 DoAfterConnect;
3728end;
3729
3730procedure TTCPBlockSocket.SocksDoConnect(IP, Port: string);
3731var
3732 b: Boolean;
3733begin
3734 inherited Connect(FSocksIP, FSocksPort);
3735 if FLastError = 0 then
3736 begin
3737 b := SocksOpen;
3738 if b then
3739 b := SocksRequest(1, IP, Port);
3740 if b then
3741 b := SocksResponse;
3742 if not b and (FLastError = 0) then
3743 FLastError := WSASYSNOTREADY;
3744 FSocksLocalIP := FSocksResponseIP;
3745 FSocksLocalPort := FSocksResponsePort;
3746 FSocksRemoteIP := IP;
3747 FSocksRemotePort := Port;
3748 end;
3749 ExceptCheck;
3750 DoStatus(HR_Connect, IP + ':' + Port);
3751end;
3752
3753procedure TTCPBlockSocket.HTTPTunnelDoConnect(IP, Port: string);
3754//bugfixed by Mike Green (mgreen@emixode.com)
3755var
3756 s: string;
3757begin
3758 Port := IntToStr(ResolvePort(Port));
3759 inherited Connect(FHTTPTunnelIP, FHTTPTunnelPort);
3760 if FLastError <> 0 then
3761 Exit;
3762 FHTTPTunnel := False;
3763 if IsIP6(IP) then
3764 IP := '[' + IP + ']';
3765 SendString('CONNECT ' + IP + ':' + Port + ' HTTP/1.0' + CRLF);
3766 if FHTTPTunnelUser <> '' then
3767 Sendstring('Proxy-Authorization: Basic ' +
3768 EncodeBase64(FHTTPTunnelUser + ':' + FHTTPTunnelPass) + CRLF);
3769 SendString(CRLF);
3770 repeat
3771 s := RecvTerminated(FHTTPTunnelTimeout, #$0a);
3772 if FLastError <> 0 then
3773 Break;
3774 if (Pos('HTTP/', s) = 1) and (Length(s) > 11) then
3775 FHTTPTunnel := s[10] = '2';
3776 until (s = '') or (s = #$0d);
3777 if (FLasterror = 0) and not FHTTPTunnel then
3778 FLastError := WSASYSNOTREADY;
3779 FHTTPTunnelRemoteIP := IP;
3780 FHTTPTunnelRemotePort := Port;
3781 ExceptCheck;
3782end;
3783
3784procedure TTCPBlockSocket.SSLDoConnect;
3785begin
3786 ResetLastError;
3787 if not FSSL.Connect then
3788 FLastError := WSASYSNOTREADY;
3789 ExceptCheck;
3790end;
3791
3792procedure TTCPBlockSocket.SSLDoShutdown;
3793begin
3794 ResetLastError;
3795 FSSL.BiShutdown;
3796end;
3797
3798function TTCPBlockSocket.GetLocalSinIP: string;
3799begin
3800 if FUsingSocks then
3801 Result := FSocksLocalIP
3802 else
3803 Result := inherited GetLocalSinIP;
3804end;
3805
3806function TTCPBlockSocket.GetRemoteSinIP: string;
3807begin
3808 if FUsingSocks then
3809 Result := FSocksRemoteIP
3810 else
3811 if FHTTPTunnel then
3812 Result := FHTTPTunnelRemoteIP
3813 else
3814 Result := inherited GetRemoteSinIP;
3815end;
3816
3817function TTCPBlockSocket.GetLocalSinPort: Integer;
3818begin
3819 if FUsingSocks then
3820 Result := StrToIntDef(FSocksLocalPort, 0)
3821 else
3822 Result := inherited GetLocalSinPort;
3823end;
3824
3825function TTCPBlockSocket.GetRemoteSinPort: Integer;
3826begin
3827 if FUsingSocks then
3828 Result := ResolvePort(FSocksRemotePort)
3829 else
3830 if FHTTPTunnel then
3831 Result := StrToIntDef(FHTTPTunnelRemotePort, 0)
3832 else
3833 Result := inherited GetRemoteSinPort;
3834end;
3835
3836function TTCPBlockSocket.RecvBuffer(Buffer: TMemory; Len: Integer): Integer;
3837begin
3838 if FSSL.SSLEnabled then
3839 begin
3840 Result := 0;
3841 if TestStopFlag then
3842 Exit;
3843 ResetLastError;
3844 LimitBandwidth(Len, FMaxRecvBandwidth, FNextRecv);
3845 Result := FSSL.RecvBuffer(Buffer, Len);
3846 if FSSL.LastError <> 0 then
3847 FLastError := WSASYSNOTREADY;
3848 ExceptCheck;
3849 Inc(FRecvCounter, Result);
3850 DoStatus(HR_ReadCount, IntToStr(Result));
3851 DoMonitor(False, Buffer, Result);
3852 DoReadFilter(Buffer, Result);
3853 end
3854 else
3855 Result := inherited RecvBuffer(Buffer, Len);
3856end;
3857
3858function TTCPBlockSocket.SendBuffer(Buffer: TMemory; Length: Integer): Integer;
3859var
3860 x, y: integer;
3861 l, r: integer;
3862{$IFNDEF CIL}
3863 p: Pointer;
3864{$ENDIF}
3865begin
3866 if FSSL.SSLEnabled then
3867 begin
3868 Result := 0;
3869 if TestStopFlag then
3870 Exit;
3871 ResetLastError;
3872 DoMonitor(True, Buffer, Length);
3873{$IFDEF CIL}
3874 Result := FSSL.SendBuffer(Buffer, Length);
3875 if FSSL.LastError <> 0 then
3876 FLastError := WSASYSNOTREADY;
3877 Inc(FSendCounter, Result);
3878 DoStatus(HR_WriteCount, IntToStr(Result));
3879{$ELSE}
3880 l := Length;
3881 x := 0;
3882 while x < l do
3883 begin
3884 y := l - x;
3885 if y > FSendMaxChunk then
3886 y := FSendMaxChunk;
3887 if y > 0 then
3888 begin
3889 LimitBandwidth(y, FMaxSendBandwidth, FNextsend);
3890 p := IncPoint(Buffer, x);
3891 r := FSSL.SendBuffer(p, y);
3892 if FSSL.LastError <> 0 then
3893 FLastError := WSASYSNOTREADY;
3894 if Flasterror <> 0 then
3895 Break;
3896 Inc(x, r);
3897 Inc(Result, r);
3898 Inc(FSendCounter, r);
3899 DoStatus(HR_WriteCount, IntToStr(r));
3900 end
3901 else
3902 break;
3903 end;
3904{$ENDIF}
3905 ExceptCheck;
3906 end
3907 else
3908 Result := inherited SendBuffer(Buffer, Length);
3909end;
3910
3911function TTCPBlockSocket.SSLAcceptConnection: Boolean;
3912begin
3913 ResetLastError;
3914 if not FSSL.Accept then
3915 FLastError := WSASYSNOTREADY;
3916 ExceptCheck;
3917 Result := FLastError = 0;
3918end;
3919
3920function TTCPBlockSocket.GetSocketType: integer;
3921begin
3922 Result := integer(SOCK_STREAM);
3923end;
3924
3925function TTCPBlockSocket.GetSocketProtocol: integer;
3926begin
3927 Result := integer(IPPROTO_TCP);
3928end;
3929
3930{======================================================================}
3931
3932function TICMPBlockSocket.GetSocketType: integer;
3933begin
3934 Result := integer(SOCK_RAW);
3935end;
3936
3937function TICMPBlockSocket.GetSocketProtocol: integer;
3938begin
3939 if FIP6Used then
3940 Result := integer(IPPROTO_ICMPV6)
3941 else
3942 Result := integer(IPPROTO_ICMP);
3943end;
3944
3945{======================================================================}
3946
3947function TRAWBlockSocket.GetSocketType: integer;
3948begin
3949 Result := integer(SOCK_RAW);
3950end;
3951
3952function TRAWBlockSocket.GetSocketProtocol: integer;
3953begin
3954 Result := integer(IPPROTO_RAW);
3955end;
3956
3957{======================================================================}
3958
3959constructor TSynaClient.Create;
3960begin
3961 inherited Create;
3962 FIPInterface := cAnyHost;
3963 FTargetHost := cLocalhost;
3964 FTargetPort := cAnyPort;
3965 FTimeout := 5000;
3966 FUsername := '';
3967 FPassword := '';
3968end;
3969
3970{======================================================================}
3971
3972constructor TCustomSSL.Create(const Value: TTCPBlockSocket);
3973begin
3974 inherited Create;
3975 FSocket := Value;
3976 FSSLEnabled := False;
3977 FUsername := '';
3978 FPassword := '';
3979 FLastError := 0;
3980 FLastErrorDesc := '';
3981 FVerifyCert := False;
3982 FSSLType := LT_all;
3983 FKeyPassword := '';
3984 FCiphers := '';
3985 FCertificateFile := '';
3986 FPrivateKeyFile := '';
3987 FCertCAFile := '';
3988 FCertCA := '';
3989 FTrustCertificate := '';
3990 FTrustCertificateFile := '';
3991 FCertificate := '';
3992 FPrivateKey := '';
3993 FPFX := '';
3994 FPFXfile := '';
3995 FSSHChannelType := '';
3996 FSSHChannelArg1 := '';
3997 FSSHChannelArg2 := '';
3998end;
3999
4000procedure TCustomSSL.Assign(const Value: TCustomSSL);
4001begin
4002 FUsername := Value.Username;
4003 FPassword := Value.Password;
4004 FVerifyCert := Value.VerifyCert;
4005 FSSLType := Value.SSLType;
4006 FKeyPassword := Value.KeyPassword;
4007 FCiphers := Value.Ciphers;
4008 FCertificateFile := Value.CertificateFile;
4009 FPrivateKeyFile := Value.PrivateKeyFile;
4010 FCertCAFile := Value.CertCAFile;
4011 FCertCA := Value.CertCA;
4012 FTrustCertificate := Value.TrustCertificate;
4013 FTrustCertificateFile := Value.TrustCertificateFile;
4014 FCertificate := Value.Certificate;
4015 FPrivateKey := Value.PrivateKey;
4016 FPFX := Value.PFX;
4017 FPFXfile := Value.PFXfile;
4018end;
4019
4020procedure TCustomSSL.ReturnError;
4021begin
4022 FLastError := -1;
4023 FLastErrorDesc := 'SSL/TLS support is not compiled!';
4024end;
4025
4026function TCustomSSL.LibVersion: String;
4027begin
4028 Result := '';
4029end;
4030
4031function TCustomSSL.LibName: String;
4032begin
4033 Result := '';
4034end;
4035
4036function TCustomSSL.CreateSelfSignedCert(Host: string): Boolean;
4037begin
4038 Result := False;
4039end;
4040
4041function TCustomSSL.Connect: boolean;
4042begin
4043 ReturnError;
4044 Result := False;
4045end;
4046
4047function TCustomSSL.Accept: boolean;
4048begin
4049 ReturnError;
4050 Result := False;
4051end;
4052
4053function TCustomSSL.Shutdown: boolean;
4054begin
4055 ReturnError;
4056 Result := False;
4057end;
4058
4059function TCustomSSL.BiShutdown: boolean;
4060begin
4061 ReturnError;
4062 Result := False;
4063end;
4064
4065function TCustomSSL.SendBuffer(Buffer: TMemory; Len: Integer): Integer;
4066begin
4067 ReturnError;
4068 Result := integer(SOCKET_ERROR);
4069end;
4070
4071function TCustomSSL.RecvBuffer(Buffer: TMemory; Len: Integer): Integer;
4072begin
4073 ReturnError;
4074 Result := integer(SOCKET_ERROR);
4075end;
4076
4077function TCustomSSL.WaitingData: Integer;
4078begin
4079 ReturnError;
4080 Result := 0;
4081end;
4082
4083function TCustomSSL.GetSSLVersion: string;
4084begin
4085 Result := '';
4086end;
4087
4088function TCustomSSL.GetPeerSubject: string;
4089begin
4090 Result := '';
4091end;
4092
4093function TCustomSSL.GetPeerName: string;
4094begin
4095 Result := '';
4096end;
4097
4098function TCustomSSL.GetPeerIssuer: string;
4099begin
4100 Result := '';
4101end;
4102
4103function TCustomSSL.GetPeerFingerprint: string;
4104begin
4105 Result := '';
4106end;
4107
4108function TCustomSSL.GetCertInfo: string;
4109begin
4110 Result := '';
4111end;
4112
4113function TCustomSSL.GetCipherName: string;
4114begin
4115 Result := '';
4116end;
4117
4118function TCustomSSL.GetCipherBits: integer;
4119begin
4120 Result := 0;
4121end;
4122
4123function TCustomSSL.GetCipherAlgBits: integer;
4124begin
4125 Result := 0;
4126end;
4127
4128function TCustomSSL.GetVerifyCert: integer;
4129begin
4130 Result := 1;
4131end;
4132
4133{======================================================================}
4134
4135function TSSLNone.LibVersion: String;
4136begin
4137 Result := 'Without SSL support';
4138end;
4139
4140function TSSLNone.LibName: String;
4141begin
4142 Result := 'ssl_none';
4143end;
4144
4145{======================================================================}
4146
4147{$IFDEF ONCEWINSOCK}
4148initialization
4149begin
4150 if not InitSocketInterface(DLLStackName) then
4151 begin
4152 e := ESynapseError.Create('Error loading Socket interface (' + DLLStackName + ')!');
4153 e.ErrorCode := 0;
4154 e.ErrorMessage := 'Error loading Socket interface (' + DLLStackName + ')!';
4155 raise e;
4156 end;
4157 synsock.WSAStartup(WinsockLevel, WsaDataOnce);
4158end;
4159{$ENDIF}
4160
4161finalization
4162begin
4163{$IFDEF ONCEWINSOCK}
4164 synsock.WSACleanup;
4165 DestroySocketInterface;
4166{$ENDIF}
4167end;
4168
4169end.
Note: See TracBrowser for help on using the repository browser.