unit WBSockets;
{ This module is based on v3 of SOCKETS.PAS by Gary Desrosiers.
July 1997 version by Eric Engler: englere@smtps.saia.af.mil
This is freeware, please distribute and use widely.
Supports Delphi 1, 2, and 3.
This module requires the accompanying file: WINSK.PAS.
IMPORTANT: Make sure you use the correct .DCR file:
for Delphi 1, copy sock16.dcr to sockets.dcr
for Delphi 2 and 3, copy sock32.dcr to sockets.dcr
}
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, WinSk;
const
{ Define a "User" Windows Message }
{ This is how we receive notification from Windows that the
Async function we executed is now complete. }
WM_ASYNCSELECT = WM_USER + 0;
type
ESocketError = class(Exception);
TDataAvailable = procedure (Sender: TObject; Socket: TSocket) of object;
TDataNeeded = procedure (Sender: TObject; Socket: TSocket) of object;
TSessionClosed = procedure (Sender: TObject; Socket: TSocket) of object;
TSessionAvailable = procedure (Sender: TObject; Socket: TSocket) of object;
TSessionConnected = procedure (Sender: TObject; Socket: TSocket) of object;
TErrorOccurred = procedure (Sender: TObject; Socket: Integer; Error: integer; Msg: string) of object;
TSockets = class(TWinControl)
private
Pse: PServEnt;
pHost: PHostEnt;
pProto: PProtoEnt;
sin: TSockAddrIn;
InitData: TWSAData;
FAuthorized: Boolean;
FPort: String;
FIPAddr: String;
FMSocket: TSocket;
FModeAsync: Boolean;
FTimeout: integer;
FMaximumReceiveLength: integer;
FDataAvailable: TDataAvailable;
FDataNeeded : TDataNeeded;
FSessionClosed: TSessionClosed;
FSessionAvailable: TSessionAvailable;
FSessionConnected: TSessionConnected;
FErrorOccurred: TErrorOccurred;
procedure SetText(Text: string);
function GetText : string;
procedure SetTextOOB(Text: string);
function GetTextOOB : string;
function PeekData : string;
function SocketErrorDesc(error: integer) : string;
procedure SocketError(Socket: TSocket; sockfunc: string; error: integer);
procedure TWMPaint(var msg:TWMPaint); message WM_PAINT;
procedure SetTimeout;
procedure ResetTimeout;
function GetLocalHostName: string;
protected
procedure WMAsyncSelect(var msg: TMessage); message WM_ASYNCSELECT;
procedure WMTimer(var msg: TMessage); message WM_TIMER;
public
FSocket: TSocket;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
{ I'd like to call these methods Connect, Close, Listen, etc but
they would conflict with the WinSock DLL function names! }
procedure SConnect;
procedure SClose;
procedure SListen;
procedure SListenLocal;
procedure SCancelListen;
function SAccept: TSocket;
function SReceive(Socket: TSocket; szBuff: PChar; var rlen: integer)
: integer;
function SSend(Socket: TSocket; szBuff: PChar; var slen: integer)
: integer;
function GetIPAddr(aSocket: TSocket): string;
function GetLocalIPAddr: string;
function GetPort(aSocket: TSocket): string;
function GetPeerIPAddr(aSocket: TSocket): string;
function GetPeerPort(aSocket: TSocket): string;
function GetAsync: Boolean;
procedure SetAsync(flag: Boolean);
property Text: string read GetText
write SetText;
property Authorized: Boolean read FAuthorized
write FAuthorized;
property Peek: string read PeekData;
property OOB: string read GetTextOOB
write SetTextOOB;
property SocketNumber: TSocket read FSocket
write FSocket;
property MasterSocket: TSocket read FMSocket
write FMSocket;
property HostName: string read GetLocalHostName;
published
property MaximumReceiveLength: integer read FMaximumReceiveLength
write FMaximumReceiveLength;
property IPAddr: string read FIPAddr
write FIPAddr;
property Port: string read FPort
write FPort;
property NonBlocking: Boolean read GetAsync
write SetAsync default True;
property Timeout: integer read FTimeout
write FTimeout;
property OnDataAvailable: TDataAvailable read FDataAvailable
write FDataAvailable;
property OnDataNeeded: TDataNeeded read FDataNeeded
write FDataNeeded;
property OnSessionClosed: TSessionClosed read FSessionClosed
write FSessionClosed;
property OnSessionAvailable: TSessionAvailable read FSessionAvailable
write FSessionAvailable;
property OnSessionConnected: TSessionConnected read FSessionConnected
write FSessionConnected;
property OnErrorOccurred: TErrorOccurred read FErrorOccurred
write FErrorOccurred;
end;
procedure Register;
var
longzero: DWORD;
implementation
procedure Register;
begin
RegisterComponents('Samples', [TSockets]);
end;
constructor TSockets.Create(AOwner: TComponent);
var
iStatus: integer;
begin
inherited Create(AOwner);
longzero:=0;
FAuthorized := False; { don't allow the use of priviledged ports }
FModeAsync := True; { set to ASYNC mode }
FTimeout := 60; { dflt timeout of 60 seconds }
FMaximumReceiveLength := 8192; { size of our RX buffer }
FSocket := INVALID_SOCKET;
FMSocket := INVALID_SOCKET;
invalidate;
if csDesigning in ComponentState then
exit;
{ Issue the standard Winsock startup - say we need ver 1.1 or higher }
iStatus := WSAStartup($101, InitData);
if iStatus <> 0 then
SocketError(0,'Constructor (WSAStartup)',WSAGetLastError);
end;
destructor TSockets.Destroy;
var
iStatus: integer;
begin
if not (csDesigning in ComponentState) then
begin
iStatus := WSACleanup;
if iStatus < 0 then
SocketError(INVALID_SOCKET,'Destructor (WSACleanup)',WSAGetLastError);
end;
inherited Destroy;
end;
{ This paints the icon on component palette, and on the
developer's form. This isn't used at runtime. }
procedure TSockets.TWMPaint(var msg: TWMPaint);
var
icon: HIcon;
dc: HDC;
begin
if csDesigning in ComponentState then
begin
{ Load the icon as a resource }
icon := LoadIcon(HInstance, MakeIntResource('TSOCKETS'));
dc := GetDC(Handle); { get device context of screen }
Width := 32;
Height := 32;
DrawIcon(dc, 0, 0, icon);
ReleaseDC(Handle, dc);
FreeResource(icon);
end;
ValidateRect(Handle, nil);
end;
{ Return true if we are in the ASYNC mode }
function TSockets.GetAsync: Boolean;
begin
Result := FModeAsync;
end;
{ Pass in "true" to say we want the ASYNC mode }
procedure TSockets.SetAsync(Flag: Boolean);
begin
FModeAsync := Flag;
end;
procedure TSockets.SetText(Text: string);
var
BytesSent: integer;
pBuff: PChar;
begin
pBuff := StrAlloc(Length(Text)+1);
try
StrPCopy(pBuff,Text);
if not FModeAsync then
SetTimeout; { blocking mode }
BytesSent := Send(FSocket, pBuff^, Length(Text),0);
if not FModeAsync then
ResetTimeout; { blocking mode }
if BytesSent < 0 then
SocketError(FSocket,'SetText (Send)', WSAGetLastError);
finally
StrDispose(pBuff);
end;
end;
function TSockets.GetText: string;
var
len: integer;
pBuff: PChar;
begin
if FSocket <> INVALID_SOCKET then
begin
pBuff := StrAlloc(FMaximumReceiveLength);
try
if not FModeAsync then
SetTimeout; { blocking mode }
len := Recv(FSocket, pBuff^, FMaximumReceiveLength, 0);
if not FModeAsync then
ResetTimeout; { blocking mode }
if len < 0 then
SocketError(FSocket, 'GetText (Recv)', WSAGetLastError);
pBuff[len] := Chr(0); { null terminate }
Result := StrPas(pBuff);
finally
StrDispose(pBuff);
end;
end
else
Result := '';
end;
{ NOTE: OOB data is specific to Winsock Stack in use. }
procedure TSockets.SetTextOOB(Text: string);
var
BytesSent: integer;
pBuff: PChar;
begin
pBuff := StrAlloc(Length(Text) + 1);
try
StrPCopy(pBuff, Text);
if not FModeAsync then
SetTimeout; { Blocking mode }
BytesSent := Send(FSocket, pBuff^, Length(Text), MSG_OOB);
if not FModeAsync then
ResetTimeout; { blocking mode }
if BytesSent < 0 then
SocketError(FSocket,'SetTextOOB (Send)',WSAGetLastError);
finally
StrDispose(pBuff);
end;
end;
{ NOTE: OOB data is specific to Winsock Stack in use. }
function TSockets.GetTextOOB: string;
var
len: integer;
pBuff: PChar;
begin
if FSocket <> INVALID_SOCKET then
begin
pBuff := StrAlloc(FMaximumReceiveLength);
try
if not FModeAsync then
SetTimeout; { blocking mode }
len := recv(FSocket,pBuff^,FMaximumReceiveLength,MSG_OOB);
if not FModeAsync then
ResetTimeout; { blocking mode }
if len < 0 then
SocketError(FSocket,'GetTextOOB (Recv)',WSAGetLastError);
Result := StrPas(pBuff);
finally
StrDispose(pBuff);
end;
end
else
Result := '';
end;
function TSockets.PeekData: string;
var
len: integer;
pBuff: PChar;
begin
if FSocket <> INVALID_SOCKET then
begin
pBuff := StrAlloc(FMaximumReceiveLength);
try
if not FModeAsync then
SetTimeout; { blocking mode }
len := Recv(FSocket,pBuff^,FMaximumReceiveLength,MSG_PEEK);
if not FModeAsync then
ResetTimeout; { blocking mode }
if len < 0 then
SocketError(FSocket,'PeekData (Peek)',WSAGetLastError);
Result := StrPas(pBuff);
finally
StrDispose(pBuff);
end;
end
else
Result := '';
end;
{ The port is also called the "socket name" }
function TSockets.GetPort(aSocket: TSocket): string;
var
addr: TSockAddrIn;
addrlen: integer;
begin
addrlen := Sizeof(addr);
{ The following call takes a socket object, and returns
an addr struct, and the length of the address struct. }
GetSockName(aSocket, addr, addrlen);
{ Get the port from the address record,
and convert it to host byte order }
Result := IntToStr(ntohs(addr.sin_port));
end;
function TSockets.GetIPAddr(aSocket: TSocket): string;
var
addr: TSockAddrIn;
addrlen: integer;
szIPAddr: PChar;
begin
addrlen := sizeof(addr);
{ The socket name is the TSockAddrIn structure: IP and port number }
GetSockName(aSocket, addr, addrlen);
{ cvt from network/binary 32 bit IP to ascii format }
szIPAddr := inet_ntoa(addr.sin_addr);
{ cvt to Pascal string }
Result := StrPas(szIPAddr);
end;
function TSockets.GetLocalIPAddr: string;
var
addr: TSockAddrIn;
pHost: PHostEnt;
szHostName: array[0..255] of char;
begin
{ sometimes the hostname will also have domainname }
GetHostName(szHostName, 255); { get what the local computer thinks is his
{ hostname - may not agree with DNS }
pHost := GetHostByName(szHostName); { get the IP - usu DOES agree with DNS }
if pHost = nil then
Result := '127.0.0.1' { return the std loopback address }
else
begin
{ get the 32 bit "network/binary" formatted IP Addr from the add list }
addr.sin_addr.s_addr := longint(pLongInt(pHost^.h_addr_list^)^);
{ cvt to ascii, then to Pascal string }
Result := StrPas(inet_ntoa(addr.sin_addr));
end;
end;
{ Improved version as of 6 Feb 97 }
function TSockets.GetLocalHostName: string;
var
szHostName: array[0..255] of char;
pHost: PHostEnt;
addr: TSockAddrIn;
Paddr: ^TSockAddrIn;
LocalHName: String;
begin
{ sometimes the hostname will also have domainname }
GetHostName(szHostName, 255); { get what the local computer thinks is his
{ hostname - may not agree with DNS }
pHost := GetHostByName(szHostName); { get the HostEnt structure }
if pHost = nil then
Result := 'localhost' { unknown }
else
begin
{ We now have local version of our hostname }
LocalHName := StrPas(pHost^.h_name);
if Length(LocalHName) = 0 then
begin
result := 'localhost'; { unknown }
exit;
end;
{ We're going to extract our local IP (which is normally in
sync with DNS), then we'll get our HostEnt struct from the addr.
This is a form of reverse mapping, and it normally gives us our
address/domain exactly as a distant site would get it from DNS. }
addr.sin_addr.s_addr := longint(pLongInt(pHost^.h_addr_list^)^);
Paddr:= @addr.sin_addr.s_addr;
pHost := GetHostByAddr(pLongInt(Paddr), 4, PF_INET);
if pHost = nil then
Result := LocalHName { the best we can do }
else
{ NOTE: Delphi v1 on Win95 just returns the same thing here
as our local hostname. Delphi v2 will correctly reverse
map to get our "official" DNS hostname. }
Result:= StrPas(pHost^.h_name);
end;
end;
{ Get the port we're connected to at the other end }
function TSockets.GetPeerPort(aSocket: TSocket): string;
var
addr: TSockAddrIn;
addrlen: integer;
begin
addrlen := sizeof(addr);
GetPeerName(aSocket, addr, addrlen);
Result := IntToStr(ntohs(addr.sin_port));
end;
{ Get the IP addr we're connected to at the other end }
function TSockets.GetPeerIPAddr(aSocket: TSocket): string;
var
addr: TSockAddrIn;
addrlen: integer;
szIPAddr: PChar;
begin
addrlen := sizeof(addr);
GetPeerName(aSocket, addr, addrlen);
szIPAddr := inet_ntoa(addr.sin_addr);
Result := StrPas(szIPAddr);
end;
function TSockets.SReceive(Socket: TSocket; szBuff: PChar; var rlen: integer)
: integer;
begin
if Socket <> INVALID_SOCKET then
begin
if not FModeAsync then
SetTimeout; { blocking mode }
Result := recv(Socket,szBuff^,rlen,0);
if not FModeAsync then
ResetTimeout; { blocking mode }
if rlen < 0 then
SocketError(FSocket,'SReceive',WSAGetLastError);
end
else
Result := -1;
end;
function TSockets.SSend(Socket: TSocket; szBuff: PChar; var slen: integer)
: integer;
begin
Result:=0;
if Socket <> INVALID_SOCKET then
begin
if not FModeAsync then
SetTimeout; { blocking mode }
slen := Send(Socket,szBuff^,slen,0);
if not FModeAsync then
ResetTimeout; { blocking mode }
if slen < 0 then
SocketError(FSocket,'SSend',WSAGetLastError);
Result := slen;
end;
end;
procedure TSockets.WMAsyncSelect(var msg: TMessage);
var
err: integer;
errfn: string;
begin
err := WSAGetSelectError(msg.LParam);
if err > WSABASEERR then
begin
case WSAGetSelectEvent(msg.lParam) of
FD_READ: errfn := 'FD_READ';
FD_WRITE: errfn := 'FD_WRITE';
FD_CLOSE: errfn := 'FD_CLOSE';
FD_ACCEPT: errfn := 'FD_ACCEPT';
FD_CONNECT: errfn := 'FD_CONNECT';
end;
SocketError(msg.wParam, errfn, err);
end
else
case WSAGetSelectEvent(msg.lParam) of
FD_READ:
begin
if Assigned(FDataAvailable) then
FDataAvailable(Self,msg.wParam);
end;
FD_WRITE:
begin
if Assigned(FDataNeeded) then
FDataNeeded(Self,msg.wParam);
end;
FD_CLOSE:
begin
if Assigned(FSessionClosed) then
FSessionClosed(Self,msg.wParam);
end;
FD_ACCEPT:
begin
if Assigned(FSessionAvailable) then
FSessionAvailable(Self,msg.wParam);
end;
FD_CONNECT:
begin
if Assigned(FSessionConnected) then
FSessionConnected(Self,msg.wParam);
end;
end; { end case }
end;
procedure TSockets.WMTimer(var msg: TMessage);
begin
KillTimer(Handle,10);
{ if we're waiting for a blocking function, tell Windows to abort it }
if WSAIsBlocking then
begin
{ Blocking Call Timed Out, so we'll cancel it }
WSACancelBlockingCall;
SocketError(FSocket,'WMTimer', WSAGetLastError);
end;
end;
procedure TSockets.SConnect;
var
iStatus: integer;
szTcp: PChar;
szPort: array[0..31] of char;
szData: array[0..256] of char;
bind_sin: TSockAddrIn;
alport: TSocket;
begin
if FPort = '' then
begin
SocketError(FSocket,'SConnect', -1); { No Port Specified }
exit;
end;
if FIPAddr = '' then
begin
SocketError(FSocket,'SConnect', -2); { No IP Addr Specified }
exit;
end;
sin.sin_family := AF_INET; { Internet Addressing }
StrPCopy(szPort, FPort);
szTcp := 'tcp';
Pse := GetServByName(szPort,szTcp);
if Pse = nil then
sin.sin_port := htons(StrToInt(StrPas(szPort)))
else
sin.sin_port := Pse^.s_port;
{ cvt IP format from aaa.xxx.yyy.zzz to 32 bit network/binary format }
StrPCopy(szData, FIPAddr);
sin.sin_addr.s_addr := inet_addr(szData);
if sin.sin_addr.s_addr = INADDR_NONE then
begin
{ the addr didn't convert, so we probably have a hostname, instead }
pHost := GetHostByName(szData);
if pHost = nil then
begin
{ it doesn't seem to be either an IP or a hostname }
SocketError(FSocket,'SConnect',WSAGetLastError);
exit;
end;
sin.sin_addr.S_addr := longint(plongint(pHost^.h_addr_list^)^);
end;
pProto := GetProtoByName(szTcp);
FSocket := Socket(PF_INET, SOCK_STREAM, pProto^.p_proto);
if FSocket < 0 then
SocketError(INVALID_SOCKET,'SConnect (socket)', WSAGetLastError);
if FAuthorized = True then
begin
alport := IPPORT_RESERVED;
bind_sin.sin_family := AF_INET;
bind_sin.sin_addr.s_addr := 0;
repeat
bind_sin.sin_port := htons(alport);
if Bind(FSocket,bind_sin,sizeof(bind_sin)) = 0 then
break;
if WSAGetLastError <> WSAEADDRINUSE then
SocketError(FSocket,'SConnect bind()',WSAGetLastError);
dec(alport);
until(alport <= (IPPORT_RESERVED div 2));
end;
if FModeAsync then
iStatus := WSAAsyncSelect(FSocket,Handle,WM_ASYNCSELECT,
FD_READ or FD_CLOSE or FD_CONNECT or FD_WRITE)
else
iStatus := IoCtlSocket(FSocket, FIONBIO, longzero); { blocking mode }
if iStatus <> 0 then
SocketError(FSocket,'Select',WSAGetLastError);
if not FModeAsync then
SetTimeout; { blocking mode }
{ ***** Here's the actual connect ***** }
iStatus := Connect(FSocket,sin,sizeof(sin));
if not FModeAsync then
ResetTimeout; { blocking mode }
if iStatus <> 0 then
begin
iStatus := WSAGetLastError;
if iStatus <> WSAEWOULDBLOCK then
SocketError(FSocket,'SConnect',WSAGetLastError);
end;
end;
procedure TSockets.SListen;
var
iStatus: integer;
szTcp: PChar;
szPort: array[0..31] of char;
begin
if FPort = '' then
begin
SocketError(FSocket,'SListen', -1); { No Port Specified }
exit;
end;
sin.sin_family := AF_INET;
sin.sin_addr.s_addr := INADDR_ANY;
szTcp := 'tcp';
StrPCopy(szPort, FPort);
Pse := GetServByName(szPort,szTcp);
if Pse = nil then
sin.sin_port := htons(StrToInt(StrPas(szPort)))
else
sin.sin_port := Pse^.s_port;
pProto := GetProtoByName(szTcp);
FMSocket := Socket(PF_INET,SOCK_STREAM,pProto^.p_proto);
if FMSocket < 0 then
SocketError(INVALID_SOCKET,'Socket',WSAGetLastError);
iStatus := Bind(FMSocket, sin, sizeof(sin));
if iStatus <> 0 then
SocketError(FMSocket,'Bind',WSAGetLastError);
iStatus := Listen(FMSocket,5);
if iStatus <> 0 then
SocketError(FMSocket,'Listen',WSAGetLastError);
if FModeAsync then
begin
iStatus := WSAAsyncSelect(FMSocket,Handle,WM_ASYNCSELECT,
FD_READ or FD_WRITE or FD_ACCEPT or FD_CLOSE);
if iStatus <> 0 then
SocketError(FMSocket,'WSAAsyncSelect',WSAGetLastError);
end
else
IoCtlSocket(FMSocket, FIONBIO, longzero); { blocking mode }
end;
// added by BRAiN, listen on local loopback interface only (secure)
procedure TSockets.SListenLocal;
var
iStatus: integer;
szTcp: PChar;
szPort: array[0..31] of char;
szData: array[0..31] of char;
begin
if FPort = '' then
begin
SocketError(FSocket,'SListenLocal', -1); { No Port Specified }
exit;
end;
sin.sin_family := AF_INET;
StrPCopy(szData, '127.0.0.1');
//sin.sin_addr.s_addr := INADDR_ANY;
sin.sin_addr.s_addr := inet_addr(szData);
szTcp := 'tcp';
StrPCopy(szPort, FPort);
Pse := GetServByName(szPort,szTcp);
if Pse = nil then
sin.sin_port := htons(StrToInt(StrPas(szPort)))
else
sin.sin_port := Pse^.s_port;
pProto := GetProtoByName(szTcp);
FMSocket := Socket(PF_INET,SOCK_STREAM,pProto^.p_proto);
if FMSocket < 0 then
SocketError(INVALID_SOCKET,'Socket',WSAGetLastError);
iStatus := Bind(FMSocket, sin, sizeof(sin));
if iStatus <> 0 then
SocketError(FMSocket,'Bind',WSAGetLastError);
iStatus := Listen(FMSocket,5);
if iStatus <> 0 then
SocketError(FMSocket,'ListenLocal',WSAGetLastError);
if FModeAsync then
begin
iStatus := WSAAsyncSelect(FMSocket,Handle,WM_ASYNCSELECT,
FD_READ or FD_WRITE or FD_ACCEPT or FD_CLOSE);
if iStatus <> 0 then
SocketError(FMSocket,'WSAAsyncSelect',WSAGetLastError);
end
else
IoCtlSocket(FMSocket, FIONBIO, longzero); { blocking mode }
end;
procedure TSockets.SCancelListen;
var
iStatus: integer;
begin
if FModeAsync then
WSAAsyncSelect(FMSocket, Handle, WM_ASYNCSELECT, 0);
ShutDown(FMSocket, 2);
iStatus := CloseSocket(FMSocket);
if iStatus <> 0 then
SocketError(FMSocket,'CancelListen (CloseSocket)',WSAGetLastError);
FMSocket := 0;
end;
function TSockets.SAccept: TSocket;
var
iStatus: integer;
len: integer;
begin
iStatus:=0;
len := sizeof(sin);
if not FModeAsync then
SetTimeout; { blocking mode }
FSocket := accept(FMSocket,sin,len);
if not FModeAsync then
begin
ResetTimeout; { blocking mode }
iStatus:=IoCtlSocket(FSocket, FIONBIO, longzero);
end;
if ((FMSocket < 0) or (iStatus <> 0)) then
SocketError(FSocket,'Accept',WSAGetLastError);
Result := FSocket;
end;
procedure TSockets.SClose;
var
iStatus: integer;
lin: TLinger;
linx: array[0..3] of char absolute lin;
begin
if FModeAsync then
WSAAsyncSelect(FSocket, Handle, WM_ASYNCSELECT, 0);
if WSAIsBlocking then
WSACancelBlockingCall;
ShutDown(FSocket,2);
lin.l_onoff := 1;
lin.l_linger := 0;
SetSockOpt(FSocket, SOL_SOCKET, SO_LINGER, linx, sizeof(lin));
iStatus := CloseSocket(FSocket);
{ we ignore the WSANOTSOCK error - it means socket is already closed }
if iStatus <> 0 then
begin
iStatus:=WSAGetLastError;
if iStatus <> WSAENOTSOCK then
SocketError(FSocket,'Disconnect (CloseSocket)',iStatus);
end;
FSocket := INVALID_SOCKET;
end;
procedure TSockets.SocketError(Socket:TSocket;sockfunc:string;error:Integer);
var
szLine: array[0..255] of char;
line, ErrMsg: string;
begin
if ((FModeAsync) and (error = WSAEWOULDBLOCK)) then
Exit; { ignore }
{ Std Winsock errors are above 10000 }
if Error < 0 then
{ it's one of our own errors }
case Error of
-1: ErrMsg := 'No Port Specified';
-2: ErrMsg := 'No IP Specified';
end { end case }
else
ErrMsg := SocketErrorDesc(error);
if error=10057 then Exit; // Socket not connected
line := 'Code '+IntToStr(error)+' in function '+sockfunc+#13#10+ErrMsg;
if Assigned(FErrorOccurred) then FErrorOccurred(Self,Socket,error,line);
FSocket := INVALID_SOCKET;
end;
{ Start a timer for "FTimeout" no. of seconds }
procedure TSockets.SetTimeout;
begin
if FTimeout > 0 then
SetTimer(Handle,10,FTimeout*1000,nil);
end;
procedure TSockets.ResetTimeout;
begin
if FTimeout > 0 then
KillTimer(Handle,10);
end;
function TSockets.SocketErrorDesc(error: integer) : string;
begin
case error of
WSAEINTR:
SocketErrorDesc := 'Interrupted system call';
WSAEBADF:
SocketErrorDesc := 'Bad file number';
WSAEACCES:
SocketErrorDesc := 'Permission denied';
WSAEFAULT:
SocketErrorDesc := 'Bad address';
WSAEINVAL:
SocketErrorDesc := 'Invalid argument';
WSAEMFILE:
SocketErrorDesc := 'Too many open files';
WSAEWOULDBLOCK:
{ this is non-fatal }
SocketErrorDesc := 'Oper would block, but socket in nonblock mode';
WSAEINPROGRESS:
SocketErrorDesc := 'Operation now in progress';
WSAEALREADY:
SocketErrorDesc := 'Operation already in progress';
WSAENOTSOCK:
SocketErrorDesc := 'Socket operation on non-socket';
WSAEDESTADDRREQ:
SocketErrorDesc := 'Destination address required';
WSAEMSGSIZE:
SocketErrorDesc := 'Message too long';
WSAEPROTOTYPE:
SocketErrorDesc := 'Protocol wrong type for socket';
WSAENOPROTOOPT:
SocketErrorDesc := 'Protocol not available';
WSAEPROTONOSUPPORT:
SocketErrorDesc := 'Protocol not supported';
WSAESOCKTNOSUPPORT:
SocketErrorDesc := 'Socket type not supported';
WSAEOPNOTSUPP:
SocketErrorDesc := 'Operation not supported on socket';
WSAEPFNOSUPPORT:
SocketErrorDesc := 'Protocol family not supported';
WSAEAFNOSUPPORT:
SocketErrorDesc := 'Address family not supported by protocol family';
WSAEADDRINUSE:
SocketErrorDesc := 'Address already in use';
WSAEADDRNOTAVAIL:
SocketErrorDesc := 'Can''t assign requested address';
WSAENETDOWN:
SocketErrorDesc := 'Network is down';
WSAENETUNREACH:
SocketErrorDesc := 'Network is unreachable';
WSAENETRESET:
SocketErrorDesc := 'Network dropped connection on reset';
WSAECONNABORTED:
SocketErrorDesc := 'Software caused connection abort';
WSAECONNRESET:
SocketErrorDesc := 'Connection reset by peer';
WSAENOBUFS:
SocketErrorDesc := 'No buffer space available';
WSAEISCONN:
SocketErrorDesc := 'Socket is already connected';
WSAENOTCONN:
SocketErrorDesc := 'Socket is not connected';
WSAESHUTDOWN:
SocketErrorDesc := 'Can''t send after socket ShutDown';
WSAETOOMANYREFS:
SocketErrorDesc := 'Too many references: can''t splice';
WSAETIMEDOUT:
SocketErrorDesc := 'Connection timed out';
WSAECONNREFUSED:
SocketErrorDesc := 'Connection refused';
WSAELOOP:
SocketErrorDesc := 'Too many levels of symbolic links';
WSAENAMETOOLONG:
SocketErrorDesc := 'File name too long';
WSAEHOSTDOWN:
SocketErrorDesc := 'Host is down';
WSAEHOSTUNREACH:
SocketErrorDesc := 'No route to host';
WSAENOTEMPTY:
SocketErrorDesc := 'Directory not empty';
WSAEPROCLIM:
SocketErrorDesc := 'Too many processes';
WSAEUSERS:
SocketErrorDesc := 'Too many users';
WSAEDQUOT:
SocketErrorDesc := 'Disk quota exceeded';
WSAESTALE:
SocketErrorDesc := 'Stale NFS file handle';
WSAEREMOTE:
SocketErrorDesc := 'Too many levels of remote in path';
WSASYSNOTREADY:
SocketErrorDesc := 'WinSock DLL not found, or not responding';
WSAVERNOTSUPPORTED:
SocketErrorDesc := 'Your WinSock DLL is an old version';
WSANOTINITIALISED:
SocketErrorDesc := 'WinSock has not yet been initialized';
WSAHOST_NOT_FOUND:
SocketErrorDesc := 'Host not found';
WSATRY_AGAIN:
SocketErrorDesc := 'Non-authoritative host not found';
WSANO_RECOVERY:
SocketErrorDesc := 'Non-recoverable error';
WSANO_DATA:
SocketErrorDesc := 'No Data; perhaps no route to host';
else
SocketErrorDesc := 'Error undefined in WinSock v1.1 spec';
end;
end;
end.
