netware.pp 3.2 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164
  1. {
  2. <partof>
  3. Copyright (c) 1998 by <yourname>
  4. <infoline>
  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. unit netware;
  12. interface
  13. const
  14. NlmLib = 'nlmlib.nlm';
  15. type
  16. fdSet=array[0..7] of longint;{=256 bits}
  17. pfdset=^fdset;
  18. TFDSet=fdset;
  19. timeval = packed record
  20. sec,usec:longint
  21. end;
  22. ptimeval=^timeval;
  23. TTimeVal=timeval;
  24. Function Select(N:longint;readfds,writefds,exceptfds:PFDSet;TimeOut:PTimeVal):longint; CDECL; EXTERNAL NlmLib NAME 'select';
  25. Function Select(N:longint;readfds,writefds,exceptfds:PFDSet;TimeOut:Longint):longint;
  26. Function SelectText(var T:Text;TimeOut :PTimeVal):Longint;
  27. Procedure FD_Zero(var fds:fdSet);
  28. Procedure FD_Clr(fd:longint;var fds:fdSet);
  29. Procedure FD_Set(fd:longint;var fds:fdSet);
  30. Function FD_IsSet(fd:longint;var fds:fdSet):boolean;
  31. Function GetFS (var T:Text):longint;
  32. Function GetFS(Var F:File):longint;
  33. implementation
  34. { Get the definitions of textrec and filerec }
  35. {$i textrec.inc}
  36. {$i filerec.inc}
  37. Function Select(N:longint;readfds,writefds,exceptfds:PFDSet;TimeOut:Longint):longint;
  38. {
  39. Select checks whether the file descriptor sets in readfs/writefs/exceptfs
  40. have changed.
  41. This function allows specification of a timeout as a longint.
  42. }
  43. var
  44. p : PTimeVal;
  45. tv : TimeVal;
  46. begin
  47. if TimeOut=-1 then
  48. p:=nil
  49. else
  50. begin
  51. tv.Sec:=Timeout div 1000;
  52. tv.Usec:=(Timeout mod 1000)*1000;
  53. p:=@tv;
  54. end;
  55. Select:=Select(N,Readfds,WriteFds,ExceptFds,p);
  56. end;
  57. Function SelectText(var T:Text;TimeOut :PTimeval):Longint;
  58. Var
  59. F:FDSet;
  60. begin
  61. if textrec(t).mode=fmclosed then
  62. begin
  63. {LinuxError:=Sys_EBADF;}
  64. exit(-1);
  65. end;
  66. FD_Zero(f);
  67. FD_Set(textrec(T).handle,f);
  68. if textrec(T).mode=fminput then
  69. SelectText:=select(textrec(T).handle+1,@f,nil,nil,TimeOut)
  70. else
  71. SelectText:=select(textrec(T).handle+1,nil,@f,nil,TimeOut);
  72. end;
  73. {--------------------------------
  74. FiledescriptorSets
  75. --------------------------------}
  76. Procedure FD_Zero(var fds:fdSet);
  77. {
  78. Clear the set of filedescriptors
  79. }
  80. begin
  81. FillChar(fds,sizeof(fdSet),0);
  82. end;
  83. Procedure FD_Clr(fd:longint;var fds:fdSet);
  84. {
  85. Remove fd from the set of filedescriptors
  86. }
  87. begin
  88. fds[fd shr 5]:=fds[fd shr 5] and (not (1 shl (fd and 31)));
  89. end;
  90. Procedure FD_Set(fd:longint;var fds:fdSet);
  91. {
  92. Add fd to the set of filedescriptors
  93. }
  94. begin
  95. fds[fd shr 5]:=fds[fd shr 5] or (1 shl (fd and 31));
  96. end;
  97. Function FD_IsSet(fd:longint;var fds:fdSet):boolean;
  98. {
  99. Test if fd is part of the set of filedescriptors
  100. }
  101. begin
  102. FD_IsSet:=((fds[fd shr 5] and (1 shl (fd and 31)))<>0);
  103. end;
  104. Function GetFS (var T:Text):longint;
  105. {
  106. Get File Descriptor of a text file.
  107. }
  108. begin
  109. if textrec(t).mode=fmclosed then
  110. exit(-1)
  111. else
  112. GETFS:=textrec(t).Handle
  113. end;
  114. Function GetFS(Var F:File):longint;
  115. {
  116. Get File Descriptor of an unTyped file.
  117. }
  118. begin
  119. { Handle and mode are on the same place in textrec and filerec. }
  120. if filerec(f).mode=fmclosed then
  121. exit(-1)
  122. else
  123. GETFS:=filerec(f).Handle
  124. end;
  125. end.