sockets.inc 4.6 KB

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