development/compilers/freepascal/rtl/win32/sockets.pp

   1 {
   2     $Id$
   3     This file is part of the Free Pascal run time library.
   4     Copyright (c) 1999-2000 by the Free Pascal development team
   5
   6     See the file COPYING.FPC, included in this distribution,
   7     for details about the copyright.
   8
   9     This program is distributed in the hope that it will be useful,
  10     but WITHOUT ANY WARRANTY; without even the implied warranty of
  11     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  12
  13  **********************************************************************}
  14 {$mode objfpc}
  15 unit Sockets;
  16
  17 Interface
  18
  19   Uses
  20      windows,winsock;
  21
  22   Const
  23      AF_MAX          = WinSock.AF_MAX;
  24      PF_MAX          = AF_MAX;
  25
  26 {$i socketsh.inc}
  27
  28 Implementation
  29
  30 { Include filerec and textrec structures }
  31 {$i filerec.inc}
  32 {$i textrec.inc}
  33
  34 {******************************************************************************
  35                           Basic Socket Functions
  36 ******************************************************************************}
  37
  38 Function socket(Domain,SocketType,Protocol:Longint):Longint;
  39 begin
  40   Socket:=WinSock.Socket(Domain,SocketType,ProtoCol);
  41   if Socket<0 then
  42     SocketError:=WSAGetLastError
  43   else
  44     SocketError:=0;
  45 end;
  46
  47 Function Send(Sock:Longint;Var Addr;AddrLen,Flags:Longint):Longint;
  48 begin
  49   Send:=WinSock.Send(Sock,Addr,AddrLen,Flags);
  50   if Send<0 then
  51     SocketError:=WSAGetLastError
  52   else
  53     SocketError:=0;
  54 end;
  55
  56 Function Recv(Sock:Longint;Var Addr;AddrLen,Flags:Longint):Longint;
  57 begin
  58   Recv:=WinSock.Recv(Sock,Addr,AddrLen,Flags);
  59   if Recv<0 then
  60     SocketError:=WSAGetLastError
  61   else
  62     SocketError:=0;
  63 end;
  64
  65 Function Bind(Sock:Longint;Var Addr;AddrLen:Longint):Boolean;
  66
  67   var
  68      l : longint;
  69
  70 begin
  71   l:=WinSock.Bind(Sock,WinSock.PSockAddr(@Addr),AddrLen);
  72   if l<0 then
  73     begin
  74        SocketError:=WSAGetLastError;
  75        Bind:=false;
  76     end
  77   else
  78     begin
  79        SocketError:=0;
  80        Bind:=true;
  81     end;
  82 end;
  83
  84 Function Listen(Sock,MaxConnect:Longint):Boolean;
  85
  86   var
  87      l : longint;
  88
  89 begin
  90   l:=WinSock.Listen(Sock,MaxConnect);
  91   if l<0 then
  92     begin
  93        SocketError:=WSAGetLastError;
  94        Listen:=false;
  95     end
  96   else
  97     begin
  98        SocketError:=0;
  99        Listen:=true;
 100     end;
 101 end;
 102
 103 Function Accept(Sock:Longint;Var Addr;Var Addrlen:Longint):Longint;
 104 begin
 105   Accept:=WinSock.Accept(Sock,WinSock.PSockAddr(@Addr),plongint(@AddrLen));
 106   if Accept<0 then
 107     SocketError:=WSAGetLastError
 108   else
 109     SocketError:=0;
 110 end;
 111
 112 Function Connect(Sock:Longint;Var Addr;Addrlen:Longint):Boolean;
 113
 114 begin
 115   Connect:=WinSock.Connect(Sock,WinSock.TSockAddr(Addr),AddrLen)=0;
 116   if not Connect then
 117     SocketError:=WSAGetLastError
 118   else
 119     SocketError:=0;
 120 end;
 121
 122 Function Shutdown(Sock:Longint;How:Longint):Longint;
 123 begin
 124   ShutDown:=WinSock.ShutDown(Sock,How);
 125   if ShutDown<0 then
 126     SocketError:=WSAGetLastError
 127   else
 128     SocketError:=0;
 129 end;
 130
 131 Function GetSocketName(Sock:Longint;Var Addr;Var Addrlen:Longint):Longint;
 132 begin
 133   GetSocketName:=WinSock.GetSockName(Sock,WinSock.TSockAddr(Addr),AddrLen);
 134   if GetSocketName<0 then
 135     SocketError:=WSAGetLastError
 136   else
 137     SocketError:=0;
 138 end;
 139
 140 Function GetPeerName(Sock:Longint;Var Addr;Var Addrlen:Longint):Longint;
 141 begin
 142   GetPeerName:=WinSock.GetPeerName(Sock,WinSock.TSockAddr(Addr),AddrLen);
 143   if GetPeerName<0 then
 144     SocketError:=WSAGetLastError
 145   else
 146     SocketError:=0;
 147 end;
 148
 149 Function SetSocketOptions(Sock,Level,OptName:Longint;Var OptVal;optlen:longint):Longint;
 150 begin
 151   SetSocketOptions:=WinSock.SetSockOpt(Sock,Level,OptName,OptVal,OptLen);
 152   if SetSocketOptions<0 then
 153     SocketError:=WSAGetLastError
 154   else
 155     SocketError:=0;
 156 end;
 157
 158 Function GetSocketOptions(Sock,Level,OptName:Longint;Var OptVal;Var optlen:longint):Longint;
 159 begin
 160   GetSocketOptions:=WinSock.GetSockOpt(Sock,Level,OptName,OptVal,OptLen);
 161   if GetSocketOptions<0 then
 162     SocketError:=WSAGetLastError
 163   else
 164     SocketError:=0;
 165 end;
 166
 167 Function SocketPair(Domain,SocketType,Protocol:Longint;var Pair:TSockArray):Longint;
 168 begin
 169   // SocketPair:=SocketCall(Socket_Sys_SocketPair,Domain,SocketType,Protocol,longint(@Pair),0,0);
 170 end;
 171
 172
 173 { mimic the linux fdWrite/fdRead calls for the file/text socket wrapper }
 174 function fdWrite(handle : longint;var bufptr;size : dword) : dword;
 175 begin
 176   fdWrite := WinSock.send(handle, bufptr, size, 0);
 177   if fdWrite = SOCKET_ERROR then
 178   begin
 179     SocketError := WSAGetLastError;
 180     fdWrite := 0;
 181   end
 182   else
 183     SocketError := 0;
 184 end;
 185
 186 function fdRead(handle : longint;var bufptr;size : dword) : dword;
 187   var
 188      d : dword;
 189
 190   begin
 191      if ioctlsocket(handle,FIONREAD,@d) = SOCKET_ERROR then
 192        begin
 193          SocketError:=WSAGetLastError;
 194          fdRead:=0;
 195          exit;
 196        end;
 197      if d>0 then
 198        begin
 199          if size>d then
 200            size:=d;
 201          fdRead := WinSock.recv(handle, bufptr, size, 0);
 202          if fdRead = SOCKET_ERROR then
 203          begin
 204            SocketError:= WSAGetLastError;
 205            fdRead := 0;
 206          end else
 207            SocketError:=0;
 208        end
 209      else
 210        SocketError:=0;
 211   end;
 212
 213
 214 {$i sockets.inc}
 215
 216 { winsocket stack needs an init. and cleanup code }
 217 var
 218   wsadata : twsadata;
 219
 220 initialization
 221   WSAStartUp($2,wsadata);
 222 finalization
 223   WSACleanUp;
 224 end.
 225 {
 226   $Log$
 227   Revision 1.1  2002/02/19 08:26:27  sasu
 228   Initial revision
 229
 230   Revision 1.1.2.2  2000/07/28 08:36:16  sg
 231   * Applied patch by Markus Kaemmerer: Fixes fdRead and fdWrite
 232
 233   Revision 1.1.2.1  2000/07/28 06:33:27  sg
 234   * Applied patch to "Connect" by Markus Kaemmerer: WinSock.Connect returns
 235     zero when it succeeded, and not vice versa.
 236
 237   Revision 1.1  2000/07/13 06:31:22  michael
 238   + Initial import
 239
 240   Revision 1.7  2000/06/21 22:26:47  pierre
 241    * use ioctlsocket in fdRead
 242
 243   Revision 1.6  2000/06/19 13:32:18  michael
 244   + Corrected GetSocketOptions
 245
 246   Revision 1.5  2000/02/09 16:59:34  peter
 247     * truncated log
 248
 249   Revision 1.4  2000/01/07 16:41:52  daniel
 250     * copyright 2000
 251
 252   Revision 1.3  2000/01/07 16:32:34  daniel
 253     * copyright 2000 added
 254
 255 }