mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-09 07:28:26 +02:00
160 lines
3.2 KiB
ObjectPascal
160 lines
3.2 KiB
ObjectPascal
{
|
|
<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.
|