sockets.inc 4.6 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187
  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 := fmAppend;
  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. {Output}
  81. Assign(SockOut,'.');
  82. FileRec(SockOut).Handle:=Sock;
  83. FileRec(SockOut).RecSize:=1;
  84. FileRec(SockOut).userdata[1]:=S_OUT;
  85. end;
  86. {******************************************************************************
  87. InetSock
  88. ******************************************************************************}
  89. Function DoAccept(Sock:longint;Var addr:TInetSockAddr):longint;
  90. Var AddrLen : Longint;
  91. begin
  92. AddrLEn:=SizeOf(Addr);
  93. DoAccept:=Accept(Sock,Addr,AddrLen);
  94. end;
  95. Function DoConnect(Sock:longint;const addr: TInetSockAddr): Boolean;
  96. begin
  97. DoConnect:=Connect(Sock,Addr,SizeOF(TInetSockAddr));
  98. end;
  99. Function Connect(Sock:longint;const addr: TInetSockAddr;var SockIn,SockOut:text):Boolean;
  100. begin
  101. Connect:=DoConnect(Sock,addr);
  102. If Connect then
  103. Sock2Text(Sock,SockIn,SockOut);
  104. end;
  105. Function Connect(Sock:longint;const addr:TInetSockAddr;var SockIn,SockOut:file):Boolean;
  106. begin
  107. Connect:=DoConnect(Sock,addr);
  108. If Connect then
  109. Sock2File(Sock,SockIn,SockOut);
  110. end;
  111. Function Accept(Sock:longint;var addr:TInetSockAddr;var SockIn,SockOut:text):Boolean;
  112. var
  113. s : longint;
  114. begin
  115. S:=DoAccept(Sock,addr);
  116. if S>0 then
  117. begin
  118. Sock2Text(S,SockIn,SockOut);
  119. Accept:=true;
  120. end
  121. else
  122. Accept:=false;
  123. end;
  124. Function Accept(Sock:longint;var addr:TInetSockAddr;var SockIn,SockOut:File):Boolean;
  125. var
  126. s : longint;
  127. begin
  128. S:=DoAccept(Sock,addr);
  129. if S>0 then
  130. begin
  131. Sock2File(S,SockIn,SockOut);
  132. Accept:=true;
  133. end
  134. else
  135. Accept:=false;
  136. end;
  137. {
  138. $Log$
  139. Revision 1.7 2003-11-22 10:32:41 marco
  140. fix from johill
  141. Revision 1.6 2003/09/15 07:55:29 marco
  142. * fixed typo
  143. Revision 1.5 2003/09/15 07:51:09 marco
  144. * fix
  145. Revision 1.4 2003/09/14 20:15:01 marco
  146. * Unix reform stage two. Remove all calls from Unix that exist in Baseunix.
  147. Revision 1.3 2002/09/07 15:07:46 peter
  148. * old logs removed and tabs fixed
  149. }