pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity
Files
053b9c89c76cdb2fd23e7a77ad0bf52b51f8da6a
lazarus-ccr/components/flashfiler/sourcelaz/ffllwsck.pas

1384 lines
45 KiB
ObjectPascal
Raw Normal View History

flashfiler: Initial commit (ported by A.Soner). Not working yet (server error). git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5438 8e941d3f-bd1b-0410-a28a-d453659cc2b4
2016-12-07 13:31:59 +00:00
{*********************************************************}
{* FlashFiler: Low-level Winsock implementation *}
{*********************************************************}
(* ***** BEGIN LICENSE BLOCK *****
* Version: MPL 1.1
*
* The contents of this file are subject to the Mozilla Public License Version
* 1.1 (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 TurboPower FlashFiler
*
* The Initial Developer of the Original Code is
* TurboPower Software
*
* Portions created by the Initial Developer are Copyright (C) 1996-2002
* the Initial Developer. All Rights Reserved.
*
* Contributor(s):
*
* ***** END LICENSE BLOCK ***** *)
{$I ffdefine.inc}
{$IFDEF CBuilder3}
(*$HPPEMIT '' *)
(*$HPPEMIT '#undef h_addr' *)
(*$HPPEMIT '' *)
{$ENDIF}
{ Use the following DEFINE to force loading of Winsock 1 }
{.$DEFINE ForceWinSock1}
unit ffllwsck;
interface
uses
Classes,
Windows,
Messages,
SysUtils,
ffconst,
ffllwsct,
ffllbase,
ffsrmgr,
ffllexcp;
{$R ffwscnst.res}
const
ffwscEventComplete = WM_USER + $0FF1;
{===Standard Winsock constants===}
const
Fd_SETSIZE = 64;
IocPARM_MASK = $7F;
Ioc_VOID = $20000000;
Ioc_OUT = $40000000;
Ioc_IN = $80000000;
Ioc_INOUT = (Ioc_IN or Ioc_OUT);
{ Protocols }
IpPROTO_IP = 0;
IpPROTO_ICMP = 1;
IpPROTO_GGP = 2;
IpPROTO_TCP = 6;
IpPROTO_PUP = 12;
IpPROTO_UDP = 17;
IpPROTO_IDP = 22;
IpPROTO_ND = 77;
IpPROTO_RAW = 255;
IpPROTO_MAX = 256;
{ Port/socket numbers: network standard functions}
IpPORT_ECHO = 7;
IpPORT_DISCARD = 9;
IpPORT_SYSTAT = 11;
IpPORT_DAYTIME = 13;
IpPORT_NETSTAT = 15;
IpPORT_FTP = 21;
IpPORT_TELNET = 23;
IpPORT_SMTP = 25;
IpPORT_TIMESERVER = 37;
IpPORT_NAMESERVER = 42;
IpPORT_WHOIS = 43;
IpPORT_MTP = 57;
{ Port/socket numbers: host specific functions }
IpPORT_TFTP = 69;
IpPORT_RJE = 77;
IpPORT_FINGER = 79;
IpPORT_TTYLINK = 87;
IpPORT_SUPDUP = 95;
{ UNIX TCP sockets }
IpPORT_EXECSERVER = 512;
IpPORT_LOGINSERVER = 513;
IpPORT_CMDSERVER = 514;
IpPORT_EFSSERVER = 520;
{ UNIX UDP sockets }
IpPORT_BIFFUDP = 512;
IpPORT_WHOSERVER = 513;
IpPORT_ROUTESERVER = 520;
{ Ports < IPPORT_RESERVED are reserved for privileged processes (e.g. root). }
IpPORT_RESERVED = 1024;
{ Link numbers }
ImpLINK_IP = 155;
ImpLINK_LOWEXPER = 156;
ImpLINK_HIGHEXPER = 158;
{ Get # bytes to read }
FIoNREAD = Ioc_OUT or ((longint(SizeOf(longint)) and IocPARM_MASK) shl 16) or
(longint(Byte('f')) shl 8) or 127;
{ Set/Clear non-blocking i/o }
FIoNBIO = Ioc_IN or((longint(SizeOf(longint)) and IocPARM_MASK) shl 16) or
(longint(Byte('f')) shl 8) or 126;
{ Set/Clear async i/o }
FIoASYNC = Ioc_IN or ((longint(SizeOf(longint)) and IocPARM_MASK) shl 16) or
(longint(Byte('f')) shl 8) or 125;
InAddr_ANY = $00000000;
InAddr_LOOPBACK = $7F000001;
InAddr_BROADCAST = $FFFFFFFF;
InAddr_NONE = $FFFFFFFF;
WsaDESCRIPTION_LEN = 256;
WsaSYS_STATUS_LEN = 128;
WsaProtocolLen = 255;
WsaMaxProtocolChain = 7;
{ Options for use with (get/set)sockopt at the IP level. }
Ip_OPTIONS = 1;
Ip_MULTICAST_IF = 2; { set/get IP multicast interface }
Ip_MULTICAST_TTL = 3; { set/get IP multicast timetolive }
Ip_MULTICAST_LOOP = 4; { set/get IP multicast loopback }
Ip_ADD_MEMBERSHIP = 5; { add an IP group membership }
Ip_DROP_MEMBERSHIP = 6; { drop an IP group membership }
Ip_DEFAULT_MULTICAST_TTL = 1; { normally limit m'casts to 1 hop }
Ip_DEFAULT_MULTICAST_LOOP = 1; { normally hear sends if a member }
Ip_MAX_MEMBERSHIPS = 20; { per socket; must fit in one mbuf }
Ipx_ADDRESS = $4007; { querying IPX info }
Invalid_SOCKET = -1;
Socket_ERROR = -1;
{ Types }
Sock_STREAM = 1; { stream socket }
Sock_DGRAM = 2; { datagram socket }
Sock_RAW = 3; { raw-protocol interface }
Sock_RDM = 4; { reliably-delivered message }
Sock_SEQPACKET = 5; { sequenced packet stream }
{ Option flags per-socket. }
So_DEBUG = $0001; { turn on debugging info recording }
So_ACCEPTCONN = $0002; { socket has had listen() }
So_REUSEADDR = $0004; { allow local address reuse }
So_KEEPALIVE = $0008; { keep connections alive }
So_DONTROUTE = $0010; { just use interface addresses }
So_BROADCAST = $0020; { permit sending of broadcast msgs }
So_USELOOPBACK = $0040; { bypass hardware when possible }
So_LINGER = $0080; { linger on close if data present }
So_OOBINLINE = $0100; { leave received OOB data in line }
So_DONTLINGER = $FF7F;
{ Additional options. }
So_SNDBUF = $1001; { send buffer size }
So_RCVBUF = $1002; { receive buffer size }
So_SNDLOWAT = $1003; { send low-water mark }
So_RCVLOWAT = $1004; { receive low-water mark }
So_SNDTIMEO = $1005; { send timeout }
So_RCVTIMEO = $1006; { receive timeout }
So_ERROR = $1007; { get error status and clear }
So_TYPE = $1008; { get socket type }
{ Options for connect and disconnect data and options. Used only by
non-TCP/IP transports such as DECNet, OSI TP4, etc. }
So_CONNDATA = $7000;
So_CONNOPT = $7001;
So_DISCDATA = $7002;
So_DISCOPT = $7003;
So_CONNDATALEN = $7004;
So_CONNOPTLEN = $7005;
So_DISCDATALEN = $7006;
So_DISCOPTLEN = $7007;
{ Option for opening sockets for synchronous access. }
So_OPENTYPE = $7008;
So_SYNCHRONOUS_ALERT = $10;
So_SYNCHRONOUS_NONALERT = $20;
{ Other NT-specific options. }
So_MAXDG = $7009;
So_MAXPATHDG = $700A;
{ TCP options. }
TCP_NoDELAY = $0001;
TCP_BsdURGENT = $7000;
{ Address families. }
Af_UNSPEC = 0; { unspecified }
Af_UNIX = 1; { local to host (pipes, portals) }
Af_INET = 2; { internetwork: UDP, TCP, etc. }
Af_IMPLINK = 3; { arpanet imp addresses }
Af_PUP = 4; { pup protocols: e.g. BSP }
Af_CHAOS = 5; { mit CHAOS protocols }
Af_IPX = 6; { IPX and SPX }
Af_NS = 6; { XEROX NS protocols }
Af_ISO = 7; { ISO protocols }
Af_OSI = Af_ISO; { OSI is ISO }
Af_ECMA = 8; { european computer manufacturers }
Af_DATAKIT = 9; { datakit protocols }
Af_CCITT = 10; { CCITT protocols, X.25 etc }
Af_SNA = 11; { IBM SNA }
Af_DECnet = 12; { DECnet }
Af_DLI = 13; { Direct data link interface }
Af_LAT = 14; { LAT }
Af_HYLINK = 15; { NSC Hyperchannel }
Af_APPLETALK = 16; { AppleTalk }
Af_NETBIOS = 17; { NetBios-style addresses }
Af_VOICEVIEW = 18; { VoiceView }
Af_MAX = 19;
{ Protocol families, same as address families for now. }
Pf_UNSPEC = Af_UNSPEC;
Pf_UNIX = Af_UNIX;
Pf_INET = Af_INET;
Pf_IMPLINK = Af_IMPLINK;
Pf_PUP = Af_PUP;
Pf_CHAOS = Af_CHAOS;
Pf_NS = Af_NS;
Pf_IPX = Af_IPX;
Pf_ISO = Af_ISO;
Pf_OSI = Af_OSI;
Pf_ECMA = Af_ECMA;
Pf_DATAKIT = Af_DATAKIT;
Pf_CCITT = Af_CCITT;
Pf_SNA = Af_SNA;
Pf_DECnet = Af_DECnet;
Pf_DLI = Af_DLI;
Pf_LAT = Af_LAT;
Pf_HYLINK = Af_HYLINK;
Pf_APPLETALK = Af_APPLETALK;
Pf_VOICEVIEW = Af_VOICEVIEW;
Pf_MAX = Af_MAX;
{ Level number for (get/set)sockopt() to apply to socket itself. }
Sol_SOCKET = $FFFF; {options for socket level }
{ Maximum queue length specifiable by listen. }
SoMAXCONN = 5;
Msg_OOB = $1; {process out-of-band data }
Msg_PEEK = $2; {peek at incoming message }
Msg_DONTROUTE = $4; {send without using routing tables }
Msg_MAXIOVLEN = 16;
Msg_PARTIAL = $8000; {partial send or recv for message xport }
{ Define constant based on rfc883, used by gethostbyxxxx() calls. }
MaxGETHOSTSTRUCT = 1024;
{ Define flags to be used with the WSAAsyncSelect() call. }
Fd_READ = $01;
Fd_WRITE = $02;
Fd_OOB = $04;
Fd_ACCEPT = $08;
Fd_CONNECT = $10;
Fd_CLOSE = $20;
{ Protocols for IPX/SPX }
NSPROTO_IPX = 1000;
NSPROTO_SPX = 1256;
NSPROTO_SPXII = 1257;
type
EffWinsockException = class(EffCommsException)
public
constructor CreateTranslate(aErrorCode : integer;
aDummy : pointer);
end;
{===FF Winsock types===}
type
TffWinsockFamily = ( {the Winsock family types we support}
wfTCP, {..TCP/IP}
wfIPX); {..IPX/SPX}
TffWinsockFamilies = set of TffWinsockFamily;
{ The following record type is used to track Winsock versions supported
by this module. }
TffWinsockVerRec = record
VerNum : Word;
ModuleName : array[0..12] of AnsiChar;
end;
TffwsWinsockVersion = (ffwvNone, ffwvWinSock1, ffwvWinSock2);
{ Identifies the winsock version we have loaded in FFWSInstalled. }
{===Standard Winsock types===}
type
TffwsSocket = integer; {a Winsock socket}
PffwsFDSet = ^TffwsFDSet;
TffwsFDSet = packed record {an array of sockets}
fd_count : integer;
fd_array : array [0..pred(FD_SETSIZE)] of TffwsSocket;
end;
PffwsTimeVal = ^TffwsTimeVal;
TffwsTimeVal = packed record {a time value}
tv_sec : longint;
tv_usec : longint;
end;
PffwsHostEnt = ^TffwsHostEnt;
TffwsHostEnt = packed record {host entity}
h_name : PAnsiChar;
h_aliases : ^PAnsiChar;
h_addrtype: smallint;
h_length : smallint;
case byte of
0: (h_addr_list: ^PAnsiChar);
1: (h_Addr : ^PAnsiChar)
end;
PffwsNetEnt = ^TffwsNetEnt;
TffwsNetEnt = packed record {network entity}
n_name : PAnsiChar;
n_aliases : ^PAnsiChar;
n_addrtype: smallint;
n_net : longint;
end;
PffwsServEnt = ^TffwsServEnt;
TffwsServEnt = packed record {server entity}
s_name : PAnsiChar;
s_aliases: ^PAnsiChar;
s_port : smallint;
s_proto : PAnsiChar;
end;
PffwsProtoEnt = ^TffwsProtoEnt;
TffwsProtoEnt = packed record {protocol entity}
p_name : PAnsiChar;
p_aliases: ^PAnsiChar;
p_proto : smallint;
end;
PffwsInAddr = ^TffwsInAddr;
TffwsInAddr = TffWord32;
PffwsSockAddrIn = ^TffwsSockAddrIn;
TffwsSockAddrIn = packed record
sin_family: word;
sin_port : word;
sin_addr : TffwsInAddr;
sin_zero : array [0..7] of AnsiChar;
end;
PffwsIPXAddr = ^TffwsIPXAddr;
TffwsIPXAddr = array [0..5] of byte;
PffwsIPXNetNum = ^TffwsIPXNetNum;
TffwsIPXNetNum = array [0..3] of byte;
PffwsSockAddrIPX = ^TffwsSockAddrIPX;
TffwsSockAddrIPX = packed record
sipx_family : word;
sipx_netnum : TffwsIPXNetNum;
sipx_nodenum : TffwsIPXAddr;
sipx_socket : word;
end;
{ Structure used by kernel to store most addresses. }
PffwsSockAddr = ^TffwsSockAddr;
TffwsSockAddr = record
case integer of
0 : (TCP : TffwsSockAddrIn);
1 : (IPX : TffwsSockAddrIPX);
end;
PffWSAData = ^TffWSAData;
TffWSAData = packed record
wVersion : word;
wHighVersion : word;
szDescription : array [0..WSADESCRIPTION_LEN] of AnsiChar;
szSystemStatus: array [0..WSASYS_STATUS_LEN] of AnsiChar;
iMaxSockets : word;
iMaxUdpDg : word;
lpVendorInfo : PAnsiChar;
end;
{ Structure used by kernel to pass protocol information in raw sockets. }
PffwsSockProto = ^TffwsSockProto;
TffwsSockProto = packed record
sp_family : word;
sp_protocol : word;
end;
{ Structure used for manipulating linger option. }
PffwsLinger = ^TffwsLinger;
TffwsLinger = packed record
l_onoff : word;
l_linger : word;
end;
{structure for querying IPX address info (from NWLINK.H)}
PffwsIPXAddrInfo = ^TffwsIPXAddrInfo;
TffwsIPXAddrInfo = packed record
adapternum : integer; {input: 0-based adapter number}
netnum : TffwsIPXNetNum; {output: IPX network number}
nodenum : TffwsIPXAddr; {output: IPX node address}
wan : boolean; {output: TRUE = adapter is on a wan link}
status : boolean; {output: TRUE = wan link is up (or adapter is not wan)}
maxpkt : integer; {output: max packet size, not including IPX header}
linkspeed : longint; {output: link speed in 100 bytes/sec (i.e. 96 == 9600)}
end;
TffwsProtocolChain = packed record
chainLen: Integer; { The length of the chain:
0 -> layered protocol,
1 -> base protocol,
> 1 -> protocol chain }
chainEntries: Array[0..WsaMaxProtocolChain - 1] of DWORD;
end;
{ Structure for retrieving protocol information. }
PffwsProtocolInfo = ^TffwsProtocolInfo;
TffwsProtocolInfo = packed record
dwServiceFlags1: DWORD;
dwServiceFlags2: DWORD;
dwServiceFlags3: DWORD;
dwServiceFlags4: DWORD;
dwProviderFlags: DWORD;
ProviderId: TGUID;
dwCatalogEntryId: DWORD;
ProtocolChain: TffwsProtocolChain;
iVersion: Integer;
iAddressFamily: Integer;
iMaxSockAddr: Integer;
iMinSockAddr: Integer;
iSocketType: Integer;
iProtocol: Integer;
iProtocolMaxOffset: Integer;
iNetworkByteOrder: Integer;
iSecurityScheme: Integer;
dwMessageSize: DWORD;
dwProviderReserved: DWORD;
szProtocol: Array[0..WsaProtocolLen] of AnsiChar;
end;
{ Socket function types }
tffwsrAccept =
function(S : TffwsSocket; var Addr : TffwsSockAddr; var Addrlen : integer) : TffwsSocket
stdcall;
tffwsrBind =
function(S : TffwsSocket; var Addr : TffwsSockAddr; NameLen : integer) : integer
stdcall;
tffwsrCloseSocket =
function(S : TffwsSocket) : integer
stdcall;
tffwsrConnect =
function(S : TffwsSocket; var Name : TffwsSockAddr; NameLen : integer) : integer
stdcall;
tffwsrEnumProtocols =
function( Protocols : PInteger; aBuffer : PffwsProtocolInfo;
var BufferLength : DWORD ) : Integer; stdcall;
tffwsrIOCtlSocket =
function(S : TffwsSocket; Cmd : longint; var Arg : longint) : integer
stdcall;
tffwsrGetPeerName =
function(S : TffwsSocket; var Name : TffwsSockAddr; var NameLen : integer): integer
stdcall;
tffwsrGetSockName =
function(S : TffwsSocket; var Name : TffwsSockAddr; var NameLen : integer): integer
stdcall;
tffwsrGetSockOpt =
function(S : TffwsSocket; Level, OptName : integer;
var OptVal; var OptLen: integer): integer
stdcall;
tffwsrhtonl =
function(HostLong : longint) : longint
stdcall;
tffwsrhtons =
function(HostShort : word) : word
stdcall;
tffwsrINet_Addr =
function(Cp : PAnsiChar) : dword {!!.11}
stdcall;
tffwsrINet_NtoA =
function(InAddr : TffwsInAddr) : PAnsiChar
stdcall;
tffwsrListen =
function(S : TffwsSocket; Backlog : integer) : integer
stdcall;
tffwsrntohl =
function(NetLong : longint) : longint
stdcall;
tffwsrntohs =
function(NetShort : word) : word
stdcall;
tffwsrRecv =
function(S : TffwsSocket; var Buf; Len, Flags : integer) : integer
stdcall;
tffwsrRecvFrom =
function(S : TffwsSocket; var Buf; Len, Flags : integer;
var From: TffwsSockAddr; var FromLen : integer) : integer
stdcall;
tffwsrSelect =
function(Nfds : integer; Readfds, Writefds,
Exceptfds : PffwsFDSet; Timeout : PffwsTimeVal) : longint
stdcall;
tffwsrSend =
function(S : TffwsSocket; var Buf; Len, Flags : integer) : integer
stdcall;
tffwsrSendTo =
function(S : TffwsSocket; var Buf; Len, Flags : integer;
var AddrTo : TffwsSockAddr; ToLen : integer) : integer
stdcall;
tffwsrSetSockOpt =
function(S : TffwsSocket; Level, OptName : integer;
var OptVal; OptLen : integer) : integer
stdcall;
tffwsrShutdown =
function(S : TffwsSocket; How : integer) : integer
stdcall;
tffwsrSocket =
function(Af, Struct, Protocol : integer) : TffwsSocket
stdcall;
tffwsrGetHostByAddr =
function(var Addr; Len, Struct : integer): PffwsHostEnt
stdcall;
tffwsrGetHostByName =
function(Name : PAnsiChar) : PffwsHostEnt
stdcall;
tffwsrGetHostName =
function(Name : PAnsiChar; Len : integer): integer
stdcall;
tffwsrGetServByPort =
function(Port : integer; Proto : PAnsiChar) : PffwsServEnt
stdcall;
tffwsrGetServByName =
function(Name, Proto : PAnsiChar) : PffwsServEnt
stdcall;
tffwsrGetProtoByNumber =
function(Proto : integer) : PffwsProtoEnt
stdcall;
tffwsrGetProtoByName =
function(Name : PAnsiChar) : PffwsProtoEnt
stdcall;
tffwsrWSAStartup =
function(wVersionRequired : word; var WSData : TffWSAData) : integer
stdcall;
tffwsrWSACleanup =
function : integer
stdcall;
tffwsrWSASetLastError =
procedure(iError : integer)
stdcall;
tffwsrWSAGetLastError =
function : integer
stdcall;
tffwsrWSAIsBlocking =
function : BOOL
stdcall;
tffwsrWSAUnhookBlockingHook =
function : integer
stdcall;
tffwsrWSASetBlockingHook =
function(lpBlockFunc : TFarProc) : TFarProc
stdcall;
tffwsrWSACancelBlockingCall =
function : integer
stdcall;
tffwsrWSAAsyncGetServByName =
function(HWindow : HWnd; wMsg : integer;
Name, Proto, Buf : PAnsiChar; BufLen : integer) : THandle
stdcall;
tffwsrWSAAsyncGetServByPort =
function(HWindow : HWnd; wMsg, Port : integer;
Proto, Buf : PAnsiChar; BufLen : integer) : THandle
stdcall;
tffwsrWSAAsyncGetProtoByName =
function(HWindow : HWnd; wMsg : integer;
Name, Buf : PAnsiChar; BufLen : integer) : THandle
stdcall;
tffwsrWSAAsyncGetProtoByNumber =
function(HWindow : HWnd; wMsg : integer; Number : integer;
Buf : PAnsiChar; BufLen : integer) : THandle
stdcall;
tffwsrWSAAsyncGetHostByName =
function(HWindow : HWnd; wMsg : integer;
Name, Buf : PAnsiChar; BufLen : integer) : THandle
stdcall;
tffwsrWSAAsyncGetHostByAddr =
function(HWindow : HWnd; wMsg : integer; Addr : PAnsiChar;
Len, Struct : integer; Buf : PAnsiChar; BufLen : integer) : THandle
stdcall;
tffwsrWSACancelAsyncRequest =
function(hAsyncTaskHandle : THandle) : integer
stdcall;
tffwsrWSAAsyncSelect =
function(S : TffwsSocket; HWindow : HWnd; wMsg : integer; lEvent : longint) : integer
stdcall;
type
PffWinsockRoutines = ^TffWinsockRoutines;
TffWinsockRoutines = record {record of Winsock function pointers}
accept : tffwsrAccept;
bind : tffwsrBind;
closesocket : tffwsrCloseSocket;
connect : tffwsrConnect;
ioctlsocket : tffwsrIOCtlSocket;
getpeername : tffwsrGetPeerName;
getsockname : tffwsrGetSockName;
getsockopt : tffwsrGetSockOpt;
htonl : tffwsrhtonl;
htons : tffwsrhtons;
inet_addr : tffwsrINet_Addr;
inet_ntoa : tffwsrINet_Ntoa;
listen : tffwsrListen;
ntohl : tffwsrntohl;
ntohs : tffwsrntohs;
recv : tffwsrRecv;
recvfrom : tffwsrRecvFrom;
select : tffwsrSelect;
send : tffwsrSend;
sendTo : tffwsrSendTo;
setsockopt : tffwsrSetSockOpt;
shutdown : tffwsrShutdown;
socket : tffwsrSocket;
gethostbyaddr : tffwsrGetHostByAddr;
gethostbyname : tffwsrGetHostByName;
gethostname : tffwsrGetHostName;
getservbyport : tffwsrGetServByPort;
getservbyname : tffwsrGetServByName;
getprotobynumber : tffwsrGetProtoByNumber;
getprotobyname : tffwsrGetProtoByName;
WSAStartup : tffwsrWSAStartup;
WSACleanup : tffwsrWSACleanup;
WSAEnumProtocols : tffwsrEnumProtocols;
WSASetLastError : tffwsrWSASetLastError;
WSAGetLastError : tffwsrWSAGetLastError;
WSAIsBlocking : tffwsrWSAIsBlocking;
WSAUnhookBlockingHook : tffwsrWSAUnhookBlockingHook;
WSASetBlockingHook : tffwsrWSASetBlockingHook;
WSACancelBlockingCall : tffwsrWSACancelBlockingCall;
WSAAsyncGetServByName : tffwsrWSAAsyncGetServByName;
WSAAsyncGetServByPort : tffwsrWSAAsyncGetServByPort;
WSAAsyncGetProtoByName : tffwsrWSAAsyncGetProtoByName;
WSAAsyncGetProtoByNumber : tffwsrWSAAsyncGetProtoByNumber;
WSAAsyncGetHostByName : tffwsrWSAAsyncGetHostByName;
WSAAsyncGetHostByAddr : tffwsrWSAAsyncGetHostByAddr;
WSACancelAsyncRequest : tffwsrWSACancelAsyncRequest;
WSAAsyncSelect : tffwsrWSAAsyncSelect;
end;
var
WinsockRoutines : TffWinsockRoutines;
ffwsFamiliesInstalled : TffWinsockFamilies;
function FFWSInstalled : boolean;
{-Returns true if Winsock is installed}
function WSAMakeSyncReply(Buflen, Error : word) : longint;
{-Construct the response to a WSAAsyncGetXByY routine}
function WSAMakeSelectReply(Event, Error : word) : longint;
{-Construct the response to WSAAsyncSelect}
function WSAGetAsyncBuflen(lParam : longint) : integer;
{-Extract the buffer length from lParam in response to a WSAGetXByY}
function WSAGetAsyncError(lParam : longint) : integer;
{-Extract the error from lParam in response to a WSAGetXByY}
function WSAGetSelectEvent(lParam : longint) : integer;
{-Extract the event from lParam in response to a WSAAsyncSelect}
function WSAGetSelectError(lParam : longint) : integer;
{-Extract the error from lParam in response to a WSAAsyncSelect}
{===FlashFiler helper routines===}
procedure FFWSAsyncSelect(aSocket : TffwsSocket;
aWindow : HWnd;
aEvent : longint);
function FFWSCreateSocket(aAF, aStruct, aProtocol : integer) : TffwsSocket;
function FFWSCvtAddrToStr(aAddr : TffwsInAddr) : TffNetName;
function FFWSCvtIPXAddrToStr(const aNetNum : TffwsIPXNetNum;
const aAddr : TffwsIPXAddr) : TffNetName;
function FFWSCvtStrToAddr(aStr : TffNetName; var aAddr : TffwsInAddr) : boolean;
function FFWSCvtStrToIPXAddr(const aStr : TffNetName;
var aNetNum : TffwsIPXNetNum;
var aAddr : TffwsIPXAddr) : boolean;
procedure FFWSDestroySocket(aSocket : TffwsSocket);
function FFWSGetLocalHosts(aList : TStrings) : Boolean;
function FFWSGetLocalHostByNum(const NIC : Integer;
var aNetName : TffNetName;
var aAddr : TffwsInAddr) : Boolean;
function FFWSGetLocalIPXAddr(var aNetNum : TffwsIPXNetNum;
var aAddr : TffwsIPXAddr) : boolean;
function FFWSGetRemoteHost(const aName : TffNetName;
var aNetName : TffNetName; var aAddr : TffwsInAddr) : boolean;
function FFWSGetRemoteNameFromAddr(aAddr : TffwsInAddr) : TffNetName;
procedure FFWSGetSocketOption(aSocket : TffwsSocket; aLevel, aOptName : integer;
var aOptValue; aOptValueLen : integer);
procedure FFWSSetSocketOption(aSocket : TffwsSocket; aLevel, aOptName : integer;
var aOptValue; aOptValueLen : integer);
const
ffcNumWinsockVersions = 2;
{ Number of supported Winsock versions. }
var
ffStrResWinsock : TffStringResource; {in FFWSCNST.RC}
{ This array defines the Winsock versions supported by this module. }
ffWinsockVerArray : array[1..ffcNumWinsockVersions] of TffWinsockVerRec =
((VerNum : $0101; ModuleName : 'wsock32.dll'), { WinSock 1 }
(VerNum : $0202; ModuleName : 'ws2_32.dll')); { WinSock 2 }
implementation
var
UnitInitializationDone : boolean;
ffwsLoadedWinsockVersion : TffwsWinsockVersion;
WSLibHandle : THandle;
LockFFWSInstalled : TRTLCriticalSection;
{===EffWinsockException==============================================}
constructor EffWinsockException.CreateTranslate(aErrorCode : integer;
aDummy : pointer);
var
ErrorMsg : TffShStr;
begin
ErrorMsg := ffStrResWinsock[aErrorCode];
inherited CreateEx(ffStrResGeneral, fferrWinsock, [aErrorCode, aErrorCode, ErrorMsg]);
end;
{===Macro expansion==================================================}
function WSAMakeSyncReply(Buflen, Error : word) : longint;
register;
asm
movzx eax, ax
shl edx, 16
or eax, edx
end;
{--------}
function WSAMakeSelectReply(Event, Error : word) : longint;
register;
asm
movzx eax, ax
shl edx, 16
or eax, edx
end;
{--------}
function WSAGetAsyncBuflen(lParam : longint) : integer;
register;
asm
and eax, $0000FFFF
end;
{--------}
function WSAGetAsyncError(lParam : longint) : integer;
register;
asm
shr eax, 16
end;
{--------}
function WSAGetSelectEvent(lParam : longint) : integer;
register;
asm
and eax, $0000FFFF
end;
{--------}
function WSAGetSelectError(lParam : longint) : integer;
register;
asm
shr eax, 16
end;
{====================================================================}
{===Unit initialization/finalization=================================}
function FFWSInstalled : boolean;
const
ffcMaxProtoInfoRecords = 15;
var
aBuffer : PChar;
pBuffer : PffwsProtocolInfo absolute aBuffer;
aCode : HFile;
aCount : integer;
aFile : TOFStruct;
anError : integer;
anIndex : integer;
anOffset : integer;
aProtocolInfo : PffwsProtocolInfo;
aSize : DWORD;
aVersion : integer;
WSData : TffWSAData;
begin
EnterCriticalSection(LockFFWSInstalled);
try
Result := (ffwsLoadedWinsockVersion <> ffwvNone);
{ If this routine has already been called, exit. }
if UnitInitializationDone then
Exit;
{ No matter what happens next, we've initialized. }
UnitInitializationDone := true;
ffwsLoadedWinsockVersion := ffwvNone;
aVersion := 0;
{ Load the Winsock DLL. Note that we try to load the most recent
Winsock version first. }
for anIndex := ffcNumWinsockVersions downto 1 do begin
{$IFDEF ForceWinSock1}
if anIndex <> 1 then Continue;
{$ENDIF}
{ Check to see if the file exists before trying to load it }
aCode := OpenFile(ffWinsockVerArray[anIndex].ModuleName, aFile, OF_EXIST);
if aCode = HFILE_ERROR then Continue;
{ If we get this far, we should have a good module -- load it }
WSLibHandle := LoadLibrary(ffWinsockVerArray[anIndex].ModuleName);
if WSLibHandle <> 0 then begin
aVersion := anIndex;
break;
end;
end;
if (WSLibHandle = 0) then
Exit;
{load and validate all pointers}
@WinsockRoutines.accept := GetProcAddress(WSLibHandle, 'accept');
if not Assigned(WinsockRoutines.accept) then Exit;
@WinsockRoutines.bind := GetProcAddress(WSLibHandle, 'bind');
if not Assigned(WinsockRoutines.bind) then Exit;
@WinsockRoutines.closesocket := GetProcAddress(WSLibHandle, 'closesocket');
if not Assigned(WinsockRoutines.closesocket) then Exit;
@WinsockRoutines.connect := GetProcAddress(WSLibHandle, 'connect');
if not Assigned(WinsockRoutines.connect) then Exit;
@WinsockRoutines.getpeername := GetProcAddress(WSLibHandle, 'getpeername');
if not Assigned(WinsockRoutines.getpeername) then Exit;
@WinsockRoutines.getsockname := GetProcAddress(WSLibHandle, 'getsockname');
if not Assigned(WinsockRoutines.getsockname) then Exit;
@WinsockRoutines.getsockopt := GetProcAddress(WSLibHandle, 'getsockopt');
if not Assigned(WinsockRoutines.getsockopt) then Exit;
@WinsockRoutines.htonl := GetProcAddress(WSLibHandle, 'htonl');
if not Assigned(WinsockRoutines.htonl) then Exit;
@WinsockRoutines.htons := GetProcAddress(WSLibHandle, 'htons');
if not Assigned(WinsockRoutines.htons) then Exit;
@WinsockRoutines.inet_addr := GetProcAddress(WSLibHandle, 'inet_addr');
if not Assigned(WinsockRoutines.inet_addr) then Exit;
@WinsockRoutines.inet_ntoa := GetProcAddress(WSLibHandle, 'inet_ntoa');
if not Assigned(WinsockRoutines.inet_ntoa) then Exit;
@WinsockRoutines.ioctlsocket := GetProcAddress(WSLibHandle, 'ioctlsocket');
if not Assigned(WinsockRoutines.ioctlsocket) then Exit;
@WinsockRoutines.listen := GetProcAddress(WSLibHandle, 'listen');
if not Assigned(WinsockRoutines.listen) then Exit;
@WinsockRoutines.ntohl := GetProcAddress(WSLibHandle, 'ntohl');
if not Assigned(WinsockRoutines.ntohl) then Exit;
@WinsockRoutines.ntohs := GetProcAddress(WSLibHandle, 'ntohs');
if not Assigned(WinsockRoutines.ntohs) then Exit;
@WinsockRoutines.recv := GetProcAddress(WSLibHandle, 'recv');
if not Assigned(WinsockRoutines.recv) then Exit;
@WinsockRoutines.recvfrom := GetProcAddress(WSLibHandle, 'recvfrom');
if not Assigned(WinsockRoutines.recvfrom) then Exit;
@WinsockRoutines.select := GetProcAddress(WSLibHandle, 'select');
if not Assigned(WinsockRoutines.select) then Exit;
@WinsockRoutines.send := GetProcAddress(WSLibHandle, 'send');
if not Assigned(WinsockRoutines.send) then Exit;
@WinsockRoutines.sendto := GetProcAddress(WSLibHandle, 'sendto');
if not Assigned(WinsockRoutines.sendto) then Exit;
@WinsockRoutines.setsockopt := GetProcAddress(WSLibHandle, 'setsockopt');
if not Assigned(WinsockRoutines.setsockopt) then Exit;
@WinsockRoutines.shutdown := GetProcAddress(WSLibHandle, 'shutdown');
if not Assigned(WinsockRoutines.shutdown) then Exit;
@WinsockRoutines.socket := GetProcAddress(WSLibHandle, 'socket');
if not Assigned(WinsockRoutines.socket) then Exit;
@WinsockRoutines.gethostbyaddr := GetProcAddress(WSLibHandle, 'gethostbyaddr');
if not Assigned(WinsockRoutines.gethostbyaddr) then Exit;
@WinsockRoutines.gethostbyname := GetProcAddress(WSLibHandle, 'gethostbyname');
if not Assigned(WinsockRoutines.gethostbyname) then Exit;
@WinsockRoutines.gethostname := GetProcAddress(WSLibHandle, 'gethostname');
if not Assigned(WinsockRoutines.gethostname) then Exit;
@WinsockRoutines.getservbyport := GetProcAddress(WSLibHandle, 'getservbyport');
if not Assigned(WinsockRoutines.getservbyport) then Exit;
@WinsockRoutines.getservbyname := GetProcAddress(WSLibHandle, 'getservbyname');
if not Assigned(WinsockRoutines.getservbyname) then Exit;
@WinsockRoutines.getprotobynumber := GetProcAddress(WSLibHandle, 'getprotobynumber');
if not Assigned(WinsockRoutines.getprotobynumber) then Exit;
@WinsockRoutines.getprotobyname := GetProcAddress(WSLibHandle, 'getprotobyname');
if not Assigned(WinsockRoutines.getprotobyname) then Exit;
@WinsockRoutines.WSAStartup := GetProcAddress(WSLibHandle, 'WSAStartup');
if not Assigned(WinsockRoutines.WSAStartup) then Exit;
@WinsockRoutines.WSACleanup := GetProcAddress(WSLibHandle, 'WSACleanup');
if not Assigned(WinsockRoutines.WSACleanup) then Exit;
if aVersion > 1 then begin
@WinsockRoutines.WSAEnumProtocols := GetProcAddress(WSLibHandle, 'WSAEnumProtocolsA');
if not Assigned(WinsockRoutines.WSAEnumProtocols) then Exit;
end;
@WinsockRoutines.WSASetLastError := GetProcAddress(WSLibHandle, 'WSASetLastError');
if not Assigned(WinsockRoutines.WSASetLastError) then Exit;
@WinsockRoutines.WSAGetLastError := GetProcAddress(WSLibHandle, 'WSAGetLastError');
if not Assigned(WinsockRoutines.WSAGetLastError) then Exit;
@WinsockRoutines.WSAIsBlocking := GetProcAddress(WSLibHandle, 'WSAIsBlocking');
if not Assigned(WinsockRoutines.WSAIsBlocking) then Exit;
@WinsockRoutines.WSAUnhookBlockingHook := GetProcAddress(WSLibHandle, 'WSAUnhookBlockingHook');
if not Assigned(WinsockRoutines.WSAUnhookBlockingHook) then Exit;
@WinsockRoutines.WSASetBlockingHook := GetProcAddress(WSLibHandle, 'WSASetBlockingHook');
if not Assigned(WinsockRoutines.WSASetBlockingHook) then Exit;
@WinsockRoutines.WSACancelBlockingCall := GetProcAddress(WSLibHandle, 'WSACancelBlockingCall');
if not Assigned(WinsockRoutines.WSACancelBlockingCall) then Exit;
@WinsockRoutines.WSAAsyncGetServByName := GetProcAddress(WSLibHandle, 'WSAAsyncGetServByName');
if not Assigned(WinsockRoutines.WSAAsyncGetServByName) then Exit;
@WinsockRoutines.WSAAsyncGetServByPort := GetProcAddress(WSLibHandle, 'WSAAsyncGetServByPort');
if not Assigned(WinsockRoutines.WSAAsyncGetServByPort) then Exit;
@WinsockRoutines.WSAAsyncGetProtoByName := GetProcAddress(WSLibHandle, 'WSAAsyncGetProtoByName');
if not Assigned(WinsockRoutines.WSAAsyncGetProtoByName) then Exit;
@WinsockRoutines.WSAAsyncGetProtoByNumber := GetProcAddress(WSLibHandle, 'WSAAsyncGetProtoByNumber');
if not Assigned(WinsockRoutines.WSAAsyncGetProtoByNumber) then Exit;
@WinsockRoutines.WSAAsyncGetHostByName := GetProcAddress(WSLibHandle, 'WSAAsyncGetHostByName');
if not Assigned(WinsockRoutines.WSAAsyncGetHostByName) then Exit;
@WinsockRoutines.WSAAsyncGetHostByAddr := GetProcAddress(WSLibHandle, 'WSAAsyncGetHostByAddr');
if not Assigned(WinsockRoutines.WSAAsyncGetHostByAddr) then Exit;
@WinsockRoutines.WSACancelAsyncRequest := GetProcAddress(WSLibHandle, 'WSACancelAsyncRequest');
if not Assigned(WinsockRoutines.WSACancelAsyncRequest) then Exit;
@WinsockRoutines.WSAAsyncSelect := GetProcAddress(WSLibHandle, 'WSAAsyncSelect');
if not Assigned(WinsockRoutines.WSAAsyncSelect) then Exit;
{ If we got here then we have succeeded. }
if (WinsockRoutines.WSAStartup
(ffWinsockVerArray[aVersion].VerNum, WSData) = 0) then begin
ffwsLoadedWinsockVersion := TffwsWinsockVersion(aVersion);
{ Determine which winsock families are installed. Allocate a buffer that
will hold several protocol records. }
if aVersion > 1 then begin
ffwsFamiliesInstalled := [];
{ Allocate a buffer that we know is too small. }
aSize := sizeOf(TffwsProtocolInfo);
FFGetMem(aBuffer, 32);
try
Fillchar(aBuffer^, 32, 0);
aSize := 0;
aCount := WinsockRoutines.WSAEnumProtocols(nil, pBuffer, aSize);
if aCount < 0 then begin
anError := WinsockRoutines.WSAGetLastError;
if anError = WSAENOBUFS then begin
FFFreeMem(aBuffer, 32);
FFGetMem(aBuffer, aSize);
fillChar(aBuffer^, aSize, 0);
aCount := WinsockRoutines.WSAEnumProtocols(nil, pBuffer, aSize);
end;
end;
if aCount > 0 then begin
anOffset := 0;
for anIndex := 1 to aCount do begin
{ Grab the record. }
aProtocolInfo := @(aBuffer[anOffset]);
{ Is it a family we care about? }
case aProtocolInfo^.iAddressFamily of
Af_INET : include(ffwsFamiliesInstalled, wfTCP);
Af_IPX : include(ffwsFamiliesInstalled, wfIPX);
end; { case }
{ Position to the next record. }
inc(anOffset, sizeOf(TffwsProtocolInfo));
end;
end;
finally
if aSize > 0 then
FFFreemem(aBuffer, aSize)
else
FFFreemem(aBuffer, 32);
end;
end
else begin
{ Winsock 1: Assume all families supported. }
ffwsFamiliesInstalled := [wfTCP, wfIPX];
end;
end;
finally
LeaveCriticalSection(LockFFWSInstalled);
end;
Result := (ffwsLoadedWinsockVersion <> ffwvNone);
end;
{--------}
procedure FinalizeUnit;
begin
ffStrResWinsock.Free;
DeleteCriticalSection(LockFFWSInstalled);
if UnitInitializationDone then begin
if (WSLibHandle <> 0) then begin
if (ffwsLoadedWinsockVersion <> ffwvNone) then
WinsockRoutines.WSACleanUp;
FreeLibrary(WSLibHandle);
end;
end;
end;
{====================================================================}
{===FlashFiler helper routines=======================================}
procedure FFWSAsyncSelect(aSocket : TffwsSocket;
aWindow : HWnd;
aEvent : longint);
var
Error : integer;
begin
if (WinsockRoutines.WSAAsyncSelect(aSocket, aWindow,
ffwscEventComplete, aEvent) = SOCKET_ERROR) then begin
Error := WinsockRoutines.WSAGetLastError;
raise EffWinsockException.CreateTranslate(Error, nil);
end;
end;
{--------}
function FFWSCreateSocket(aAF, aStruct, aProtocol : integer) : TffwsSocket;
var
Error : integer;
begin
Result := WinsockRoutines.socket(aAF, aStruct, aProtocol);
if (Result = INVALID_SOCKET) then begin
Error := WinsockRoutines.WSAGetLastError;
raise EffWinsockException.CreateTranslate(Error, nil);
end;
end;
{--------}
function FFWSCvtAddrToStr(aAddr : TffwsInAddr) : TffNetName;
begin
Result := FFStrPas(WinsockRoutines.inet_ntoa(aAddr));
end;
{--------}
function FFWSCvtIPXAddrToStr(const aNetNum : TffwsIPXNetNum;
const aAddr : TffwsIPXAddr) : TffNetName;
const
HexChars : string[16] = '0123456789ABCDEF';
var
i, j : integer;
begin
{Begin !!.03}
{$IFDEF IsDelphi}
Result[0] := chr((2 * sizeof(TffwsIPXNetNum)) +
1 +
(2 * sizeof(TffwsIPXAddr)) +
5);
{$ELSE}
SetLength(Result, (2 * sizeof(TffwsIPXNetNum)) + 1 +
(2 * sizeof(TffwsIPXAddr)) + 5);
{$ENDIF}
{End !!.03}
j := 0;
for i := 0 to pred(sizeof(TffwsIPXNetNum)) do begin
Result[j+1] := HexChars[(aNetNum[i] shr 4) + 1];
Result[j+2] := HexChars[(aNetNum[i] and $F) + 1];
inc(j, 2);
end;
inc(j);
Result[j] := ':';
for i := 0 to pred(sizeof(TffwsIPXAddr)) do begin
if (i <> 0) then
Result[j] := '-';
Result[j+1] := HexChars[(aAddr[i] shr 4) + 1];
Result[j+2] := HexChars[(aAddr[i] and $F) + 1];
inc(j, 3);
end;
end;
{--------}
function FFWSCvtStrToAddr(aStr : TffNetName; var aAddr : TffwsInAddr) : boolean;
var
StrZ : TffStringZ;
begin
FFStrPCopy(StrZ, aStr);
aAddr := TffWord32(WinsockRoutines.inet_addr(StrZ));
Result := (aAddr <> INADDR_NONE);
end;
{--------}
function FFWSCvtStrToIPXAddr(const aStr : TffNetName;
var aNetNum : TffwsIPXNetNum;
var aAddr : TffwsIPXAddr) : boolean;
var
i, j : integer;
Nibble : integer;
Ch : char;
DoUpper : boolean;
DoNetNum: boolean;
begin
Nibble := 0;
Result := false;
j := 0;
DoNetNum := true;
DoUpper := true;
for i := 1 to length(aStr) do begin
Ch := upcase(aStr[i]);
if ('0' <= Ch) and (Ch <= '9') then
Nibble := ord(Ch) - ord('0')
else if ('A' <= Ch) and (Ch <= 'F') then
Nibble := ord(Ch) - ord('A') + 10
else if (Ch <> '-') and (Ch <> ':') then
Exit;
if (Ch = '-') or (Ch = ':') then begin
if DoNetNum then
j := 0;
DoNetNum := false;
DoUpper := true;
end
else
if DoUpper then begin
if DoNetNum then
aNetNum[j] := Nibble shl 4
else
aAddr[j] := Nibble shl 4;
DoUpper := false;
end
else begin
if DoNetNum then
aNetNum[j] := aNetNum[j] or Nibble
else
aAddr[j] := aAddr[j] or Nibble;
inc(j);
DoUpper := true;
end;
end;
Result := true;
end;
{--------}
procedure FFWSDestroySocket(aSocket : TffwsSocket);
begin
if (aSocket <> INVALID_SOCKET) then begin
WinsockRoutines.shutdown(aSocket, 2);
WinsockRoutines.closesocket(aSocket);
end;
end;
{--------}
function FFWSGetLocalHosts(aList : TStrings) : Boolean;
type
TaPInAddr = array [0..255] of PFFWord32;
PaPInAddr = ^TaPInAddr;
var
ZStr : TffStringZ;
HostEnt : PffwsHostEnt;
IPAddress : TffNetName;
pptr : PaPInAddr;
Idx : Integer;
begin
aList.BeginUpdate;
try
aList.Clear;
aList.Add('<ALL INTERFACES>');
Result := False;
if (WinsockRoutines.gethostname(ZStr, SizeOf(ZStr)) = 0) then begin
HostEnt := WinsockRoutines.gethostbyname(ZStr);
if Assigned(HostEnt) then begin
pptr := PaPInAddr(HostEnt^.h_addr_list);
Idx := 0;
while Assigned(pptr^[Idx]) do begin
{pptr is assigned if any winsock based protocol is installed}
{When IPX/SPX is installed, and TCP/IP is an IP address still
is returned. We must filter this out.}
IPAddress := FFWSCvtAddrToStr(pptr^[Idx]^);
if IPAddress <> '127.0.0.1' then
aList.Add(Format('Adapter %D: %S', [Idx, IPAddress]));
Inc(Idx);
end;
Result := true;
end;
end;
finally
aList.EndUpdate;
end;
end;
{--------}
function FFWSGetLocalHostByNum(const NIC : Integer;
var aNetName : TffNetName;
var aAddr : TffwsInAddr) : Boolean;
type
TaPInAddr = array [0..255] of PffWord32;
PaPInAddr = ^TaPInAddr;
var
ZStr : TffStringZ;
HostEnt : PffwsHostEnt;
pptr : PaPInAddr;
begin
Result := False;
if (WinsockRoutines.gethostname(ZStr, SizeOf(ZStr)) = 0) then begin
HostEnt := WinsockRoutines.gethostbyname(ZStr);
if Assigned(HostEnt) then begin
pptr := PaPInAddr(HostEnt^.h_addr_list);
if NIC = -1 then begin
aNetName := FFStrPasLimit(HostEnt^.h_name, pred(sizeof(TffNetName)));
aAddr := InAddr_ANY;
Result := True;
end else begin
if Assigned(pptr^[NIC]) then begin
aNetName := FFStrPasLimit(HostEnt^.h_name, Pred(SizeOf(TffNetName)));
aAddr:= pptr^[NIC]^;
Result := True;
end;
end;
end;
end;
end;
{--------}
function FFWSGetLocalIPXAddr(var aNetNum : TffwsIPXNetNum;
var aAddr : TffwsIPXAddr) : boolean;
var
Addr : TffwsSockAddr;
IPXInfo : TffwsIPXAddrInfo;
S : TffwsSocket;
begin
// Create IPX socket.
S := FFWSCreateSocket(AF_IPX, SOCK_DGRAM, NSPROTO_IPX);
// Socket must be bound prior to calling IPX_ADDRESS
FillChar(Addr, sizeof(Addr), 0);
Addr.IPX.sipx_family := AF_IPX;
WinsockRoutines.bind(S, Addr, sizeof(TffwsSockAddrIPX));
// Specify which adapter to check.
FillChar(IPXInfo, sizeof(IPXInfo), 0);
IPXInfo.adapternum := 0;
FFWSGetSocketOption(S, NSPROTO_IPX, IPX_ADDRESS, IPXInfo, sizeof(IPXInfo));
aNetNum := IPXInfo.netnum;
aAddr := IPXInfo.nodenum;
Result := true;
// Destroy IPX socket.
FFWSDestroySocket(S);
end;
{--------}
function FFWSGetRemoteHost(const aName : TffNetName;
var aNetName : TffNetName; var aAddr : TffwsInAddr) : boolean;
var
ZStr : TffStringZ;
HostEnt : PffwsHostEnt;
begin
HostEnt := WinsockRoutines.gethostbyname(FFStrPCopy(ZStr, aName));
if (HostEnt = nil) then
Result := false
else begin
aAddr := PffwsInAddr((HostEnt^.h_addr)^)^;
aNetName := FFStrPasLimit(HostEnt^.h_name, pred(sizeof(TffNetName)));
Result := true;
end;
end;
{--------}
function FFWSGetRemoteNameFromAddr(aAddr : TffwsInAddr) : TffNetName;
var
HostEnt : PffwsHostEnt;
begin
HostEnt := WinsockRoutines.gethostbyaddr(aAddr, sizeof(aAddr), PF_INET);
if (HostEnt = nil) then
Result := ''
else
Result := FFStrPasLimit(HostEnt^.h_name, pred(sizeof(TffNetName)));
end;
{--------}
procedure FFWSGetSocketOption(aSocket : TffwsSocket; aLevel, aOptName : integer;
var aOptValue; aOptValueLen : integer);
var
Error : integer;
begin
Error := WinsockRoutines.getsockopt(aSocket, aLevel, aOptName, aOptValue, aOptValueLen);
if (Error = SOCKET_ERROR) then begin
Error := WinsockRoutines.WSAGetLastError;
raise EffWinsockException.CreateTranslate(Error, nil);
end;
end;
{--------}
procedure FFWSSetSocketOption(aSocket : TffwsSocket; aLevel, aOptName : integer;
var aOptValue; aOptValueLen : integer);
var
Error : integer;
begin
Error := WinsockRoutines.setsockopt(aSocket, aLevel, aOptName, aOptValue, aOptValueLen);
if (Error = SOCKET_ERROR) then begin
Error := WinsockRoutines.WSAGetLastError;
raise EffWinsockException.CreateTranslate(Error, nil);
end;
end;
{====================================================================}
initialization
UnitInitializationDone := false;
ffwsLoadedWinsockVersion := ffwvNone;
ffStrResWinsock := nil;
ffStrResWinsock := TffStringResource.Create(hInstance, 'FF_WINSOCK_ERROR_STRINGS');
InitializeCriticalSection(LockFFWSInstalled);
finalization
FinalizeUnit;
end.
Reference in New Issue Copy Permalink