123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159 |
- {
- <partof>
- Copyright (c) 1998 by <yourname>
- <infoline>
- See the file COPYING.FPC, included in this distribution,
- for details about the copyright.
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
- **********************************************************************}
- unit netware;
- interface
- const
- NlmLib = 'nlmlib.nlm';
- type
- fdSet=array[0..7] of longint;{=256 bits}
- pfdset=^fdset;
- TFDSet=fdset;
- timeval = packed record
- sec,usec:longint
- end;
- ptimeval=^timeval;
- TTimeVal=timeval;
- Function Select(N:longint;readfds,writefds,exceptfds:PFDSet;TimeOut:PTimeVal):longint; CDECL; EXTERNAL NlmLib NAME 'select';
- Function Select(N:longint;readfds,writefds,exceptfds:PFDSet;TimeOut:Longint):longint;
- Function SelectText(var T:Text;TimeOut :PTimeVal):Longint;
- Procedure FD_Zero(var fds:fdSet);
- Procedure FD_Clr(fd:longint;var fds:fdSet);
- Procedure FD_Set(fd:longint;var fds:fdSet);
- Function FD_IsSet(fd:longint;var fds:fdSet):boolean;
- Function GetFS (var T:Text):longint;
- Function GetFS(Var F:File):longint;
- implementation
- Function Select(N:longint;readfds,writefds,exceptfds:PFDSet;TimeOut:Longint):longint;
- {
- Select checks whether the file descriptor sets in readfs/writefs/exceptfs
- have changed.
- This function allows specification of a timeout as a longint.
- }
- var
- p : PTimeVal;
- tv : TimeVal;
- begin
- if TimeOut=-1 then
- p:=nil
- else
- begin
- tv.Sec:=Timeout div 1000;
- tv.Usec:=(Timeout mod 1000)*1000;
- p:=@tv;
- end;
- Select:=Select(N,Readfds,WriteFds,ExceptFds,p);
- end;
- Function SelectText(var T:Text;TimeOut :PTimeval):Longint;
- Var
- F:FDSet;
- begin
- if textrec(t).mode=fmclosed then
- begin
- {LinuxError:=Sys_EBADF;}
- exit(-1);
- end;
- FD_Zero(f);
- FD_Set(textrec(T).handle,f);
- if textrec(T).mode=fminput then
- SelectText:=select(textrec(T).handle+1,@f,nil,nil,TimeOut)
- else
- SelectText:=select(textrec(T).handle+1,nil,@f,nil,TimeOut);
- end;
- {--------------------------------
- FiledescriptorSets
- --------------------------------}
- Procedure FD_Zero(var fds:fdSet);
- {
- Clear the set of filedescriptors
- }
- begin
- FillChar(fds,sizeof(fdSet),0);
- end;
- Procedure FD_Clr(fd:longint;var fds:fdSet);
- {
- Remove fd from the set of filedescriptors
- }
- begin
- fds[fd shr 5]:=fds[fd shr 5] and (not (1 shl (fd and 31)));
- end;
- Procedure FD_Set(fd:longint;var fds:fdSet);
- {
- Add fd to the set of filedescriptors
- }
- begin
- fds[fd shr 5]:=fds[fd shr 5] or (1 shl (fd and 31));
- end;
- Function FD_IsSet(fd:longint;var fds:fdSet):boolean;
- {
- Test if fd is part of the set of filedescriptors
- }
- begin
- FD_IsSet:=((fds[fd shr 5] and (1 shl (fd and 31)))<>0);
- end;
- Function GetFS (var T:Text):longint;
- {
- Get File Descriptor of a text file.
- }
- begin
- if textrec(t).mode=fmclosed then
- exit(-1)
- else
- GETFS:=textrec(t).Handle
- end;
- Function GetFS(Var F:File):longint;
- {
- Get File Descriptor of an unTyped file.
- }
- begin
- { Handle and mode are on the same place in textrec and filerec. }
- if filerec(f).mode=fmclosed then
- exit(-1)
- else
- GETFS:=filerec(f).Handle
- end;
- end.
|