sockets.inc 4.8 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191
  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 : fdWrite(textrec(f).handle,textrec(f).bufptr^,textrec(f).bufpos);
  30. fminput : textrec(f).BufEnd:=fdRead(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. { Now the writing part. }
  60. Assign(SockOut,'.');
  61. Textrec(SockOut).Handle:=Sock;
  62. Textrec(SockOut).userdata[1]:=S_OUT;
  63. TextRec(SockOut).OpenFunc:=@OpenSock;
  64. TextRec(SockOut).InOutFunc:=@IOSock;
  65. TextRec(SockOut).FlushFunc:=@FlushSock;
  66. TextRec(SockOut).CloseFunc:=@CloseSock;
  67. end;
  68. {******************************************************************************
  69. Untyped File
  70. ******************************************************************************}
  71. Procedure Sock2File(Sock:Longint;Var SockIn,SockOut:File);
  72. begin
  73. {Input}
  74. Assign(SockIn,'.');
  75. FileRec(SockIn).Handle:=Sock;
  76. FileRec(SockIn).RecSize:=1;
  77. FileRec(Sockin).userdata[1]:=S_IN;
  78. {Output}
  79. Assign(SockOut,'.');
  80. FileRec(SockOut).Handle:=Sock;
  81. FileRec(SockOut).RecSize:=1;
  82. FileRec(SockOut).userdata[1]:=S_OUT;
  83. end;
  84. {******************************************************************************
  85. InetSock
  86. ******************************************************************************}
  87. Function DoAccept(Sock:longint;Var addr:TInetSockAddr):longint;
  88. Var AddrLen : Longint;
  89. begin
  90. AddrLEn:=SizeOf(Addr);
  91. DoAccept:=Accept(Sock,Addr,AddrLen);
  92. end;
  93. Function DoConnect(Sock:longint;const addr: TInetSockAddr): Boolean;
  94. begin
  95. DoConnect:=Connect(Sock,Addr,SizeOF(TInetSockAddr));
  96. end;
  97. Function Connect(Sock:longint;const addr: TInetSockAddr;var SockIn,SockOut:text):Boolean;
  98. begin
  99. Connect:=DoConnect(Sock,addr);
  100. If Connect then
  101. Sock2Text(Sock,SockIn,SockOut);
  102. end;
  103. Function Connect(Sock:longint;const addr:TInetSockAddr;var SockIn,SockOut:file):Boolean;
  104. begin
  105. Connect:=DoConnect(Sock,addr);
  106. If Connect then
  107. Sock2File(Sock,SockIn,SockOut);
  108. end;
  109. Function Accept(Sock:longint;var addr:TInetSockAddr;var SockIn,SockOut:text):Boolean;
  110. var
  111. s : longint;
  112. begin
  113. S:=DoAccept(Sock,addr);
  114. if S>0 then
  115. begin
  116. Sock2Text(S,SockIn,SockOut);
  117. Accept:=true;
  118. end
  119. else
  120. Accept:=false;
  121. end;
  122. Function Accept(Sock:longint;var addr:TInetSockAddr;var SockIn,SockOut:File):Boolean;
  123. var
  124. s : longint;
  125. begin
  126. S:=DoAccept(Sock,addr);
  127. if S>0 then
  128. begin
  129. Sock2File(S,SockIn,SockOut);
  130. Accept:=true;
  131. end
  132. else
  133. Accept:=false;
  134. end;
  135. {
  136. $Log$
  137. Revision 1.1 2000-07-13 06:30:48 michael
  138. + Initial import
  139. Revision 1.7 2000/06/21 22:27:50 pierre
  140. * no bufpos reset on flush for fminput
  141. Revision 1.6 2000/05/22 12:38:51 jonas
  142. * CloseSock is now a dummy (it called system.close, but this doesn't
  143. make any sense since itself can only be called by system.close) This
  144. caused an endless loop with my last changes where the mode of a
  145. textrec is set to fmClosed only after the closeFunc() has been called.
  146. Revision 1.5 2000/02/09 16:59:31 peter
  147. * truncated log
  148. Revision 1.4 2000/01/07 16:41:36 daniel
  149. * copyright 2000
  150. Revision 1.3 2000/01/07 16:32:25 daniel
  151. * copyright 2000 added
  152. }