sockets.inc 5.0 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202
  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. See the file COPYING.FPC, included in this distribution,
  6. for details about the copyright.
  7. This program is distributed in the hope that it will be useful,
  8. but WITHOUT ANY WARRANTY; without even the implied warranty of
  9. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  10. **********************************************************************}
  11. {******************************************************************************
  12. Text File Writeln/ReadLn Support
  13. ******************************************************************************}
  14. Procedure OpenSock(var F:Text);
  15. begin
  16. if textrec(f).handle=UnusedHandle then
  17. textrec(f).mode:=fmclosed
  18. else
  19. case textrec(f).userdata[1] of
  20. S_OUT : textrec(f).mode:=fmoutput;
  21. S_IN : textrec(f).mode:=fminput;
  22. else
  23. textrec(f).mode:=fmclosed;
  24. end;
  25. end;
  26. Procedure IOSock(var F:text);
  27. begin
  28. case textrec(f).mode of
  29. fmoutput : {$ifdef unix}fpWrite{$else}fdwrite{$endif}(textrec(f).handle,textrec(f).bufptr^,textrec(f).bufpos);
  30. fminput : textrec(f).BufEnd:={$ifdef Unix}fpRead{$else}fdread{$endif}(textrec(f).handle,textrec(f).bufptr^,textrec(f).bufsize);
  31. end;
  32. textrec(f).bufpos:=0;
  33. end;
  34. Procedure FlushSock(var F:Text);
  35. begin
  36. if (textrec(f).mode=fmoutput) and (textrec(f).bufpos<>0) then
  37. begin
  38. IOSock(f);
  39. textrec(f).bufpos:=0;
  40. end;
  41. end;
  42. Procedure CloseSock(var F:text);
  43. begin
  44. { Nothing special has to be done here }
  45. end;
  46. Procedure Sock2Text(Sock:Longint;Var SockIn,SockOut:Text);
  47. {
  48. Set up two Pascal Text file descriptors for reading and writing)
  49. }
  50. begin
  51. { First the reading part.}
  52. Assign(SockIn,'.');
  53. Textrec(SockIn).Handle:=Sock;
  54. Textrec(Sockin).userdata[1]:=S_IN;
  55. TextRec(SockIn).OpenFunc:=@OpenSock;
  56. TextRec(SockIn).InOutFunc:=@IOSock;
  57. TextRec(SockIn).FlushFunc:=@FlushSock;
  58. TextRec(SockIn).CloseFunc:=@CloseSock;
  59. TextRec(SockIn).Mode := fmInput;
  60. { Now the writing part. }
  61. Assign(SockOut,'.');
  62. Textrec(SockOut).Handle:=Sock;
  63. Textrec(SockOut).userdata[1]:=S_OUT;
  64. TextRec(SockOut).OpenFunc:=@OpenSock;
  65. TextRec(SockOut).InOutFunc:=@IOSock;
  66. TextRec(SockOut).FlushFunc:=@FlushSock;
  67. TextRec(SockOut).CloseFunc:=@CloseSock;
  68. TextRec(SockOut).Mode := fmOutput;
  69. end;
  70. {******************************************************************************
  71. Untyped File
  72. ******************************************************************************}
  73. Procedure Sock2File(Sock:Longint;Var SockIn,SockOut:File);
  74. begin
  75. {Input}
  76. Assign(SockIn,'.');
  77. FileRec(SockIn).Handle:=Sock;
  78. FileRec(SockIn).RecSize:=1;
  79. FileRec(Sockin).userdata[1]:=S_IN;
  80. FileRec(SockIn).Mode := fmInput;
  81. {Output}
  82. Assign(SockOut,'.');
  83. FileRec(SockOut).Handle:=Sock;
  84. FileRec(SockOut).RecSize:=1;
  85. FileRec(SockOut).userdata[1]:=S_OUT;
  86. FileRec(SockOut).Mode := fmOutput;
  87. end;
  88. {******************************************************************************
  89. InetSock
  90. ******************************************************************************}
  91. Function DoAccept(Sock:longint;Var addr:TInetSockAddr):longint;
  92. Var AddrLen : Longint;
  93. begin
  94. AddrLEn:=SizeOf(Addr);
  95. DoAccept:=Accept(Sock,Addr,AddrLen);
  96. end;
  97. Function DoConnect(Sock:longint;const addr: TInetSockAddr): Boolean;
  98. begin
  99. DoConnect:=Connect(Sock,Addr,SizeOF(TInetSockAddr));
  100. end;
  101. Function Connect(Sock:longint;const addr: TInetSockAddr;var SockIn,SockOut:text):Boolean;
  102. begin
  103. Connect:=DoConnect(Sock,addr);
  104. If Connect then
  105. Sock2Text(Sock,SockIn,SockOut);
  106. end;
  107. Function Connect(Sock:longint;const addr:TInetSockAddr;var SockIn,SockOut:file):Boolean;
  108. begin
  109. Connect:=DoConnect(Sock,addr);
  110. If Connect then
  111. Sock2File(Sock,SockIn,SockOut);
  112. end;
  113. Function Accept(Sock:longint;var addr:TInetSockAddr;var SockIn,SockOut:text):Boolean;
  114. var
  115. s : longint;
  116. begin
  117. S:=DoAccept(Sock,addr);
  118. if S>0 then
  119. begin
  120. Sock2Text(S,SockIn,SockOut);
  121. Accept:=true;
  122. end
  123. else
  124. Accept:=false;
  125. end;
  126. Function Accept(Sock:longint;var addr:TInetSockAddr;var SockIn,SockOut:File):Boolean;
  127. var
  128. s : longint;
  129. begin
  130. S:=DoAccept(Sock,addr);
  131. if S>0 then
  132. begin
  133. Sock2File(S,SockIn,SockOut);
  134. Accept:=true;
  135. end
  136. else
  137. Accept:=false;
  138. end;
  139. {
  140. $Log$
  141. Revision 1.11 2003-11-23 10:57:15 michael
  142. + Changed mode to output for file sockets
  143. Revision 1.10 2003/11/22 21:58:09 marco
  144. * johill changed his mind
  145. Revision 1.9 2003/11/22 10:59:58 marco
  146. fix for last one
  147. Revision 1.8 2003/11/22 10:33:38 marco
  148. fix from johill for 2801
  149. Revision 1.7 2003/11/22 10:32:41 marco
  150. fix from johill
  151. Revision 1.6 2003/09/15 07:55:29 marco
  152. * fixed typo
  153. Revision 1.5 2003/09/15 07:51:09 marco
  154. * fix
  155. Revision 1.4 2003/09/14 20:15:01 marco
  156. * Unix reform stage two. Remove all calls from Unix that exist in Baseunix.
  157. Revision 1.3 2002/09/07 15:07:46 peter
  158. * old logs removed and tabs fixed
  159. }