📄 wsocket_rtc.pas
字号:
{
"WinSock components" - Copyright (c) Danijel Tkalcec
@html(<br>)
Based on: [
ICS by Fran鏾is PIETTE
francois.piette(at)overbyte.be http://www.overbyte.be
francois.piette(at)rtfm.be http://www.rtfm.be/fpiette
francois.piette(at)pophost.eunet.be
Copyright (C) 1996-2004 by Fran鏾is PIETTE
Rue de Grady 24, 4053 Embourg, Belgium. Fax: +32-4-365.74.56
<francois.piette(at)overbyte.be> ]
@exclude
}
{$INCLUDE rtcDefs.inc}
{$IFDEF FPC}
{$PACKRECORDS 1}
{$ENDIF}
unit WSocket_rtc;
{$H+}
{$IFDEF FPC}
{$B-} { Enable partial boolean evaluation }
{$T-} { Untyped pointers }
{$X+} { Enable extended syntax }
{$ENDIF}
interface
uses
rtcTrashcan,
{$IFNDEF FPC}
Messages,
{$ENDIF}
Windows,
Classes, SysUtils,
memXList,
rtcSyncObjs,
rtcLog,
rtcTimer,
rtcSocketPool,
rtcHWndPool,
WSockBuf_rtc,
rtcThrPool;
var
LOG_SOCKET_ERRORS:boolean=False;
LOG_MESSAGE_ERRORS:boolean=False;
LOG_AV_ERRORS:boolean=False;
LOG_EVENT_ERRORS:boolean=False;
const
SD_RECEIVE = 0;
SD_SEND = 1;
SD_BOTH = 2;
TXPROTO_UDP = 'udp';
TXPROTO_TCP = 'tcp';
const
SOCKET_ERROR = -1;
SOCK_STREAM = 1; { stream socket }
SOCK_DGRAM = 2; { datagram socket }
IP_MULTICAST_IF = 2; { set/get IP multicast interface }
IP_MULTICAST_TTL = 3; { set/get IP multicast timetolive }
IP_DEFAULT_MULTICAST_TTL = 1; { normally limit m'casts to 1 hop }
IP_ADD_MEMBERSHIP = 5; { add an IP group membership }
IPPROTO_UDP = 17; { user datagram protocol }
IPPROTO_TCP = 6; { tcp }
IPPROTO_IP = 0; { dummy for IP }
TCP_NODELAY = $0001;
SO_KEEPALIVE = $0008; { keep connections alive }
AF_INET = 2; { internetwork: UDP, TCP, etc. }
PF_INET = AF_INET;
SO_BROADCAST = $0020; { permit sending of broadcast msgs }
SO_LINGER = $0080; { linger on close if data present }
SO_REUSEADDR = $0004; { allow local address reuse }
INADDR_ANY = $00000000;
INADDR_LOOPBACK = $7F000001;
INADDR_BROADCAST = -1;
INADDR_NONE = -1;
WSADESCRIPTION_LEN = 256;
WSASYS_STATUS_LEN = 128;
FD_READ = $01;
FD_WRITE = $02;
FD_OOB = $04;
FD_ACCEPT = $08;
FD_CONNECT = $10;
FD_CLOSE = $20;
{ All Windows Sockets error constants are biased by WSABASEERR from the "normal" }
WSABASEERR = 10000;
{ Windows Sockets definitions of regular Microsoft C error constants }
WSAEINTR = (WSABASEERR+4);
WSAEBADF = (WSABASEERR+9);
WSAEACCES = (WSABASEERR+13);
WSAEFAULT = (WSABASEERR+14);
WSAEINVAL = (WSABASEERR+22);
WSAEMFILE = (WSABASEERR+24);
{ Windows Sockets definitions of regular Berkeley error constants }
WSAEWOULDBLOCK = (WSABASEERR+35);
WSAEINPROGRESS = (WSABASEERR+36);
WSAEALREADY = (WSABASEERR+37);
WSAENOTSOCK = (WSABASEERR+38);
WSAEDESTADDRREQ = (WSABASEERR+39);
WSAEMSGSIZE = (WSABASEERR+40);
WSAEPROTOTYPE = (WSABASEERR+41);
WSAENOPROTOOPT = (WSABASEERR+42);
WSAEPROTONOSUPPORT = (WSABASEERR+43);
WSAESOCKTNOSUPPORT = (WSABASEERR+44);
WSAEOPNOTSUPP = (WSABASEERR+45);
WSAEPFNOSUPPORT = (WSABASEERR+46);
WSAEAFNOSUPPORT = (WSABASEERR+47);
WSAEADDRINUSE = (WSABASEERR+48);
WSAEADDRNOTAVAIL = (WSABASEERR+49);
WSAENETDOWN = (WSABASEERR+50);
WSAENETUNREACH = (WSABASEERR+51);
WSAENETRESET = (WSABASEERR+52);
WSAECONNABORTED = (WSABASEERR+53);
WSAECONNRESET = (WSABASEERR+54);
WSAENOBUFS = (WSABASEERR+55);
WSAEISCONN = (WSABASEERR+56);
WSAENOTCONN = (WSABASEERR+57);
WSAESHUTDOWN = (WSABASEERR+58);
WSAETOOMANYREFS = (WSABASEERR+59);
WSAETIMEDOUT = (WSABASEERR+60);
WSAECONNREFUSED = (WSABASEERR+61);
WSAELOOP = (WSABASEERR+62);
WSAENAMETOOLONG = (WSABASEERR+63);
WSAEHOSTDOWN = (WSABASEERR+64);
WSAEHOSTUNREACH = (WSABASEERR+65);
WSAENOTEMPTY = (WSABASEERR+66);
WSAEPROCLIM = (WSABASEERR+67);
WSAEUSERS = (WSABASEERR+68);
WSAEDQUOT = (WSABASEERR+69);
WSAESTALE = (WSABASEERR+70);
WSAEREMOTE = (WSABASEERR+71);
WSAHOST_NOT_FOUND = (WSABASEERR+1001);
WSAEDISCON = (WSABASEERR+101);
WSASYSNOTREADY = (WSABASEERR+91);
WSAVERNOTSUPPORTED = (WSABASEERR+92);
WSANOTINITIALISED = (WSABASEERR+93);
WSATRY_AGAIN = (WSABASEERR+1002);
WSANO_RECOVERY = (WSABASEERR+1003);
WSANO_DATA = (WSABASEERR+1004);
WSANO_ADDRESS = WSANO_DATA;
SOL_SOCKET = $ffff; {options for socket level }
SO_SNDBUF = $1001; { send buffer size }
SO_RCVBUF = $1002; { receive buffer size }
IOCPARM_MASK = $7f;
IOC_VOID = $20000000;
IOC_OUT = $40000000;
IOC_IN = $80000000;
IOC_INOUT = (IOC_IN or IOC_OUT);
FIONREAD = IOC_OUT or { get # bytes to read }
((Longint(SizeOf(Longint)) and IOCPARM_MASK) shl 16) or
(Longint(Byte('f')) shl 8) or 127;
FIONBIO = IOC_IN or { set/clear non-blocking i/o }
((Longint(SizeOf(Longint)) and IOCPARM_MASK) shl 16) or
(Longint(Byte('f')) shl 8) or 126;
FIOASYNC = IOC_IN or { set/clear async i/o }
((Longint(SizeOf(Longint)) and IOCPARM_MASK) shl 16) or
(Longint(Byte('f')) shl 8) or 125;
type
u_int = integer;
u_char = char;
u_short = word;
u_long = dword;
TSocket = u_int;
SunB = packed record
s_b1, s_b2, s_b3, s_b4: u_char;
end;
SunW = packed record
s_w1, s_w2: u_short;
end;
in_addr = record
case integer of
0: (S_un_b: SunB);
1: (S_un_w: SunW);
2: (S_addr: u_long);
end;
PInAddr = ^TInAddr;
TInAddr = in_addr;
sockaddr_in = packed record
case Integer of
0: (sin_family: u_short;
sin_port: u_short;
sin_addr: TInAddr;
sin_zero: array[0..7] of Char);
1: (sa_family: u_short;
sa_data: array[0..13] of Char)
end;
PSOCKADDR = ^TSockAddr;
TSockAddrIn = sockaddr_in;
TSockAddr = sockaddr_in;
WSAData = packed record // !!! also WSDATA
wVersion: Word;
wHighVersion: Word;
szDescription: array[0..WSADESCRIPTION_LEN] of Char;
szSystemStatus: array[0..WSASYS_STATUS_LEN] of Char;
iMaxSockets: Word;
iMaxUdpDg: Word;
lpVendorInfo: PChar;
end;
TWSAData = WSAData;
PServEnt = ^TServEnt;
servent = packed record
s_name: PChar;
s_aliases: ^PChar;
s_port: Word;
s_proto: PChar;
end;
TServEnt = servent;
PProtoEnt = ^TProtoEnt;
protoent = packed record
p_name: PChar;
p_aliases: ^Pchar;
p_proto: Smallint;
end;
TProtoEnt = protoent;
PHostEnt = ^THostEnt;
hostent = packed record
h_name: PChar;
h_aliases: ^PChar;
h_addrtype: Smallint;
h_length: Smallint;
case Byte of
0: (h_addr_list: ^PChar);
1: (h_addr: ^PChar)
end;
THostEnt = hostent;
PLinger = ^TLinger;
linger = packed record
l_onoff: u_short;
l_linger: u_short;
end;
TLinger = linger;
const
WM_CLOSE_DELAYED = WM_USER + 1;
WM_TSOCKET_CLOSE = WM_USER + 2;
WM_WSOCKET_RELEASE = WM_USER + 3;
WM_ASYNCSELECT_FIRST = WM_USER + 4;
WM_ASYNCSELECT_LAST = WM_ASYNCSELECT_FIRST + RTC_HWND_MSG_CODES - 1;
WSA_WSOCKET_TIMEOUT = 12001;
winsockdll = 'wsock32.dll'; { 32 bits TCP/IP system DLL }
winsocket2 = 'ws2_32.dll'; { 32 bits TCP/IP system DLL version 2}
INVALID_SOCKET = TSocket(NOT(0));
const
WSOCK_PACKET_SIZE=1460;
// Buffer used by WinSock to buffer outgoing data
WSOCK_SEND_BUFFER_SIZE:integer=WSOCK_PACKET_SIZE*44;
// Buffer used by WinSock to buffer incoming data
WSOCK_READ_BUFFER_SIZE:integer=WSOCK_PACKET_SIZE*44;
// Max packet size sent out at once
WSOCK_MAX_SEND_SIZE:integer=WSOCK_PACKET_SIZE*44;
type
TWndMethod = procedure(var Message: TMessage) of object;
EWinSockException = class(Exception);
TBgExceptionEvent = procedure (Sender : TObject;
E : Exception;
var CanClose : Boolean) of object;
TSocketState = (wsInvalidState,
wsOpened, wsBound,
wsConnecting, wsSocksConnected, wsConnected,
wsAccepting, wsListening,
wsClosed);
TSocketProtocol = (spTcp, spUdp);
TSocketLingerOnOff = (wsLingerOff, wsLingerOn, wsLingerNoSet);
TDataReceived = procedure (Sender: TObject; ErrCode: Word) of object;
TDataSent = procedure (Sender: TObject; ErrCode: Word) of object;
TDataOut = procedure (Sender: TObject; Len:Cardinal) of object;
TDataIn = procedure (Sender: TObject; Len:Cardinal) of object;
TSessionAvailable = procedure (Sender: TObject; ErrCode: Word) of object;
TDnsLookupDone = procedure (Sender: TObject; ErrCode: Word) of object;
TChangeState = procedure (Sender: TObject;
OldState, NewState : TSocketState) of object;
TCustomWSocket = class(TComponent)
private
FProtoStr:string;
FProto:integer;
FProtoType:integer;
FMultiThreaded:boolean;
FSrc : TSockAddrIn;
FSrcLen : Integer;
FLastError : Integer;
FWindowHandle : HWND;
FMessageCode : Cardinal;
FHSocket : TSocket;
FASocket : TSocket; { Accepted socket }
FAddrStr : String;
FAddrResolved : Boolean;
FAddrFormat : Integer;
FAddrAssigned : Boolean;
FLocalPortResolved : Boolean;
FPortStr : String;
FPortAssigned : Boolean;
FPortResolved : Boolean;
FPortNum : Integer;
FLocalPortStr : String;
FLocalPortNum : Integer;
FLocalAddr : String; { IP address for local interface to use }
FBufList : TXList;
FBufSize : Integer;
FProtocol : TSocketProtocol;
FListenBacklog : Integer;
bAllSent : Boolean;
FSentOut : Integer;
FSentFlag : Boolean;
FReadyToSend : Boolean;
FDnsLookupHandle : THandle;
FMultiCast : Boolean;
FMultiCastAddrStr : String;
FMultiCastIpTTL : Integer;
FReuseAddr : Boolean;
FState : TSocketState;
FRcvdFlag : Boolean;
FSelectEvent : LongInt;
FOnSessionAvailable : TSessionAvailable;
FOnChangeState : TChangeState;
FOnDataReceived : TDataReceived;
FOnDataSent : TDataSent;
FOnDataOut : TDataOut;
FOnDataIn : TDataIn;
FOnDnsLookupDone : TDnsLookupDone;
FOnError : TNotifyEvent;
FOnBgException : TBgExceptionEvent;
procedure WndProc(var MsgRec: TMessage); virtual;
procedure AllocateSocketHWnd; virtual;
procedure DeallocateSocketHWnd; virtual;
procedure SocketError(sockfunc: string);
procedure WMASyncSelect(var msg: TMessage);
procedure ChangeState(NewState : TSocketState);
procedure TryToSend; virtual;
procedure ASyncReceive(Error : Word);
procedure AssignDefaultValue; virtual;
procedure InternalClose(bShut : Boolean; Error : Word); virtual;
procedure InternalAbort(ErrCode : Word); virtual;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -