{==============================================================================|
| Project : Delphree - Synapse | 003.001.000 |
|==============================================================================|
| Content: Library base |
|==============================================================================|
| The contents of this file are subject to the Mozilla Public License Ver. 1.0 |
| (the "License"); you may not use this file except in compliance with the |
| License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ |
| |
| Software distributed under the License is distributed on an "AS IS" basis, |
| WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for |
| the specific language governing rights and limitations under the License. |
|==============================================================================|
| The Original Code is Synapse Delphi Library. |
|==============================================================================|
| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
| Portions created by Lukas Gebauer are Copyright (c)1999,2000,2001. |
| All Rights Reserved. |
|==============================================================================|
| Contributor(s): |
|==============================================================================|
| History: see HISTORY.HTM from distribution package |
| (Found at URL: http://www.ararat.cz/synapse/) |
|==============================================================================|
| Modified by CyberAlien@europe.com to fit SlavaNap project requirements. |
|==============================================================================}
unit blcksock;
interface
uses
synsock, SysUtils, classes,
{$IFDEF LINUX}
libc, kernelioctl;
{$ELSE}
winsock, windows;
{$ENDIF}
type
ESynapseError = class (Exception)
Public
ErrorCode:integer;
ErrorMessage:string;
end;
{TBlockSocket}
TBlockSocket = class (TObject)
Protected
FSocket:TSocket;
FLocalSin:TSockAddrIn;
FRemoteSin:TSockAddrIn;
FLastError:integer;
FProtocol:integer;
procedure SetSin (var sin:TSockAddrIn;ip,port:string);
function GetSinIP (sin:TSockAddrIn):string;
function GetSinPort (sin:TSockAddrIn):integer;
procedure SetSocket(Value: TSocket);
public
// FWsaData : TWSADATA;
Tag: Integer;
constructor Create;
destructor Destroy; override;
Procedure CreateSocket; virtual;
Procedure CloseSocket;
procedure Bind(ip,port:string);
procedure Connect(ip,port:string);
function SendBuffer(buffer:pointer;length:integer):integer; virtual;
procedure SendByte(data:byte); virtual;
procedure SendString(data:string); virtual;
function RecvBuffer(buffer:pointer;length:integer):integer; virtual;
function RecvByte(timeout:integer):byte; virtual;
function PeekBuffer(buffer:pointer;length:integer):integer; virtual;
function PeekByte(timeout:integer):byte; virtual;
function WaitingData:integer;
procedure SetLinger(enable:boolean;Linger:integer);
procedure GetSins;
function SockCheck(SockResult:integer):integer;
function LocalName:string;
procedure ResolveNameToIP(Name:string;IPlist:TStringlist);
function GetLocalSinIP:string;
function GetRemoteSinIP:string;
function GetLocalSinPort:integer;
function GetRemoteSinPort:integer;
function CanRead(Timeout:integer):boolean;
function CanWrite(Timeout:integer):boolean;
function SendBufferTo(buffer:pointer;length:integer):integer;
function RecvBufferFrom(buffer:pointer;length:integer):integer;
function GetSizeRecvBuffer:integer;
procedure SetSizeRecvBuffer(size:integer);
function GetSizeSendBuffer:integer;
procedure SetSizeSendBuffer(size:integer);
function SetTimeout(receive, send: Integer): Boolean; // requires Winsock2 (Win98 has to be updated)
property LocalSin:TSockAddrIn read FLocalSin;
property RemoteSin:TSockAddrIn read FRemoteSin;
published
property socket:TSocket read FSocket write SetSocket;
property LastError:integer read FLastError;
property Protocol:integer read FProtocol;
property SizeRecvBuffer:integer read GetSizeRecvBuffer write SetSizeRecvBuffer;
property SizeSendBuffer:integer read GetSizeSendBuffer write SetSizeSendBuffer;
end;
{TUDPBlockSocket}
TUDPBlockSocket = class (TBlockSocket)
public
procedure CreateSocket; override;
function EnableBroadcast(Value:Boolean):Boolean;
end;
{TTCPBlockSocket}
TTCPBlockSocket = class (TBlockSocket)
public
procedure CreateSocket; override;
procedure Listen;
function Accept:TSocket;
end;
function GetErrorDesc(ErrorCode:integer): string;
procedure ResolveNameToIP(Name:string;IPlist:TStringlist);
var
FWsaData : TWSADATA;
sockets_count: Integer;
// for debug:
count_blocksock,
count_blocksock_max: Integer;
implementation
{TBlockSocket.Create}
constructor TBlockSocket.Create;
begin
inherited create;
Tag:=0;
FSocket:=INVALID_SOCKET;
FProtocol:=IPPROTO_IP;
inc(count_blocksock);
if count_blocksock>count_blocksock_max then
count_blocksock_max:=count_blocksock;
end;
{TBlockSocket.Destroy}
destructor TBlockSocket.Destroy;
begin
CloseSocket;
dec(count_blocksock);
inherited destroy;
end;
{TBlockSocket.SetSin}
procedure TBlockSocket.SetSin (var sin:TSockAddrIn;ip,port:string);
var
ProtoEnt: PProtoEnt;
ServEnt: PServEnt;
HostEnt: PHostEnt;
begin
FillChar(sin,Sizeof(sin),0);
sin.sin_family := AF_INET;
ProtoEnt:= synsock.getprotobynumber(FProtocol);
ServEnt:=nil;
If ProtoEnt <> nil then
ServEnt:= synsock.getservbyname(PChar(port), ProtoEnt^.p_name);
if ServEnt = nil then
Sin.sin_port:= synsock.htons(StrToIntDef(Port,0))
else
Sin.sin_port:= ServEnt^.s_port;
if ip='255.255.255.255'
then Sin.sin_addr.s_addr:=u_long(INADDR_BROADCAST)
else
begin
Sin.sin_addr.s_addr:= synsock.inet_addr(PChar(ip));
if SIn.sin_addr.s_addr = u_long(INADDR_NONE) then
begin
HostEnt:= synsock.gethostbyname(PChar(ip));
if HostEnt <> nil then
SIn.sin_addr.S_addr:= longint(plongint(HostEnt^.h_addr_list^)^);
end;
end;
end;
{TBlockSocket.GetSinIP}
function TBlockSocket.GetSinIP (sin:TSockAddrIn):string;
var
p:pchar;
begin
p:=synsock.inet_ntoa(Sin.sin_addr);
if p=nil then result:=''
else result:=p;
end;
{TBlockSocket.GetSinPort}
function TBlockSocket.GetSinPort (sin:TSockAddrIn):integer;
begin
result:=synsock.ntohs(Sin.sin_port);
end;
procedure TBlockSocket.SetSocket(Value: TSocket);
begin
if FSocket=INVALID_SOCKET then
begin
FSocket:=Value;
if Value<>INVALID_SOCKET then inc(sockets_count);
end
else
begin
FSocket:=Value;
if Value=INVALID_SOCKET then dec(sockets_count);
end;
end;
{TBlockSocket.CreateSocket}
Procedure TBlockSocket.CreateSocket;
begin
if FSocket=INVALID_SOCKET then FLastError:=synsock.WSAGetLastError
else FLastError:=0;
end;
{TBlockSocket.CloseSocket}
Procedure TBlockSocket.CloseSocket;
begin
if FSocket<>INVALID_SOCKET then
begin
synsock.CloseSocket(FSocket);
dec(sockets_count);
end;
FSocket:=INVALID_SOCKET;
end;
{TBlockSocket.Bind}
procedure TBlockSocket.Bind(ip,port:string);
var
sin:TSockAddrIn;
len:integer;
begin
SetSin(sin,ip,port);
SockCheck(synsock.bind(FSocket,sin,sizeof(sin)));
len:=sizeof(FLocalSin);
synsock.GetSockName(FSocket,FLocalSin,Len);
end;
{TBlockSocket.Connect}
procedure TBlockSocket.Connect(ip,port:string);
var
sin:TSockAddrIn;
begin
SetSin(sin,ip,port);
SockCheck(synsock.connect(FSocket,sin,sizeof(sin)));
GetSins;
end;
{TBlockSocket.GetSins}
procedure TBlockSocket.GetSins;
var
len:integer;
begin
len:=sizeof(FLocalSin);
synsock.GetSockName(FSocket,FLocalSin,Len);
len:=sizeof(FRemoteSin);
synsock.GetPeerName(FSocket,FremoteSin,Len);
end;
{TBlockSocket.SendBuffer}
function TBlockSocket.SendBuffer(buffer:pointer;length:integer):integer;
begin
Result := synsock.Send(FSocket, Buffer^, Length, 0);
SockCheck(Result);
end;
{TBlockSocket.SendByte}
procedure TBlockSocket.SendByte(data:byte);
begin
sockcheck(synsock.send(FSocket,data,1,0));
end;
{TBlockSocket.SendString}
procedure TBlockSocket.SendString(data:string);
begin
SendBuffer(PChar(Data), Length(Data));
end;
{TBlockSocket.RecvBuffer}
function TBlockSocket.RecvBuffer(buffer:pointer;length:integer):integer;
begin
Result := synsock.Recv(FSocket, Buffer^, Length, 0);
if Result = 0 then
FLastError := WSAENOTCONN
else
SockCheck(Result);
end;
{TBlockSocket.RecvByte}
function TBlockSocket.RecvByte(timeout:integer):byte;
var
y:integer;
data:byte;
begin
data:=0;
result:=0;
if CanRead(timeout) then
begin
y:=synsock.recv(FSocket,data,1,0);
if y=0 then FLastError:=WSAENOTCONN
else sockcheck(y);
result:=data;
end
else FLastError:=WSAETIMEDOUT;
end;
{TBlockSocket.PeekBuffer}
function TBlockSocket.PeekBuffer(buffer:pointer;length:integer):integer;
begin
result:=synsock.recv(FSocket,buffer^,length,MSG_PEEK);
sockcheck(result);
end;
{TBlockSocket.PeekByte}
function TBlockSocket.PeekByte(timeout:integer):byte;
var
y:integer;
data:byte;
begin
data:=0;
result:=0;
if CanRead(timeout) then
begin
y:=synsock.recv(FSocket,data,1,MSG_PEEK);
if y=0 then FLastError:=WSAENOTCONN;
sockcheck(y);
result:=data;
end
else FLastError:=WSAETIMEDOUT;
end;
{TBlockSocket.SockCheck}
function TBlockSocket.SockCheck(SockResult:integer):integer;
begin
if SockResult=SOCKET_ERROR then result:=synsock.WSAGetLastError
else result:=0;
FLastError:=result;
end;
{TBlockSocket.WaitingData}
function TBlockSocket.WaitingData:integer;
var
x:integer;
begin
synsock.ioctlsocket(FSocket,FIONREAD,u_long(x));
result:=x;
end;
{TBlockSocket.SetLinger}
procedure TBlockSocket.SetLinger(enable:boolean;Linger:integer);
var
li:TLinger;
begin
li.l_onoff := ord(enable);
li.l_linger := Linger div 1000;
SockCheck(synsock.SetSockOpt(FSocket, SOL_SOCKET, SO_LINGER, @li, SizeOf(li)));
end;
{TBlockSocket.LocalName}
function TBlockSocket.LocalName:string;
var
buf:array[0..255] of char;
Pbuf:pchar;
RemoteHost:PHostEnt;
begin
pbuf:=buf;
result:='';
synsock.gethostname(pbuf,255);
if pbuf<>'' then
begin
//try get Fully Qualified Domain Name
RemoteHost:=synsock.GetHostByName(pbuf);
if remoteHost<>nil then
result:=pchar(RemoteHost^.h_name);
end;
if result='' then result:='127.0.0.1';
end;
{TBlockSocket.ResolveNameToIP}
procedure TBlockSocket.ResolveNameToIP(Name:string;IPlist:TStringlist);
type
TaPInAddr = Array[0..250] of PInAddr;
PaPInAddr = ^TaPInAddr;
var
RemoteHost:PHostEnt;
IP:u_long;
PAdrPtr:PaPInAddr;
i:integer;
s:string;
InAddr:TInAddr;
begin
IPList.Clear;
IP := synsock.inet_addr(PChar(name));
if IP = u_long(INADDR_NONE)
then
begin
RemoteHost:=synsock.gethostbyname(PChar(name));
if RemoteHost <> nil then
begin
PAdrPtr:=PAPInAddr(remoteHost^.h_addr_list);
i:=0;
while PAdrPtr^[i]<>nil do
begin
InAddr:=PAdrPtr^[i]^;
with InAddr.S_un_b do
s:=IntToStr(Ord(s_b1))+'.'+IntToStr(Ord(s_b2))+'.'
+IntToStr(Ord(s_b3))+'.'+IntToStr(Ord(s_b4));
IPList.Add(s);
Inc(i);
end;
end;
end
else IPList.Add(name);
end;
{TBlockSocket.GetLocalSinIP}
function TBlockSocket.GetLocalSinIP:string;
begin
result:=GetSinIP(FLocalSin);
end;
{TBlockSocket.GetRemoteSinIP}
function TBlockSocket.GetRemoteSinIP:string;
begin
result:=GetSinIP(FRemoteSin);
end;
{TBlockSocket.GetLocalSinPort}
function TBlockSocket.GetLocalSinPort:integer;
begin
result:=GetSinPort(FLocalSin);
end;
{TBlockSocket.GetRemoteSinPort}
function TBlockSocket.GetRemoteSinPort:integer;
begin
result:=GetSinPort(FRemoteSin);
end;
{TBlockSocket.CanRead}
function TBlockSocket.CanRead(Timeout:integer):boolean;
var
FDSet:TFDSet;
TimeVal:PTimeVal;
TimeV:tTimeval;
x:integer;
begin
Timev.tv_usec:=(Timeout mod 1000)*1000;
Timev.tv_sec:=Timeout div 1000;
TimeVal:=@TimeV;
if timeout = -1 then Timeval:=nil;
FD_Zero(FDSet);
FD_Set(FSocket,FDSet);
x:=synsock.Select(FSocket+1,@FDSet,nil,nil,TimeVal);
SockCheck(x);
If FLastError<>0 then x:=0;
result:=x>0;
end;
{TBlockSocket.CanWrite}
function TBlockSocket.CanWrite(Timeout:integer):boolean;
var
FDSet:TFDSet;
TimeVal:PTimeVal;
TimeV:tTimeval;
x:integer;
begin
Timev.tv_usec:=(Timeout mod 1000)*1000;
Timev.tv_sec:=Timeout div 1000;
TimeVal:=@TimeV;
if timeout = -1 then Timeval:=nil;
FD_Zero(FDSet);
FD_Set(FSocket,FDSet);
x:=synsock.Select(FSocket+1,nil,@FDSet,nil,TimeVal);
SockCheck(x);
If FLastError<>0 then x:=0;
result:=x>0;
end;
{TBlockSocket.SendBufferTo}
function TBlockSocket.SendBufferTo(buffer:pointer;length:integer):integer;
var
len:integer;
begin
len:=sizeof(FRemoteSin);
result:=synsock.sendto(FSocket,buffer^,length,0,FRemoteSin,len);
sockcheck(result);
end;
{TBlockSocket.RecvBufferFrom}
function TBlockSocket.RecvBufferFrom(buffer:pointer;length:integer):integer;
var
len:integer;
begin
len:=sizeof(FRemoteSin);
result:=synsock.recvfrom(FSocket,buffer^,length,0,FRemoteSin,len);
sockcheck(result);
end;
{TBlockSocket.GetSizeRecvBuffer}
function TBlockSocket.GetSizeRecvBuffer:integer;
var
l:integer;
begin
l:=SizeOf(result);
SockCheck(synsock.getSockOpt(FSocket, SOL_SOCKET, SO_RCVBUF, @result, l));
if Flasterror<>0
then result:=1024;
end;
{TBlockSocket.SetSizeRecvBuffer}
procedure TBlockSocket.SetSizeRecvBuffer(size:integer);
begin
SockCheck(synsock.SetSockOpt(FSocket, SOL_SOCKET, SO_RCVBUF, @size, SizeOf(size)));
end;
{TBlockSocket.GetSizeSendBuffer}
function TBlockSocket.GetSizeSendBuffer:integer;
var
l:integer;
begin
l:=SizeOf(result);
SockCheck(synsock.getSockOpt(FSocket, SOL_SOCKET, SO_SNDBUF, @result, l));
if Flasterror<>0
then result:=1024;
end;
{TBlockSocket.SetSizeSendBuffer}
procedure TBlockSocket.SetSizeSendBuffer(size:integer);
begin
SockCheck(synsock.SetSockOpt(FSocket, SOL_SOCKET, SO_SNDBUF, @size, SizeOf(size)));
end;
function TBlockSocket.SetTimeout(receive, send: Integer): Boolean;
begin
// all timeouts are in milliseconds
Result := synsock.SetSockOpt(FSocket, SOL_SOCKET, SO_RCVTIMEO, @receive, SizeOf(receive)) <> SOCKET_ERROR;
Result := Result and (synsock.SetSockOpt(FSocket, SOL_SOCKET, SO_SNDTIMEO, @send, SizeOf(send)) <> SOCKET_ERROR);
end;
{======================================================================}
{TUDPBlockSocket.CreateSocket}
Procedure TUDPBlockSocket.CreateSocket;
begin
FSocket:=synsock.socket(PF_INET,integer(SOCK_DGRAM),IPPROTO_UDP);
FProtocol:=IPPROTO_UDP;
inherited createSocket;
end;
{TUDPBlockSocket.EnableBroadcast}
function TUDPBlockSocket.EnableBroadcast(Value:Boolean):Boolean;
var
Opt:integer;
Res:integer;
begin
opt:=Ord(Value);
Res:=synsock.SetSockOpt(FSocket, SOL_SOCKET, SO_BROADCAST, @opt, SizeOf(opt));
SockCheck(Res);
Result:=res=0;
end;
{======================================================================}
{TTCPBlockSocket.CreateSocket}
Procedure TTCPBlockSocket.CreateSocket;
begin
FSocket:=synsock.socket(PF_INET,integer(SOCK_STREAM),IPPROTO_TCP);
inc(sockets_count);
FProtocol:=IPPROTO_TCP;
inherited createSocket;
end;
{TTCPBlockSocket.Listen}
procedure TTCPBlockSocket.Listen;
begin
SockCheck(synsock.listen(FSocket,SOMAXCONN));
GetSins;
end;
{TTCPBlockSocket.Accept}
function TTCPBlockSocket.Accept:TSocket;
var
len:integer;
begin
len:=sizeof(FRemoteSin);
result:=synsock.accept(FSocket,@FRemoteSin,@len);
SockCheck(result);
end;
{======================================================================}
{GetErrorDesc}
function GetErrorDesc(ErrorCode:integer): string;
begin
case ErrorCode of
0 : Result:= 'OK';
WSAEINTR :{10004} Result:= 'Interrupted system call';
WSAEBADF :{10009} Result:= 'Bad file number';
WSAEACCES :{10013} Result:= 'Permission denied';
WSAEFAULT :{10014} Result:= 'Bad address';
WSAEINVAL :{10022} Result:= 'Invalid argument';
WSAEMFILE :{10024} Result:= 'Too many open files';
WSAEWOULDBLOCK :{10035} Result:= 'Operation would block';
WSAEINPROGRESS :{10036} Result:= 'Operation now in progress';
WSAEALREADY :{10037} Result:= 'Operation already in progress';
WSAENOTSOCK :{10038} Result:= 'Socket operation on nonsocket';
WSAEDESTADDRREQ :{10039} Result:= 'Destination address required';
WSAEMSGSIZE :{10040} Result:= 'Message too long';
WSAEPROTOTYPE :{10041} Result:= 'Protocol wrong type for socket';
WSAENOPROTOOPT :{10042} Result:= 'Protocol not available';
WSAEPROTONOSUPPORT :{10043} Result:= 'Protocol not supported';
WSAESOCKTNOSUPPORT :{10044} Result:= 'Socket not supported';
WSAEOPNOTSUPP :{10045} Result:= 'Operation not supported on socket';
WSAEPFNOSUPPORT :{10046} Result:= 'Protocol family not supported';
WSAEAFNOSUPPORT :{10047} Result:= 'Address family not supported';
WSAEADDRINUSE :{10048} Result:= 'Address already in use';
WSAEADDRNOTAVAIL :{10049} Result:= 'Can''t assign requested address';
WSAENETDOWN :{10050} Result:= 'Network is down';
WSAENETUNREACH :{10051} Result:= 'Network is unreachable';
WSAENETRESET :{10052} Result:= 'Network dropped connection on reset';
WSAECONNABORTED :{10053} Result:= 'Software caused connection abort';
WSAECONNRESET :{10054} Result:= 'Connection reset by peer';
WSAENOBUFS :{10055} Result:= 'No buffer space available';
WSAEISCONN :{10056} Result:= 'Socket is already connected';
WSAENOTCONN :{10057} Result:= 'Socket is not connected';
WSAESHUTDOWN :{10058} Result:= 'Can''t send after socket shutdown';
WSAETOOMANYREFS :{10059} Result:= 'Too many references:can''t splice';
WSAETIMEDOUT :{10060} Result:= 'Connection timed out';
WSAECONNREFUSED :{10061} Result:= 'Connection refused';
WSAELOOP :{10062} Result:= 'Too many levels of symbolic links';
WSAENAMETOOLONG :{10063} Result:= 'File name is too long';
WSAEHOSTDOWN :{10064} Result:= 'Host is down';
WSAEHOSTUNREACH :{10065} Result:= 'No route to host';
WSAENOTEMPTY :{10066} Result:= 'Directory is not empty';
WSAEPROCLIM :{10067} Result:= 'Too many processes';
WSAEUSERS :{10068} Result:= 'Too many users';
WSAEDQUOT :{10069} Result:= 'Disk quota exceeded';
WSAESTALE :{10070} Result:= 'Stale NFS file handle';
WSAEREMOTE :{10071} Result:= 'Too many levels of remote in path';
WSASYSNOTREADY :{10091} Result:= 'Network subsystem is unusable';
WSAVERNOTSUPPORTED :{10092} Result:= 'Winsock DLL cannot support this application';
WSANOTINITIALISED :{10093} Result:= 'Winsock not initialized';
WSAEDISCON :{10101} Result:= 'WSAEDISCON-10101';
WSAHOST_NOT_FOUND :{11001} Result:= 'Host not found';
WSATRY_AGAIN :{11002} Result:= 'Non authoritative - host not found';
WSANO_RECOVERY :{11003} Result:= 'Non recoverable error';
WSANO_DATA :{11004} Result:= 'Valid name, no data record of requested type'
else
Result:= 'Not a Winsock error ('+IntToStr(ErrorCode)+')';
end;
end;
procedure ResolveNameToIP(Name:string;IPlist:TStringlist);
type
TaPInAddr = Array[0..250] of PInAddr;
PaPInAddr = ^TaPInAddr;
var
RemoteHost:PHostEnt;
IP:u_long;
PAdrPtr:PaPInAddr;
i:integer;
s:string;
InAddr:TInAddr;
begin
IPList.Clear;
IP := synsock.inet_addr(PChar(name));
if IP = u_long(INADDR_NONE)
then
begin
RemoteHost:=synsock.gethostbyname(PChar(name));
if RemoteHost <> nil then
begin
PAdrPtr:=PAPInAddr(remoteHost^.h_addr_list);
i:=0;
while PAdrPtr^[i]<>nil do
begin
InAddr:=PAdrPtr^[i]^;
with InAddr.S_un_b do
s:=IntToStr(Ord(s_b1))+'.'+IntToStr(Ord(s_b2))+'.'
+IntToStr(Ord(s_b3))+'.'+IntToStr(Ord(s_b4));
IPList.Add(s);
Inc(i);
end;
end;
end
else IPList.Add(name);
end;
begin
sockets_count:=0;
count_blocksock:=0;
count_blocksock_max:=0;
exit;
asm
db 'Synapse TCP/IP library by Lukas Gebauer',0
end;
end.
