home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / OPBONUS.ZIP / FBROWSE.LZH / NETSEMA.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-06-19  |  3.4 KB  |  152 lines
  1. {
  2.   Turbo Pascal Unit of Semaphore APIs for NetWare
  3.  
  4.   by Richard S. Sadowsky
  5.  
  6.   Please address questions and comments about this unit to ALL in section 6 of
  7.   the PCVENB forum on Compuserve.
  8. }
  9. Unit NetSema;
  10. interface
  11.  
  12. uses
  13.   Dos;
  14.  
  15. type
  16.   SemaphoreName  = String[127];
  17.  
  18. function OpenSemaphore(Name : SemaphoreName; InitialValue : ShortInt;
  19.                        var OpenNumber : Byte;
  20.                        var SemaHandle : LongInt) : Boolean;
  21.  
  22. function ExamineSemaphore(Handle : LongInt; var Value : ShortInt;
  23.                           var OpenNumber : Byte) : Boolean;
  24.  
  25. function WaitOnSemaphore(Handle : LongInt; TimeOutValue : Word;
  26.                          var TimeOut : Boolean) : Boolean;
  27.  
  28. function SignalSemaphore(Handle : LongInt; var OverFlow : Boolean) : Boolean;
  29.  
  30. function CloseSemaphore(Handle : LongInt) : Boolean;
  31.  
  32. implementation
  33. type
  34.   DoubleWord       = record
  35.                        LoWord  : Word;
  36.                        HiWord  : Word;
  37.                      end;
  38.  
  39. function MakeLong(HiWord,LoWord : Word) : LongInt;
  40. {takes hi and lo words and makes a longint }
  41. Inline(
  42.   $58/    { pop ax ; pop low word into AX }
  43.   $5A);   { pop dx ; pop high word into DX }
  44.  
  45. function OpenSemaphore(Name : SemaphoreName; InitialValue : ShortInt;
  46.                        var OpenNumber : Byte;
  47.                        var SemaHandle : LongInt) : Boolean;
  48. var
  49.   Regs : Registers;
  50.  
  51. begin
  52.   with Regs do begin
  53.     AX := $C500;
  54.     DS := Seg(Name);
  55.     DX := Ofs(Name);
  56.     CL := InitialValue;
  57.     MsDos(Regs);
  58.     if AL = 0 then begin
  59.       OpenNumber := BL;
  60.       SemaHandle := MakeLong(DX, CX);
  61.       OpenSemaphore := True;
  62.     end
  63.     else
  64.       OpenSemaphore := False
  65.   end;
  66. end;
  67.  
  68. function ExamineSemaphore(Handle : LongInt; var Value : ShortInt;
  69.                           var OpenNumber : Byte) : Boolean;
  70.  
  71. var
  72.   Regs : Registers;
  73. begin
  74.   with Regs do begin
  75.     AX := $C501;
  76.     CX := DoubleWord(Handle).LoWord;
  77.     DX := DoubleWord(Handle).HiWord;
  78.     MsDos(Regs);
  79.     if AL = 0 then begin
  80.       OpenNumber := DL;
  81.       Value := CX;
  82.       ExamineSemaphore := True;
  83.     end
  84.     else
  85.       ExamineSemaphore := False;
  86.   end;
  87. end;
  88.  
  89. function WaitOnSemaphore(Handle : LongInt; TimeOutValue : Word;
  90.                          var TimeOut : Boolean) : Boolean;
  91. var
  92.   Regs : Registers;
  93.  
  94. begin
  95.   with Regs do begin
  96.     AX := $C502;
  97.     CX := DoubleWord(Handle).LoWord;
  98.     DX := DoubleWord(Handle).HiWord;
  99.     BP := TimeOutValue;
  100.     MsDos(Regs);
  101.     TimeOut := False;
  102.     if AL <> 0 then begin
  103.       if AL = $FF then begin
  104.         WaitOnSemaphore := False;
  105.         Exit;
  106.       end
  107.       else
  108.         TimeOut := True;
  109.     end;
  110.     WaitOnSemaphore := True;
  111.   end;
  112. end;
  113.  
  114. function SignalSemaphore(Handle : LongInt; var OverFlow : Boolean) : Boolean;
  115. var
  116.   Regs : Registers;
  117.  
  118. begin
  119.   with Regs do begin
  120.     AX := $C503;
  121.     CX := DoubleWord(Handle).LoWord;
  122.     DX := DoubleWord(Handle).HiWord;
  123.     MsDos(Regs);
  124.     Overflow := False;
  125.     if AL <> 0 then begin
  126.       if AL = $FF then begin
  127.         SignalSemaphore := False;
  128.         Exit;
  129.       end
  130.       else
  131.         Overflow := True;
  132.     end;
  133.   end;
  134.   SignalSemaphore := True;
  135. end;
  136.  
  137. function CloseSemaphore(Handle : LongInt) : Boolean;
  138. var
  139.   Regs : Registers;
  140.  
  141. begin
  142.   with Regs do begin
  143.     AX := $C504;
  144.     CX := DoubleWord(Handle).LoWord;
  145.     DX := DoubleWord(Handle).HiWord;
  146.     MsDos(Regs);
  147.     CloseSemaphore := AL = 0;
  148.   end;
  149. end;
  150.  
  151. end.
  152.