home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / PASCAL / NWTP04 / XSEMA / SEMATEST.PAS
Pascal/Delphi Source File  |  1993-12-29  |  2KB  |  80 lines
  1. {$X+,V-,B-}
  2. Program SemaTest;
  3.  
  4. {                                                                       */
  5. /* SemaTest - Tests semaphores by showing application metering example  */
  6. /*                                                                      */
  7. /* by Charles Rose                                                      */
  8. /*                                                                      */}
  9.  
  10. { Testprogram for the nwSema unit, this version (c) 1994, R.Spronk }
  11.  
  12. USES Dos,Crt,nwSema;
  13.  
  14. CONST
  15.  INITIAL_SEMAPHORE_VALUE=2;
  16.  WAIT_SECONDS=2;
  17.  
  18. { Global data }
  19. VAR openCount :Word;
  20.     semValue  :Integer;
  21.     semHandle :LongInt;
  22.     done      :boolean;
  23.     t         :Byte;
  24.  
  25. BEGIN {main}
  26.  
  27. done := False;
  28.  
  29. { Open Semaphore }
  30. semValue := INITIAL_SEMAPHORE_VALUE;  { Need in case we're creating the semaphore }
  31. IF NOT OpenSemaphore( 'Semaphore Test', semValue, semHandle, openCount )
  32.  then begin
  33.       writeln('Error opening semaphore. error #',nwSema.Result);
  34.       Halt(1);
  35.       end;
  36.  
  37. { Wait on the Semaphore (get permission to use the resource) }
  38. IF NOT WaitOnSemaphore( semHandle, 0 )  { 0 = Don't wait }
  39.  then if ( nwSema.Result = $FE )
  40.       then begin
  41.        writeln( 'Sorry, all of the slots for this resource are currently in use' );
  42.        halt(1);
  43.        end;
  44.  
  45. clrscr;
  46. gotoxy( 24,24 );
  47. write( 'Press any key to exit' );
  48.  
  49. IF NOT ExamineSemaphore( semHandle, semValue, openCount )
  50.  then begin
  51.       writeln('Error while examining semaphore value. Error #',nwSema.Result);
  52.       Halt(1);
  53.       end;
  54.  
  55. { Wait loop }
  56. while ( NOT done )
  57. do begin
  58.    gotoxy( 1,23 );
  59.    write( 'Semaphore Test --> Open at [',openCount,
  60.       '] stations *** Value is [',semValue,']             ');
  61.    t:=0;
  62.    While (t<100) and (not done)
  63.    do begin
  64.       delay(WAIT_SECONDS*10); { wait a while };
  65.       done:=KeyPressed;
  66.       inc(t);
  67.       end;
  68.  
  69.    gotoxy( 60,23 );
  70.    write( 'Checking...' ); Delay(500); { wait half a sec }
  71.  
  72.    ExamineSemaphore( semHandle, semValue, openCount );
  73.    end;
  74.  
  75. { Signal Semaphore (that we're through with the resource) }
  76. SignalSemaphore( semHandle );
  77. { Close Semaphore }
  78. CloseSemaphore( semHandle );
  79. end.
  80.