home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / PASCAL / NWTP04 / NWSEMA.PAS < prev    next >
Pascal/Delphi Source File  |  1994-01-01  |  14KB  |  394 lines
  1. {$X+,V-,B-}
  2. Unit nwSema;
  3.  
  4. { nwSema unit as of 931228 / NwTP 0.4 API. (c) 1994, R.Spronk }
  5.  
  6. INTERFACE
  7.  
  8. { Primary functions:                    Interrupt: comments:
  9.  
  10. * OpenSemaphore                         (F220/00)
  11. * ExamineSemaphore                      (F220/01)
  12. * WaitOnSemaphore                       (F220/02)
  13. * SignalSemaphore                       (F220/03)
  14. * CloseSemaphore                        (F220/04)
  15.   GetSemaphoreInformation               (F217/F3)
  16.  
  17. Notes: -Functions marked with a '*' are tested and found correct.
  18.  
  19. }
  20.  
  21. Uses nwMisc;
  22.  
  23. Var Result:word;
  24.  
  25. {C500 [2.0/2.1/3.x]}
  26. FUNCTION OpenSemaphore( SemName :String; InitVal :Integer;
  27.                         VAR SemHandle :LongInt;
  28.                         VAR OpenCount :Word               ) :Boolean;
  29. { Semaphores are used for exclusion when record locking is not appropriate }
  30. { The value is set the first time the semaphore is opened, thereafter you }
  31. { must use wait semaphore or signal semaphore to change the value }
  32.  
  33. {C501 [2.0/2.1/3.x]}
  34. FUNCTION ExamineSemaphore( SemHandle :LongInt;
  35.                            VAR Value     :Integer;
  36.                            VAR OpenCount :Word     ) :Boolean;
  37. { This functions returns the current value and open count of a semaphore.}
  38. { The semaphore value is decremented for each WAIT_ON_SEMAPHORE, }
  39. {   and incremented for each SIGNAL_SEMAPHORE.  A negative semaphore }
  40. {   value indicates the number of processes waiting to use the semaphore. }
  41. { Count is the number of processes that are using the same semaphore.}
  42. {   The open count is incremented any time a station opens the semaphore }
  43. {   This can be used for controlling the number of users using your software }
  44. { Value is the current value associates with the semaphore. }
  45.  
  46. {C502 [2.0/2.1/3.x]}
  47. FUNCTION WaitOnSemaphore( SemHandle :LongInt;
  48.                           Wait_Time :Word  ) :Boolean;
  49. { Decrement the semaphore value and, if it is negative,           }
  50. { wait until it becomes non-negative or until a }
  51. { timeout occurs. }
  52.  
  53. {C503 [2.0/2.1/3.x]}
  54. FUNCTION SignalSemaphore(SemHandle:LongInt) : Boolean;
  55. { Increment the semaphore value and release if waiting. If any stations }
  56. { are waiting, the station that has been waiting the longest will be }
  57. { signalled to proceed }
  58.  
  59. {C504 [2.0/2.1/3.x]}
  60. FUNCTION CloseSemaphore(SemHandle:LongInt) : Boolean;
  61. { Decrement the open count of a semaphore.}
  62. {  When the open count goes to zero, the semaphore is destroyed. }
  63. { In other words: if the requesting process is the last process to have
  64.   this semaphore open, the semaphore is deleted.}
  65.  
  66.  
  67. IMPLEMENTATION {=============================================================}
  68.  
  69. uses dos;
  70.  
  71. {F:C500 [2.x/3.x]}
  72. FUNCTION OpenSemaphore(SemName : String; InitVal : Integer;
  73.                         VAR SemHandle : LongInt;
  74.                         VAR OpenCount : Word)             : Boolean;
  75. Var Regs:Registers;
  76. BEGIN
  77. WITH Regs
  78. DO BEGIN
  79.    IF (InitVal < 0) OR (InitVal > 127)
  80.     THEN BEGIN
  81.          Result:=$FF;                          { Invalid Semaphore Value }
  82.          OpenSemaphore := False;    { InitVal must be between 0 and 127 }
  83.          Exit;
  84.          END;
  85.    IF (SemName[0]>#127)                { Semaphore must not exceed 127 chars }
  86.     THEN BEGIN
  87.          Result:=$FE;                    { Invalid Semaphore name Length }
  88.          OpenSemaphore := false;
  89.          Exit;
  90.          END;
  91.     AH := $C5;                                      { Semaphore function }
  92.     AL := $00;                                   { Sub-Function 0 = open }
  93.     DS := Seg(SemName);                           { DS:DX points to name }
  94.     DX := Ofs(SemName);                         { Byte 0 = length 0..127 }
  95.     CL := InitVal;                                { Initial Value 0..127 }
  96.  
  97.     MsDos(Regs);                                    { Give it to Int 21h }
  98.  
  99.     OpenCount := BL;              { Number of users using this semaphore }
  100.     Result:=AL;
  101.     OpenSemaphore := (AL = 0);                { OK if AL comes back as 0 }
  102.                                       { FEh Invalid Semaphore Name Length}
  103.                                       { FFh Invalid Semaphore Value      }
  104.     SemHandle:=MakeLong(CX,DX);       { CX:DX holds the semaphore handle }
  105.   END;                                                    { with Regs do }
  106. END;                                            {Function Open_Semaphore }
  107.  
  108.  
  109. {F:C501 [2.x/3.x]}
  110. FUNCTION ExamineSemaphore(SemHandle:LongInt;
  111.                            VAR Value     : Integer;
  112.                            VAR OpenCount : Word  )  : Boolean;
  113. { The semaphore value that comes back in CL is the count from the open call }
  114. { DL represents the current open count - the open count is incremented }
  115. { anytime  a station opens the semaphore this can be used for controlling }
  116. { the number of users using your software }
  117. Var Regs:Registers;
  118. BEGIN
  119. WITH Regs
  120.  DO BEGIN
  121.     AH := $C5;                                 { Semaphore function call }
  122.     AL := 1;                                  { Sub-Function 1 = examine }
  123.     CX := HiLong(SemHandle);
  124.     DX := LowLong(SemHandle);
  125.  
  126.     MsDos(Regs);                                        { Give it to DOS }
  127.  
  128.     Value := CX;                                 { Semaphore value in CX }
  129.     OpenCount := DL;                       { Number using this semaphore }
  130.     Result := AL;                              { AL = $FF invalid handle }
  131.     ExamineSemaphore := (AL = 0);                     { AL = 0 means OK }
  132.     END;
  133. END;                                        { function Examine_Semaphore }
  134.  
  135. {F:C502 [2.x/3.x]}
  136. FUNCTION WaitOnSemaphore( SemHandle : LongInt;
  137.                             Wait_Time : Word  ) : Boolean;
  138. { Decrement the semaphore value and wait if it is negative.  If negative,}
  139. { the workstation will wait until it becomes non-negative or until a }
  140. { timeout occurs. }
  141. Var regs:registers;
  142. BEGIN
  143. WITH Regs
  144. DO BEGIN
  145.    AH := $C5;                                 { Semaphore function call }
  146.    AL := 2;                                     { Sub-Function 2 = wait }
  147.    BP := Wait_Time;                      { In 1/18 seconds, 0 = No wait }
  148.    CX := HiLong(SemHandle);
  149.    DX := LowLong(SemHandle);
  150.  
  151.    MsDos(Regs);                                        { Give it to DOS }
  152.  
  153.    Result:=AL;
  154.    WaitOnSemaphore := (AL = 0);             { AL = $00 means OK,
  155.                                                      $FE timeout failure,
  156.                                                      $FF Invalid handle }
  157.   END;
  158. END;                                          { function Wait_Semaphore }
  159.  
  160. {C503 [2.x/3.x]}
  161. FUNCTION SignalSemaphore(SemHandle:LongInt) : Boolean;
  162. { Increment the semaphore value and release if waiting.  If any stations}
  163. { are waiting, the station that has been waiting the longest will be    }
  164. { signalled to proceed }
  165. Var Regs:Registers;
  166. BEGIN
  167. WITH Regs
  168. DO BEGIN
  169.     AH := $C5;                                 { Semaphore function call }
  170.     AL := 3;                                   { Sub-Function 3 = signal }
  171.     CX := HiLong(SemHandle);
  172.     DX := LowLong(SemHandle);
  173.  
  174.     MsDos(Regs);                                        { Give it to DOS }
  175.  
  176.     Result:=AL;
  177.     SignalSemaphore := (AL = 0); { AL = $00 means OK, else
  178.                                          $01 overflow ( value > 127 ) or
  179.                                          $FF Invalid handle }
  180.   END;
  181. END;                                         { function Signal_Semaphore }
  182.  
  183. {C504 [2.x/3.x]}
  184. FUNCTION CloseSemaphore(SemHandle:LongInt) : Boolean;
  185. { Decrement the open count of a semaphore.  When the open count goes     }
  186. { to zero, the semaphore is destroyed.                                   }
  187. Var Regs:Registers;
  188. BEGIN
  189. WITH Regs
  190. DO BEGIN
  191.     AH := $C5;                                  { Semaphore function call }
  192.     AL := 04;                                    { Sub-Function 4 = close }
  193.     CX := HiLong(SemHandle);
  194.     DX := LowLong(SemHandle);
  195.  
  196.     MsDos(Regs);                                          { Give it to DOS }
  197.  
  198.     Result:=AL;
  199.     CloseSemaphore := (AL = 0);     { AL = 0 means OK, FF: Invalid handle  }
  200.   END;
  201. END;                                            { function Close_Semaphore }
  202.  
  203.  
  204.  
  205. {E3E1 [2.1x/2.2]
  206. GET CONNECTION'S SEMAPHORES
  207.     AH = E3h subfn E1h
  208.     DS:SI -> request buffer (see below)
  209.     ES:DI -> reply buffer (see below)
  210. Return: AL = status
  211.         00h successful
  212.         C6h no console rights
  213. Notes:    this function is supported by Advanced NetWare 2.1+
  214.     the calling workstation must have console operator privileges
  215. SeeAlso: AH=E3h/SF=C8h,AH=E3h/SF=DBh,AH=E3h/SF=DFh,AH=E3h/SF=E2h
  216.  
  217. Format of request buffer:
  218. Offset    Size    Description
  219.  00h    WORD    0005h (length of following data)
  220.  02h    BYTE    E1h (subfunction "Get Connection's Semaphores")
  221.  03h    WORD    (big-endian) logical connection number
  222.  05h    WORD    (big-endian) last record seen (0000h on first call)
  223.  
  224. Format of reply buffer:
  225. Offset    Size    Description
  226.  00h    WORD    (call) size of following results record (max 1FEh)
  227.  02h    WORD    next request record (place in "last record" field on next call)
  228.  04h    BYTE    number of records following
  229.  05h    var    array of Semaphore Information Records
  230.  
  231. Format of Semaphore Information Record:
  232. Offset    Size    Description
  233.  00h    WORD    (big-endian) open count
  234.  02h    BYTE    semaphore value (-128 to 127)
  235.  03h    BYTE    task number
  236.  04h    BYTE    lock type
  237.  05h    BYTE    length of semaphore's name
  238.  06h  N BYTEs    semaphore's name
  239.      14 BYTEs    filename}
  240.  
  241.  
  242. {E3E2 [2.1x/2.2]
  243. GET SEMAPHORE INFORMATION
  244.     AH = E3h subfn E2h
  245.     DS:SI -> request buffer (see below)
  246.     ES:DI -> reply buffer (see below)
  247. Return: AL = status
  248.         00h successful
  249.         C6h no console rights
  250. Notes:    this function is supported by Advanced NetWare 2.1+
  251.     the calling workstation must have console operator privileges
  252. SeeAlso: AH=E3h/SF=C8h,AH=E3h/SF=E1h
  253.  
  254. Format of request buffer:
  255. Offset    Size    Description
  256.  00h    WORD    length of following data (max 83h)
  257.  02h    BYTE    E2h (subfunction "Get LAN Driver's Configuration Information")
  258.  03h    WORD    (big-endian) last record seen (0000h on first call)
  259.  05h    BYTE    length of semaphore's name (01h-7Fh)
  260.  06h  N BYTEs    semaphore's name
  261.  
  262. Format of reply buffer:
  263. Offset    Size    Description
  264.  00h    WORD    (call) size of following results buffer (max 1FEh)
  265.  02h    WORD    next request record (place in "last record" on next call)
  266.         0000h if no more
  267.  04h    WORD    (big-endian) number of logical connections opening semaphore
  268.  06h    BYTE    semaphore value (-127 to 128)
  269.  07h    BYTE    number of records following
  270.  08h    var    array of Semaphore Information records (see below)
  271.  
  272. Format of Semaphore Information:
  273. Offset    Size    Description
  274.  00h    WORD    (big-endian) logical connection number
  275.  02h    BYTE    task number}
  276.  
  277. {F217/F3 [3.11+]}
  278. Function GetSemaphoreInformation(SemaName:string;
  279.                             {i/o:} Var ReqRecordNbr:Integer;
  280.                             {out:} Var openCount:word;
  281.                                    Var semValue:byte;
  282.                                    Var connections:TconnectionList):boolean;
  283.  
  284. {   This call returns information about a single semaphore.  The
  285.     values returned are similiar to those returned in the old
  286.     version of this call.  This function may be called iteratively
  287.     to return all of the connection information for the specified
  288.     semaphore. }
  289. { 2.x: ?? if there are no more records, ReqRecordNbr is set to 0... }
  290. { need console rights to do this.. }
  291. { The function returns the connectionNumbers and taskNumbers as words.
  292.   for the sake of compatibilty, they are returned as bytes. Not too many
  293.   >250 user licences floating around.. I hope.. }
  294. Var req:record
  295.         len      :word; {lo-hi !}
  296.         subF     :byte;
  297.         lastRec  :word; {hi-lo, initially 0 }
  298.         _semaName:string; { max len=128 }
  299.         end;
  300.     reply:record
  301.           nextRec        :word; {hi-lo }
  302.           _OpenCount     :word; {hi-lo }
  303.           _semValue      :byte;
  304.                      { ?? Opencount:byte en semvalue:word ?? }
  305.           NumberOfRecords:word; {hi-lo }
  306.           _connTask:array[1..100] of record
  307.                                      connNbr,      {hi-lo !}
  308.                                      taskNbr:word; {hi-lo !}
  309.                                      end;
  310.           end;
  311.    regs:registers;
  312.    t:byte;
  313. BEGIN
  314. With req
  315.  do begin
  316.     subF:=$F3;
  317.     if ReqRecordNbr=-1
  318.      then lastRec:=0 { correct false initial value.}
  319.      else lastRec:=swap(ReqRecordNbr); {force hi-lo}
  320.     _semaName:=semaName; UpString(_semaName);
  321.     if semaName[0]>#127 then _semaName[0]:=#127;
  322.     len:=ord(semaName[0])+6;
  323.     end;
  324. With regs
  325.  do begin
  326.     ax := $f217;
  327.     ds:=SEG(req);   si := OFs(req);
  328.     cx:=sizeOf(req);
  329.     es:=SEG(reply); di := OFs(reply);
  330.     dx:=sizeOf(reply);
  331.     MsDos(regs);
  332.     result:=al;
  333.     end;
  334.  
  335. If result=0
  336.  then with reply
  337.        do begin
  338.           FillChar(connections,sizeOf(connections),#0);
  339.           for t:=0 to swap(NumberOfRecords) { <= 100, force lo-hi }
  340.            do begin
  341.               if _connTask[t].connNbr<=$FF
  342.                then connections[t]:=hi(_connTask[t].connNbr); {= LO}
  343.               end;
  344.           Opencount:=swap(_opencount); { force lo-hi }
  345.           ReqRecordNbr:=swap(nextRec); { force lo-hi }
  346.           semValue:=_semValue;
  347.           end;
  348.  
  349. GetSemaphoreInformation:=(result=0);
  350. end;
  351.  
  352.  
  353. {F2/ [2.15c+]
  354. Function    (  {i/o:}  {out: :boolean;
  355.  
  356. Var req:record
  357.         len      :word;
  358.         subF     :byte;
  359.  
  360.         end;
  361.     reply:record
  362.  
  363.           end;
  364.    regs:registers;
  365. BEGIN
  366. With req
  367.  do begin
  368.     subF:=
  369.  
  370.     len:=
  371.     end;
  372. With regs
  373.  do begin
  374.     ax := $f217;
  375.     ds:=SEG(req);   si := OFs(req);
  376.     cx:=sizeOf(req);
  377.     es:=SEG(reply); di := OFs(reply);
  378.     dx:=sizeOf(reply);
  379.     MsDos(regs);
  380.     result:=al;
  381.     end;
  382.  
  383. If result=0
  384.  then with reply
  385.        do begin
  386.  
  387.  
  388.           end;
  389.  
  390.     :=(result=0);
  391. end;}
  392.  
  393. BEGIN
  394. END.