/lib/synapse/blcksock.pas
Pascal | 1554 lines | 608 code | 232 blank | 714 comment | 3 complexity | da67418d1d5bb7f4a7681ff185978b47 MD5 | raw file
Large files files are truncated, but you can click here to view the full file
- {==============================================================================|
- | Project : Ararat Synapse | 009.006.000 |
- |==============================================================================|
- | Content: Library base |
- |==============================================================================|
- | Copyright (c)1999-2008, Lukas Gebauer |
- | All rights reserved. |
- | |
- | Redistribution and use in source and binary forms, with or without |
- | modification, are permitted provided that the following conditions are met: |
- | |
- | Redistributions of source code must retain the above copyright notice, this |
- | list of conditions and the following disclaimer. |
- | |
- | Redistributions in binary form must reproduce the above copyright notice, |
- | this list of conditions and the following disclaimer in the documentation |
- | and/or other materials provided with the distribution. |
- | |
- | Neither the name of Lukas Gebauer nor the names of its contributors may |
- | be used to endorse or promote products derived from this software without |
- | specific prior written permission. |
- | |
- | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" |
- | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
- | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
- | ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR |
- | ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
- | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR |
- | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER |
- | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
- | LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
- | OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH |
- | DAMAGE. |
- |==============================================================================|
- | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
- | Portions created by Lukas Gebauer are Copyright (c)1999-2008. |
- | All Rights Reserved. |
- |==============================================================================|
- | Contributor(s): |
- |==============================================================================|
- | History: see HISTORY.HTM from distribution package |
- | (Found at URL: http://www.ararat.cz/synapse/) |
- |==============================================================================}
-
- {
- Special thanks to Gregor Ibic <gregor.ibic@intelicom.si>
- (Intelicom d.o.o., http://www.intelicom.si)
- for good inspiration about SSL programming.
- }
-
- {$DEFINE ONCEWINSOCK}
- {Note about define ONCEWINSOCK:
- If you remove this compiler directive, then socket interface is loaded and
- initialized on constructor of TBlockSocket class for each socket separately.
- Socket interface is used only if your need it.
-
- If you leave this directive here, then socket interface is loaded and
- initialized only once at start of your program! It boost performace on high
- count of created and destroyed sockets. It eliminate possible small resource
- leak on Windows systems too.
- }
-
- //{$DEFINE RAISEEXCEPT}
- {When you enable this define, then is Raiseexcept property is on by default
- }
-
- {:@abstract(Synapse's library core)
-
- Core with implementation basic socket classes.
- }
-
- {$IFDEF FPC}
- {$MODE DELPHI}
- {$ENDIF}
- {$IFDEF VER125}
- {$DEFINE BCB}
- {$ENDIF}
- {$IFDEF BCB}
- {$ObjExportAll On}
- {$ENDIF}
- {$Q-}
- {$H+}
- {$M+}
-
- unit blcksock;
-
- interface
-
- uses
- SysUtils, Classes,
- synafpc,
- synsock, synautil, synacode, synaip
- {$IFDEF CIL}
- ,System.Net
- ,System.Net.Sockets
- ,System.Text
- {$ENDIF}
- ;
-
- const
-
- SynapseRelease = '38';
-
- cLocalhost = '127.0.0.1';
- cAnyHost = '0.0.0.0';
- cBroadcast = '255.255.255.255';
- c6Localhost = '::1';
- c6AnyHost = '::0';
- c6Broadcast = 'ffff::1';
- cAnyPort = '0';
- CR = #$0d;
- LF = #$0a;
- CRLF = CR + LF;
- c64k = 65536;
-
- type
-
- {:@abstract(Exception clas used by Synapse)
- When you enable generating of exceptions, this exception is raised by
- Synapse's units.}
- ESynapseError = class(Exception)
- private
- FErrorCode: Integer;
- FErrorMessage: string;
- published
- {:Code of error. Value depending on used operating system}
- property ErrorCode: Integer read FErrorCode Write FErrorCode;
- {:Human readable description of error.}
- property ErrorMessage: string read FErrorMessage Write FErrorMessage;
- end;
-
- {:Types of OnStatus events}
- THookSocketReason = (
- {:Resolving is begin. Resolved IP and port is in parameter in format like:
- 'localhost.somewhere.com:25'.}
- HR_ResolvingBegin,
- {:Resolving is done. Resolved IP and port is in parameter in format like:
- 'localhost.somewhere.com:25'. It is always same as in HR_ResolvingBegin!}
- HR_ResolvingEnd,
- {:Socket created by CreateSocket method. It reporting Family of created
- socket too!}
- HR_SocketCreate,
- {:Socket closed by CloseSocket method.}
- HR_SocketClose,
- {:Socket binded to IP and Port. Binded IP and Port is in parameter in format
- like: 'localhost.somewhere.com:25'.}
- HR_Bind,
- {:Socket connected to IP and Port. Connected IP and Port is in parameter in
- format like: 'localhost.somewhere.com:25'.}
- HR_Connect,
- {:Called when CanRead method is used with @True result.}
- HR_CanRead,
- {:Called when CanWrite method is used with @True result.}
- HR_CanWrite,
- {:Socket is swithed to Listen mode. (TCP socket only)}
- HR_Listen,
- {:Socket Accepting client connection. (TCP socket only)}
- HR_Accept,
- {:report count of bytes readed from socket. Number is in parameter string.
- If you need is in integer, you must use StrToInt function!}
- HR_ReadCount,
- {:report count of bytes writed to socket. Number is in parameter string. If
- you need is in integer, you must use StrToInt function!}
- HR_WriteCount,
- {:If is limiting of bandwidth on, then this reason is called when sending or
- receiving is stopped for satisfy bandwidth limit. Parameter is count of
- waiting milliseconds.}
- HR_Wait,
- {:report situation where communication error occured. When raiseexcept is
- @true, then exception is called after this Hook reason.}
- HR_Error
- );
-
- {:Procedural type for OnStatus event. Sender is calling TBlockSocket object,
- Reason is one of set Status events and value is optional data.}
- THookSocketStatus = procedure(Sender: TObject; Reason: THookSocketReason;
- const Value: String) of object;
-
- {:This procedural type is used for DataFilter hooks.}
- THookDataFilter = procedure(Sender: TObject; var Value: AnsiString) of object;
-
- {:This procedural type is used for hook OnCreateSocket. By this hook you can
- insert your code after initialisation of socket. (you can set special socket
- options, etc.)}
- THookCreateSocket = procedure(Sender: TObject) of object;
-
- {:This procedural type is used for monitoring of communication.}
- THookMonitor = procedure(Sender: TObject; Writing: Boolean;
- const Buffer: TMemory; Len: Integer) of object;
-
- {:This procedural type is used for hook OnAfterConnect. By this hook you can
- insert your code after TCP socket has been sucessfully connected.}
- THookAfterConnect = procedure(Sender: TObject) of object;
-
- {:This procedural type is used for hook OnHeartbeat. By this hook you can
- call your code repeately during long socket operations.
- You must enable heartbeats by @Link(HeartbeatRate) property!}
- THookHeartbeat = procedure(Sender: TObject) of object;
-
- {:Specify family of socket.}
- TSocketFamily = (
- {:Default mode. Socket family is defined by target address for connection.
- It allows instant access to IPv4 and IPv6 nodes. When you need IPv6 address
- as destination, then is used IPv6 mode. othervise is used IPv4 mode.
- However this mode not working properly with preliminary IPv6 supports!}
- SF_Any,
- {:Turn this class to pure IPv4 mode. This mode is totally compatible with
- previous Synapse releases.}
- SF_IP4,
- {:Turn to only IPv6 mode.}
- SF_IP6
- );
-
- {:specify possible values of SOCKS modes.}
- TSocksType = (
- ST_Socks5,
- ST_Socks4
- );
-
- {:Specify requested SSL/TLS version for secure connection.}
- TSSLType = (
- LT_all,
- LT_SSLv2,
- LT_SSLv3,
- LT_TLSv1,
- LT_TLSv1_1,
- LT_SSHv2
- );
-
- {:Specify type of socket delayed option.}
- TSynaOptionType = (
- SOT_Linger,
- SOT_RecvBuff,
- SOT_SendBuff,
- SOT_NonBlock,
- SOT_RecvTimeout,
- SOT_SendTimeout,
- SOT_Reuse,
- SOT_TTL,
- SOT_Broadcast,
- SOT_MulticastTTL,
- SOT_MulticastLoop
- );
-
- {:@abstract(this object is used for remember delayed socket option set.)}
- TSynaOption = class(TObject)
- public
- Option: TSynaOptionType;
- Enabled: Boolean;
- Value: Integer;
- end;
-
- TCustomSSL = class;
- TSSLClass = class of TCustomSSL;
-
- {:@abstract(Basic IP object.)
- This is parent class for other class with protocol implementations. Do not
- use this class directly! Use @link(TICMPBlockSocket), @link(TRAWBlockSocket),
- @link(TTCPBlockSocket) or @link(TUDPBlockSocket) instead.}
- TBlockSocket = class(TObject)
- private
- FOnStatus: THookSocketStatus;
- FOnReadFilter: THookDataFilter;
- FOnCreateSocket: THookCreateSocket;
- FOnMonitor: THookMonitor;
- FOnHeartbeat: THookHeartbeat;
- FLocalSin: TVarSin;
- FRemoteSin: TVarSin;
- FTag: integer;
- FBuffer: AnsiString;
- FRaiseExcept: Boolean;
- FNonBlockMode: Boolean;
- FMaxLineLength: Integer;
- FMaxSendBandwidth: Integer;
- FNextSend: LongWord;
- FMaxRecvBandwidth: Integer;
- FNextRecv: LongWord;
- FConvertLineEnd: Boolean;
- FLastCR: Boolean;
- FLastLF: Boolean;
- FBinded: Boolean;
- FFamily: TSocketFamily;
- FFamilySave: TSocketFamily;
- FIP6used: Boolean;
- FPreferIP4: Boolean;
- FDelayedOptions: TList;
- FInterPacketTimeout: Boolean;
- {$IFNDEF CIL}
- FFDSet: TFDSet;
- {$ENDIF}
- FRecvCounter: Integer;
- FSendCounter: Integer;
- FSendMaxChunk: Integer;
- FStopFlag: Boolean;
- FNonblockSendTimeout: Integer;
- FHeartbeatRate: integer;
- function GetSizeRecvBuffer: Integer;
- procedure SetSizeRecvBuffer(Size: Integer);
- function GetSizeSendBuffer: Integer;
- procedure SetSizeSendBuffer(Size: Integer);
- procedure SetNonBlockMode(Value: Boolean);
- procedure SetTTL(TTL: integer);
- function GetTTL:integer;
- procedure SetFamily(Value: TSocketFamily); virtual;
- procedure SetSocket(Value: TSocket); virtual;
- function GetWsaData: TWSAData;
- function FamilyToAF(f: TSocketFamily): TAddrFamily;
- protected
- FSocket: TSocket;
- FLastError: Integer;
- FLastErrorDesc: string;
- procedure SetDelayedOption(const Value: TSynaOption);
- procedure DelayedOption(const Value: TSynaOption);
- procedure ProcessDelayedOptions;
- procedure InternalCreateSocket(Sin: TVarSin);
- procedure SetSin(var Sin: TVarSin; IP, Port: string);
- function GetSinIP(Sin: TVarSin): string;
- function GetSinPort(Sin: TVarSin): Integer;
- procedure DoStatus(Reason: THookSocketReason; const Value: string);
- procedure DoReadFilter(Buffer: TMemory; var Len: Integer);
- procedure DoMonitor(Writing: Boolean; const Buffer: TMemory; Len: Integer);
- procedure DoCreateSocket;
- procedure DoHeartbeat;
- procedure LimitBandwidth(Length: Integer; MaxB: integer; var Next: LongWord);
- procedure SetBandwidth(Value: Integer);
- function TestStopFlag: Boolean;
- procedure InternalSendStream(const Stream: TStream; WithSize, Indy: boolean); virtual;
- function InternalCanRead(Timeout: Integer): Boolean; virtual;
- public
- constructor Create;
-
- {:Create object and load all necessary socket library. What library is
- loaded is described by STUB parameter. If STUB is empty string, then is
- loaded default libraries.}
- constructor CreateAlternate(Stub: string);
- destructor Destroy; override;
-
- {:If @link(family) is not SF_Any, then create socket with type defined in
- @link(Family) property. If family is SF_Any, then do nothing! (socket is
- created automaticly when you know what type of socket you need to create.
- (i.e. inside @link(Connect) or @link(Bind) call.) When socket is created,
- then is aplyed all stored delayed socket options.}
- procedure CreateSocket;
-
- {:It create socket. Address resolving of Value tells what type of socket is
- created. If Value is resolved as IPv4 IP, then is created IPv4 socket. If
- value is resolved as IPv6 address, then is created IPv6 socket.}
- procedure CreateSocketByName(const Value: String);
-
- {:Destroy socket in use. This method is also automatically called from
- object destructor.}
- procedure CloseSocket; virtual;
-
- {:Abort any work on Socket and destroy them.}
- procedure AbortSocket; virtual;
-
- {:Connects socket to local IP address and PORT. IP address may be numeric or
- symbolic ('192.168.74.50', 'cosi.nekde.cz', 'ff08::1'). The same for PORT
- - it may be number or mnemonic port ('23', 'telnet').
-
- If port value is '0', system chooses itself and conects unused port in the
- range 1024 to 4096 (this depending by operating system!). Structure
- LocalSin is filled after calling this method.
-
- Note: If you call this on non-created socket, then socket is created
- automaticly.
-
- Warning: when you call : Bind('0.0.0.0','0'); then is nothing done! In this
- case is used implicit system bind instead.}
- procedure Bind(IP, Port: string);
-
- {:Connects socket to remote IP address and PORT. The same rules as with
- @link(BIND) method are valid. The only exception is that PORT with 0 value
- will not be connected!
-
- Structures LocalSin and RemoteSin will be filled with valid values.
-
- When you call this on non-created socket, then socket is created
- automaticly. Type of created socket is by @link(Family) property. If is
- used SF_IP4, then is created socket for IPv4. If is used SF_IP6, then is
- created socket for IPv6. When you have family on SF_Any (default!), then
- type of created socket is determined by address resolving of destination
- address. (Not work properly on prilimitary winsock IPv6 support!)}
- procedure Connect(IP, Port: string); virtual;
-
- {:Sends data of LENGTH from BUFFER address via connected socket. System
- automatically splits data to packets.}
- function SendBuffer(Buffer: Tmemory; Length: Integer): Integer; virtual;
-
- {:One data BYTE is sent via connected socket.}
- procedure SendByte(Data: Byte); virtual;
-
- {:Send data string via connected socket. Any terminator is not added! If you
- need send true string with CR-LF termination, you must add CR-LF characters
- to sended string! Because any termination is not added automaticly, you can
- use this function for sending any binary data in binary string.}
- procedure SendString(Data: AnsiString); virtual;
-
- {:Send integer as four bytes to socket.}
- procedure SendInteger(Data: integer); virtual;
-
- {:Send data as one block to socket. Each block begin with 4 bytes with
- length of data in block. This 4 bytes is added automaticly by this
- function.}
- procedure SendBlock(const Data: AnsiString); virtual;
-
- {:Send data from stream to socket.}
- procedure SendStreamRaw(const Stream: TStream); virtual;
-
- {:Send content of stream to socket. It using @link(SendBlock) method}
- procedure SendStream(const Stream: TStream); virtual;
-
- {:Send content of stream to socket. It using @link(SendBlock) method and
- this is compatible with streams in Indy library.}
- procedure SendStreamIndy(const Stream: TStream); virtual;
-
- {:Note: This is low-level receive function. You must be sure if data is
- waiting for read before call this function for avoid deadlock!
-
- Waits until allocated buffer is filled by received data. Returns number of
- data received, which equals to LENGTH value under normal operation. If it
- is not equal the communication channel is possibly broken.
-
- On stream oriented sockets if is received 0 bytes, it mean 'socket is
- closed!"
-
- On datagram socket is readed first waiting datagram.}
- function RecvBuffer(Buffer: TMemory; Length: Integer): Integer; virtual;
-
- {:Note: This is high-level receive function. It using internal
- @link(LineBuffer) and you can combine this function freely with other
- high-level functions!
-
- Method waits until data is received. If no data is received within TIMEOUT
- (in milliseconds) period, @link(LastError) is set to WSAETIMEDOUT. Methods
- serves for reading any size of data (i.e. one megabyte...). This method is
- preffered for reading from stream sockets (like TCP).}
- function RecvBufferEx(Buffer: Tmemory; Len: Integer;
- Timeout: Integer): Integer; virtual;
-
- {:Similar to @link(RecvBufferEx), but readed data is stored in binary
- string, not in memory buffer.}
- function RecvBufferStr(Len: Integer; Timeout: Integer): AnsiString; virtual;
-
- {:Note: This is high-level receive function. It using internal
- @link(LineBuffer) and you can combine this function freely with other
- high-level functions.
-
- Waits until one data byte is received which is also returned as function
- result. If no data is received within TIMEOUT (in milliseconds)period,
- @link(LastError) is set to WSAETIMEDOUT and result have value 0.}
- function RecvByte(Timeout: Integer): Byte; virtual;
-
- {:Note: This is high-level receive function. It using internal
- @link(LineBuffer) and you can combine this function freely with other
- high-level functions.
-
- Waits until one four bytes are received and return it as one Ineger Value.
- If no data is received within TIMEOUT (in milliseconds)period,
- @link(LastError) is set to WSAETIMEDOUT and result have value 0.}
- function RecvInteger(Timeout: Integer): Integer; virtual;
-
- {:Note: This is high-level receive function. It using internal
- @link(LineBuffer) and you can combine this function freely with other
- high-level functions.
-
- Method waits until data string is received. This string is terminated by
- CR-LF characters. The resulting string is returned without this termination
- (CR-LF)! If @link(ConvertLineEnd) is used, then CR-LF sequence may not be
- exactly CR-LF. See @link(ConvertLineEnd) description. If no data is
- received within TIMEOUT (in milliseconds) period, @link(LastError) is set
- to WSAETIMEDOUT. You may also specify maximum length of reading data by
- @link(MaxLineLength) property.}
- function RecvString(Timeout: Integer): AnsiString; virtual;
-
- {:Note: This is high-level receive function. It using internal
- @link(LineBuffer) and you can combine this function freely with other
- high-level functions.
-
- Method waits until data string is received. This string is terminated by
- Terminator string. The resulting string is returned without this
- termination. If no data is received within TIMEOUT (in milliseconds)
- period, @link(LastError) is set to WSAETIMEDOUT. You may also specify
- maximum length of reading data by @link(MaxLineLength) property.}
- function RecvTerminated(Timeout: Integer; const Terminator: AnsiString): AnsiString; virtual;
-
- {:Note: This is high-level receive function. It using internal
- @link(LineBuffer) and you can combine this function freely with other
- high-level functions.
-
- Method reads all data waiting for read. If no data is received within
- TIMEOUT (in milliseconds) period, @link(LastError) is set to WSAETIMEDOUT.
- Methods serves for reading unknown size of data. Because before call this
- function you don't know size of received data, returned data is stored in
- dynamic size binary string. This method is preffered for reading from
- stream sockets (like TCP). It is very goot for receiving datagrams too!
- (UDP protocol)}
- function RecvPacket(Timeout: Integer): AnsiString; virtual;
-
- {:Read one block of data from socket. Each block begin with 4 bytes with
- length of data in block. This function read first 4 bytes for get lenght,
- then it wait for reported count of bytes.}
- function RecvBlock(Timeout: Integer): AnsiString; virtual;
-
- {:Read all data from socket to stream until socket is closed (or any error
- occured.)}
- procedure RecvStreamRaw(const Stream: TStream; Timeout: Integer); virtual;
- {:Read requested count of bytes from socket to stream.}
- procedure RecvStreamSize(const Stream: TStream; Timeout: Integer; Size: Integer);
-
- {:Receive data to stream. It using @link(RecvBlock) method.}
- procedure RecvStream(const Stream: TStream; Timeout: Integer); virtual;
-
- {:Receive data to stream. This function is compatible with similar function
- in Indy library. It using @link(RecvBlock) method.}
- procedure RecvStreamIndy(const Stream: TStream; Timeout: Integer); virtual;
-
- {:Same as @link(RecvBuffer), but readed data stays in system input buffer.
- Warning: this function not respect data in @link(LineBuffer)! Is not
- recommended to use this function!}
- function PeekBuffer(Buffer: TMemory; Length: Integer): Integer; virtual;
-
- {:Same as @link(RecvByte), but readed data stays in input system buffer.
- Warning: this function not respect data in @link(LineBuffer)! Is not
- recommended to use this function!}
- function PeekByte(Timeout: Integer): Byte; virtual;
-
- {:On stream sockets it returns number of received bytes waiting for picking.
- 0 is returned when there is no such data. On datagram socket it returns
- length of the first waiting datagram. Returns 0 if no datagram is waiting.}
- function WaitingData: Integer; virtual;
-
- {:Same as @link(WaitingData), but if exists some of data in @link(Linebuffer),
- return their length instead.}
- function WaitingDataEx: Integer;
-
- {:Clear all waiting data for read from buffers.}
- procedure Purge;
-
- {:Sets linger. Enabled linger means that the system waits another LINGER
- (in milliseconds) time for delivery of sent data. This function is only for
- stream type of socket! (TCP)}
- procedure SetLinger(Enable: Boolean; Linger: Integer);
-
- {:Actualize values in @link(LocalSin).}
- procedure GetSinLocal;
-
- {:Actualize values in @link(RemoteSin).}
- procedure GetSinRemote;
-
- {:Actualize values in @link(LocalSin) and @link(RemoteSin).}
- procedure GetSins;
-
- {:Reset @link(LastError) and @link(LastErrorDesc) to non-error state.}
- procedure ResetLastError;
-
- {:If you "manually" call Socket API functions, forward their return code as
- parameter to this function, which evaluates it, eventually calls
- GetLastError and found error code returns and stores to @link(LastError).}
- function SockCheck(SockResult: Integer): Integer; virtual;
-
- {:If @link(LastError) contains some error code and @link(RaiseExcept)
- property is @true, raise adequate exception.}
- procedure ExceptCheck;
-
- {:Returns local computer name as numerical or symbolic value. It try get
- fully qualified domain name. Name is returned in the format acceptable by
- functions demanding IP as input parameter.}
- function LocalName: string;
-
- {:Try resolve name to all possible IP address. i.e. If you pass as name
- result of @link(LocalName) method, you get all IP addresses used by local
- system.}
- procedure ResolveNameToIP(Name: string; const IPList: TStrings);
-
- {:Try resolve name to primary IP address. i.e. If you pass as name result of
- @link(LocalName) method, you get primary IP addresses used by local system.}
- function ResolveName(Name: string): string;
-
- {:Try resolve IP to their primary domain name. If IP not have domain name,
- then is returned original IP.}
- function ResolveIPToName(IP: string): string;
-
- {:Try resolve symbolic port name to port number. (i.e. 'Echo' to 8)}
- function ResolvePort(Port: string): Word;
-
- {:Set information about remote side socket. It is good for seting remote
- side for sending UDP packet, etc.}
- procedure SetRemoteSin(IP, Port: string);
-
- {:Picks IP socket address from @link(LocalSin).}
- function GetLocalSinIP: string; virtual;
-
- {:Picks IP socket address from @link(RemoteSin).}
- function GetRemoteSinIP: string; virtual;
-
- {:Picks socket PORT number from @link(LocalSin).}
- function GetLocalSinPort: Integer; virtual;
-
- {:Picks socket PORT number from @link(RemoteSin).}
- function GetRemoteSinPort: Integer; virtual;
-
- {:Return @TRUE, if you can read any data from socket or is incoming
- connection on TCP based socket. Status is tested for time Timeout (in
- milliseconds). If value in Timeout is 0, status is only tested and
- continue. If value in Timeout is -1, run is breaked and waiting for read
- data maybe forever.
-
- This function is need only on special cases, when you need use
- @link(RecvBuffer) function directly! read functioms what have timeout as
- calling parameter, calling this function internally.}
- function CanRead(Timeout: Integer): Boolean; virtual;
-
- {:Same as @link(CanRead), but additionally return @TRUE if is some data in
- @link(LineBuffer).}
- function CanReadEx(Timeout: Integer): Boolean; virtual;
-
- {:Return @TRUE, if you can to socket write any data (not full sending
- buffer). Status is tested for time Timeout (in milliseconds). If value in
- Timeout is 0, status is only tested and continue. If value in Timeout is
- -1, run is breaked and waiting for write data maybe forever.
-
- This function is need only on special cases!}
- function CanWrite(Timeout: Integer): Boolean; virtual;
-
- {:Same as @link(SendBuffer), but send datagram to address from
- @link(RemoteSin). Usefull for sending reply to datagram received by
- function @link(RecvBufferFrom).}
- function SendBufferTo(Buffer: TMemory; Length: Integer): Integer; virtual;
-
- {:Note: This is low-lever receive function. You must be sure if data is
- waiting for read before call this function for avoid deadlock!
-
- Receives first waiting datagram to allocated buffer. If there is no waiting
- one, then waits until one comes. Returns length of datagram stored in
- BUFFER. If length exceeds buffer datagram is truncated. After this
- @link(RemoteSin) structure contains information about sender of UDP packet.}
- function RecvBufferFrom(Buffer: TMemory; Length: Integer): Integer; virtual;
- {$IFNDEF CIL}
- {:This function is for check for incoming data on set of sockets. Whitch
- sockets is checked is decribed by SocketList Tlist with TBlockSocket
- objects. TList may have maximal number of objects defined by FD_SETSIZE
- constant. Return @TRUE, if you can from some socket read any data or is
- incoming connection on TCP based socket. Status is tested for time Timeout
- (in milliseconds). If value in Timeout is 0, status is only tested and
- continue. If value in Timeout is -1, run is breaked and waiting for read
- data maybe forever. If is returned @TRUE, CanReadList TList is filled by all
- TBlockSocket objects what waiting for read.}
- function GroupCanRead(const SocketList: TList; Timeout: Integer;
- const CanReadList: TList): Boolean;
- {$ENDIF}
- {:By this method you may turn address reuse mode for local @link(bind). It
- is good specially for UDP protocol. Using this with TCP protocol is
- hazardous!}
- procedure EnableReuse(Value: Boolean);
-
- {:Try set timeout for all sending and receiving operations, if socket
- provider can do it. (It not supported by all socket providers!)}
- procedure SetTimeout(Timeout: Integer);
-
- {:Try set timeout for all sending operations, if socket provider can do it.
- (It not supported by all socket providers!)}
- procedure SetSendTimeout(Timeout: Integer);
-
- {:Try set timeout for all receiving operations, if socket provider can do
- it. (It not supported by all socket providers!)}
- procedure SetRecvTimeout(Timeout: Integer);
-
- {:Return value of socket type.}
- function GetSocketType: integer; Virtual;
-
- {:Return value of protocol type for socket creation.}
- function GetSocketProtocol: integer; Virtual;
-
- {:WSA structure with information about socket provider. On linux is this
- structure simulated!}
- property WSAData: TWSADATA read GetWsaData;
-
- {:Structure describing local socket side.}
- property LocalSin: TVarSin read FLocalSin write FLocalSin;
-
- {:Structure describing remote socket side.}
- property RemoteSin: TVarSin read FRemoteSin write FRemoteSin;
-
- {:Socket handler. Suitable for "manual" calls to socket API or manual
- connection of socket to a previously created socket (i.e by Accept method
- on TCP socket)}
- property Socket: TSocket read FSocket write SetSocket;
-
- {:Last socket operation error code. Error codes are described in socket
- documentation. Human readable error description is stored in
- @link(LastErrorDesc) property.}
- property LastError: Integer read FLastError;
-
- {:Human readable error description of @link(LastError) code.}
- property LastErrorDesc: string read FLastErrorDesc;
-
- {:Buffer used by all high-level receiving functions. This buffer is used for
- optimized reading of data from socket. In normal cases you not need access
- to this buffer directly!}
- property LineBuffer: AnsiString read FBuffer write FBuffer;
-
- {:Size of Winsock receive buffer. If it is not supported by socket provider,
- it return as size one kilobyte.}
- property SizeRecvBuffer: Integer read GetSizeRecvBuffer write SetSizeRecvBuffer;
-
- {:Size of Winsock send buffer. If it is not supported by socket provider, it
- return as size one kilobyte.}
- property SizeSendBuffer: Integer read GetSizeSendBuffer write SetSizeSendBuffer;
-
- {:If @True, turn class to non-blocking mode. Not all functions are working
- properly in this mode, you must know exactly what you are doing! However
- when you have big experience with non-blocking programming, then you can
- optimise your program by non-block mode!}
- property NonBlockMode: Boolean read FNonBlockMode Write SetNonBlockMode;
-
- {:Set Time-to-live value. (if system supporting it!)}
- property TTL: Integer read GetTTL Write SetTTL;
-
- {:If is @true, then class in in IPv6 mode.}
- property IP6used: Boolean read FIP6used;
-
- {:Return count of received bytes on this socket from begin of current
- connection.}
- property RecvCounter: Integer read FRecvCounter;
-
- {:Return count of sended bytes on this socket from begin of current
- connection.}
- property SendCounter: Integer read FSendCounter;
- published
- {:Return descriptive string for given error code. This is class function.
- You may call it without created object!}
- class function GetErrorDesc(ErrorCode: Integer): string;
-
- {:Return descriptive string for @link(LastError).}
- function GetErrorDescEx: string; virtual;
-
- {:this value is for free use.}
- property Tag: Integer read FTag write FTag;
-
- {:If @true, winsock errors raises exception. Otherwise is setted
- @link(LastError) value only and you must check it from your program! Default
- value is @false.}
- property RaiseExcept: Boolean read FRaiseExcept write FRaiseExcept;
-
- {:Define maximum length in bytes of @link(LineBuffer) for high-level
- receiving functions. If this functions try to read more data then this
- limit, error is returned! If value is 0 (default), no limitation is used.
- This is very good protection for stupid attacks to your server by sending
- lot of data without proper terminator... until all your memory is allocated
- by LineBuffer!
-
- Note: This maximum length is checked only in functions, what read unknown
- number of bytes! (like @link(RecvString) or @link(RecvTerminated))}
- property MaxLineLength: Integer read FMaxLineLength Write FMaxLineLength;
-
- {:Define maximal bandwidth for all sending operations in bytes per second.
- If value is 0 (default), bandwidth limitation is not used.}
- property MaxSendBandwidth: Integer read FMaxSendBandwidth Write FMaxSendBandwidth;
-
- {:Define maximal bandwidth for all receiving operations in bytes per second.
- If value is 0 (default), bandwidth limitation is not used.}
- property MaxRecvBandwidth: Integer read FMaxRecvBandwidth Write FMaxRecvBandwidth;
-
- {:Define maximal bandwidth for all sending and receiving operations in bytes
- per second. If value is 0 (default), bandwidth limitation is not used.}
- property MaxBandwidth: Integer Write SetBandwidth;
-
- {:Do a conversion of non-standard line terminators to CRLF. (Off by default)
- If @True, then terminators like sigle CR, single LF or LFCR are converted
- to CRLF internally. This have effect only in @link(RecvString) method!}
- property ConvertLineEnd: Boolean read FConvertLineEnd Write FConvertLineEnd;
-
- {:Specified Family of this socket. When you are using Windows preliminary
- support for IPv6, then I recommend to set this property!}
- property Family: TSocketFamily read FFamily Write SetFamily;
-
- {:When resolving of domain name return both IPv4 and IPv6 addresses, then
- specify if is used IPv4 (dafault - @true) or IPv6.}
- property PreferIP4: Boolean read FPreferIP4 Write FPreferIP4;
-
- {:By default (@true) is all timeouts used as timeout between two packets in
- reading operations. If you set this to @false, then Timeouts is for overall
- reading operation!}
- property InterPacketTimeout: Boolean read FInterPacketTimeout Write FInterPacketTimeout;
-
- {:All sended datas was splitted by this value.}
- property SendMaxChunk: Integer read FSendMaxChunk Write FSendMaxChunk;
-
- {:By setting this property to @true you can stop any communication. You can
- use this property for soft abort of communication.}
- property StopFlag: Boolean read FStopFlag Write FStopFlag;
-
- {:Timeout for data sending by non-blocking socket mode.}
- property NonblockSendTimeout: Integer read FNonblockSendTimeout Write FNonblockSendTimeout;
-
- {:This event is called by various reasons. It is good for monitoring socket,
- create gauges for data transfers, etc.}
- property OnStatus: THookSocketStatus read FOnStatus write FOnStatus;
-
- {:this event is good for some internal thinks about filtering readed datas.
- It is used by telnet client by example.}
- property OnReadFilter: THookDataFilter read FOnReadFilter write FOnReadFilter;
-
- {:This event is called after real socket creation for setting special socket
- options, because you not know when socket is created. (it is depended on
- Ipv4, IPv6 or automatic mode)}
- property OnCreateSocket: THookCreateSocket read FOnCreateSocket write FOnCreateSocket;
-
- {:This event is good for monitoring content of readed or writed datas.}
- property OnMonitor: THookMonitor read FOnMonitor write FOnMonitor;
-
- {:This event is good for calling your code during long socket operations.
- (Example, for refresing UI if class in not called within the thread.)
- Rate of heartbeats can be modified by @link(HeartbeatRate) property.}
- property OnHeartbeat: THookHeartbeat read FOnHeartbeat write FOnHeartbeat;
-
- {:Specify typical rate of @link(OnHeartbeat) event and @link(StopFlag) testing.
- Default value 0 disabling heartbeats! Value is in milliseconds.
- Real rate can be higher or smaller then this value, because it depending
- on real socket operations too!
- Note: Each heartbeat slowing socket processing.}
- property HeartbeatRate: integer read FHeartbeatRate Write FHeartbeatRate;
- end;
-
- {:@abstract(Support for SOCKS4 and SOCKS5 proxy)
- Layer with definition all necessary properties and functions for
- implementation SOCKS proxy client. Do not use this class directly.}
- TSocksBlockSocket = class(TBlockSocket)
- protected
- FSocksIP: string;
- FSocksPort: string;
- FSocksTimeout: integer;
- FSocksUsername: string;
- FSocksPassword: string;
- FUsingSocks: Boolean;
- FSocksResolver: Boolean;
- FSocksLastError: integer;
- FSocksResponseIP: string;
- FSocksResponsePort: string;
- FSocksLocalIP: string;
- FSocksLocalPort: string;
- FSocksRemoteIP: string;
- FSocksRemotePort: string;
- FBypassFlag: Boolean;
- FSocksType: TSocksType;
- function SocksCode(IP, Port: string): Ansistring;
- function SocksDecode(Value: Ansistring): integer;
- public
- constructor Create;
-
- {:Open connection to SOCKS proxy and if @link(SocksUsername) is set, do
- authorisation to proxy. This is needed only in special cases! (it is called
- internally!)}
- function SocksOpen: Boolean;
-
- {:Send specified request to SOCKS proxy. This is needed only in special
- cases! (it is called internally!)}
- function SocksRequest(Cmd: Byte; const IP, Port: string): Boolean;
-
- {:Receive response to previosly sended request. This is needed only in
- special cases! (it is called internally!)}
- function SocksResponse: Boolean;
-
- {:Is @True when class is using SOCKS proxy.}
- property UsingSocks: Boolean read FUsingSocks;
-
- {:If SOCKS proxy failed, here is error code returned from SOCKS proxy.}
- property SocksLastError: integer read FSocksLastError;
- published
- {:Address of SOCKS server. If value is empty string, SOCKS support is
- disabled. Assingning any value to this property enable SOCKS mode.
- Warning: You cannot combine this mode with HTTP-tunneling mode!}
- property SocksIP: string read FSocksIP write FSocksIP;
-
- {:Port of SOCKS server. Default value is '1080'.}
- property SocksPort: string read FSocksPort write FSocksPort;
-
- {:If you need authorisation on SOCKS server, set username here.}
- property SocksUsername: string read FSocksUsername write FSocksUsername;
-
- {:If you need authorisation on SOCKS server, set password here.}
- property SocksPassword: string read FSocksPassword write FSocksPassword;
-
- {:Specify timeout for communicatin with SOCKS server. Default is one minute.}
- property SocksTimeout: integer read FSocksTimeout write FSocksTimeout;
-
- {:If @True, all symbolic names of target hosts is not translated to IP's
- locally, but resolving is by SOCKS proxy. Default is @True.}
- property SocksResolver: Boolean read FSocksResolver write FSocksResolver;
-
- {:Specify SOCKS type. By default is used SOCKS5, but you can use SOCKS4 too.
- When you select SOCKS4, then if @link(SOCKSResolver) is enabled, then is
- used SOCKS4a. Othervise is used pure SOCKS4.}
- property SocksType: TSocksType read FSocksType write FSocksType;
- end;
-
- {:@abstract(Implementation of TCP socket.)
- Supported features: IPv4, IPv6, SSL/TLS or SSH (depending on used plugin),
- SOCKS5 proxy (outgoing connections and limited incomming), SOCKS4/4a proxy
- (outgoing connections and limited incomming), TCP through HTTP proxy tunnel.}
- TTCPBlockSocket = class(TSocksBlockSocket)
- protected
- FOnAfterConnect: THookAfterConnect;
- FSSL: TCustomSSL;
- FHTTPTunnelIP: string;
- FHTTPTunnelPort: string;
- FHTTPTunnel: Boolean;
- FHTTPTunnelRemoteIP: string;
- FHTTPTunnelRemotePort: string;
- FHTTPTunnelUser: string;
- FHTTPTunnelPass: string;
- FHTTPTunnelTimeout: integer;
- procedure SocksDoConnect(IP, Port: string);
- procedure HTTPTunnelDoConnect(IP, Port: string);
- procedure DoAfterConnect;
- public
- {:Create TCP socket class with default plugin for SSL/TSL/SSH implementation
- (see @link(SSLImplementation))}
- constructor Create;
-
- {:Create TCP socket class with desired plugin for SSL/TSL/SSH implementation}
- constructor CreateWithSSL(SSLPlugin: TSSLClass);
- destructor Destroy; override;
-
- {:Return descriptive string for @link(LastError). On case of error
- in SSL/TLS subsystem, it returns right error description.}
- function GetErrorDescEx: string; override;
-
- {:See @link(TBlockSocket.CloseSocket)}
- procedure CloseSocket; override;
-
- {:See @link(TBlockSocket.WaitingData)}
- function WaitingData: Integer; override;
-
- {:Sets socket to receive mode for new incoming connections. It is necessary
- to use @link(TBlockSocket.BIND) function call before this method to select
- receiving port!
-
- If you use SOCKS, activate incoming TCP connection by this proxy. (By BIND
- method of SOCKS.)}
- procedure Listen; virtual;
-
- {:Waits until new incoming connection comes. After it comes a new socket is
- automatically created (socket handler is returned by this function as
- result).
-
- If you use SOCKS, new socket is not created! In this case is used same
- socket as socket for listening! So, you can accept only one connection in
- SOCKS mode.}
- function Accept: TSocket;
-
- {:Connects socket to remote IP address and PORT. The same rules as with
- @link(TBlockSocket.BIND) method are valid. The only exception is that PORT
- with 0 value will not be connected. After call to this method
- a communication channel between local and remote socket is created. Local
- socket is assigned automatically if not controlled by previous call to
- @link(TBlockSocket.BIND) method. Structures @link(TBlockSocket.LocalSin)
- and @link(TBlockSocket.RemoteSin) will be filled with valid values.
-
- If you use SOCKS, activate outgoing TCP connection by SOCKS proxy specified
- in @link(TSocksBlockSocket.SocksIP). (By CONNECT method of SOCKS.)
-
- If you use HTTP-tunnel mode, activate outgoing TCP connection by HTTP
- tunnel specified in @link(HTTPTunnelIP). (By CONNECT method of HTTP
- protocol.)
-
- Note: If you call this on non-created socket, then socket is created
- automaticly.}
- procedure Connect(IP, Port: string); override;
-
- {:If you need upgrade existing TCP connection to SSL/TLS (or SSH2, if plugin
- allows it) mode, then call this method. This method switch this class to
- SSL mode and do SSL/TSL handshake.}
- procedure SSLDoConnect;
-
- {:By this method you can downgrade existing SSL/TLS connection to normal TCP
- connection.}
- procedure SSLDoShutdown;
-
- {:If you need use this component as SSL/TLS TCP server, then after accepting
- of inbound connection you need start SSL/TLS session by this method. Before
- call this function, you must have assigned all neeeded certificates and
- keys!}
- function SSLAcceptConnection: Boolean;
-
- {:See @link(TBlockSocket.GetLocalSinIP)}
- function GetLocalSinIP: string; override;
-
- {:See @link(TBlockSocket.GetRemoteSinIP)}
- function GetRemoteSinIP: string; override;
-
- {:See @link(TBlockSocket.GetLocalSinPort)}
- function GetLocalSinPort: Integer; override;
-
- {:See @link(TBlockSocket.GetRemoteSinPort)}
- function GetRemoteSinPort: Integer; override;
-
- {:See @link(TBlockSocket.SendBuffer)}
- function SendBuffer(Buffer: TMemory; Length: Integer): Integer; override;
-
- {:See @link(TBlockSocket.RecvBuffer)}
- function RecvBuffer(Buffer: TMemory; Len: Integer): Integer; override;
-
- {:Return value of socket type. For TCP return SOCK_STREAM.}
- function GetSocketType: integer; override;
-
- {:Return value of protocol type for socket creation. For TCP return
- IPPROTO_TCP.}
- function GetSocketProtocol: integer; override;
-
- {:Class implementing SSL/TLS support. It is allways some descendant
- of @link(TCustomSSL) class. When programmer not select some SSL plugin
- class, then is used @link(TSSLNone)}
- property SSL: TCustomSSL read FSSL;
-
- {:@True if is used HTTP tunnel mode.}
- property HTTPTunnel: Boolean read FHTTPTunnel;
- published
- {:Specify IP address of HTTP proxy. Assingning non-empty value to this
- property enable HTTP-tunnel mode. This mode is for tunnelling any outgoing
- TCP connection through HTTP proxy server. (If policy on HTTP proxy server
- allow this!) Warning: You cannot combine this mode with SOCK5 mode!}
- property HTTPTunnelIP: string read FHTTPTunnelIP Write FHTTPTunnelIP;
-
- {:Specify port of HTTP proxy for HTTP-tunneling.}
- property HTTPTunnelPort: string read FHTTPTunnelPort Write FHTTPTunnelPort;
-
- {:Specify authorisation username for access to HTTP proxy in HTTP-tunnel
- mode. If you not need authorisation, then let this property empty.}
- property HTTPTunnelUser: string read FHTTPTunnelUser Write FHTTPTunnelUser;
-
- {:Specify authorisation password for access to HTTP proxy in HTTP-tunnel
- mode.}
- property HTTPTunnelPass: string read FHTTPTunnelPass Write FHTTPTunnelPass;
-
- {:Specify timeout for communication with HTTP proxy in HTTPtunnel mode.}
- property HTTPTunnelTimeout: integer read FHTTPTunnelTimeout Write FHTTPTunnelTimeout;
-
- {:This event is called after sucessful TCP socket connection.}
- property OnAfterConnect: THookAfterConnect read FOnAfterConnect write FOnAfterConnect;
- end;
-
- {:@abstract(Datagram based communication)
- This class implementing datagram based communication instead default stream
- based communication style.}
- TDgramBlockSocket = class(TSocksBlockSocket)
- public
- {:Fill @link(TBlockSocket.RemoteSin) structure. This address is used for
- sending data.}
- procedure Connect(IP, Port: string); override;
-
- {:Silently redirected to @link(TBlockSocket.SendBufferTo).}
- function SendBuffer(Buffer: TMemory; Length: Integer): Integer; override;
-
- {:Silently redirected to @link(TBlockSocket.RecvBufferFrom).}
- function RecvBuffer(Buffer: TMemory; Length: Integer): Integer; override;
- end;
-
- {:@abstract(Implementation of UDP socket.)
- NOTE: in this class is all receiving redirected to RecvBufferFrom. You can
- use for reading any receive function. Preffered is RecvPacket! Similary all
- sending is redirected to SendbufferTo. You can use for sending UDP packet any
- sending function, like SendString.
-
- Supported features: IPv4, IPv6, unicasts, broadcasts, multicasts, SOCKS5
- proxy (only unicasts! Outgoing and incomming.)}
- TUDPBlockSocket = class(TDgramBlockSocket)
- protected
- FSocksControlSock: TTCPBlockSocket;
- function UdpAssociation: Boolean;
- procedure SetMulticastTTL(TTL: integer);
- function GetMulticastTTL:integer;
- public
- destructor Destroy; override;
-
- {:Enable or disable sending of broadcasts. If seting OK, result is @true.
- This method is not supported in SOCKS5 mode! IPv6 does not support
- broadcasts! In this case you must use Multicasts instead.}
- procedure EnableBroadcast(Value: Boolean);
-
- {:See @link(TBlockSocket.SendBufferTo)}
- function SendBufferTo(Buffer: TMemory; Length: Integer): Integer; override;
-
- {:See @link(TBlockSocket.RecvBufferFrom)}
- function RecvBufferFrom(Buffer: TMemory; Length: Integer): Integer; override;
- {$IFNDEF CIL}
- {:Add this socket to given multicast group. You cannot use Multicasts in
- SOCKS mode!}
- procedure AddMulticast(MCastIP:string);
-
- {:Remove this socket from given multicast group.}
- procedure DropMulticast(MCastIP:string);
- {$ENDIF}
- {:All sended multicast datagrams is loopbacked to your interface too. (you
- can read your sended datas.) You can disable this feature by this function.
- This function not working on some Windows systems!}
- procedure EnableMulticastLoop(Value: Boolean);
-
- {:Return value of socket type. For UDP return SOCK_DGRAM.}
- function GetSocketType: integer; override;
-
- {:Return value of protocol type for socket creation. For UDP return
- IPPROTO_UDP.}
- function GetSocketProtocol: integer; override;
-
- {:Set Time-to-live value for multicasts packets. It define number of routers
- for transfer of datas. If you set this to 1 (dafault s…
Large files files are truncated, but you can click here to view the full file