home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 21 / CD_ASCQ_21_040595.iso / dos / prg / pas / nwtp06 / sematest.pas < prev    next >
Pascal/Delphi Source File  |  1995-03-01  |  3KB  |  92 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,1995 R.Spronk }
  11.  
  12. USES Crt,nwMisc,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( 'TestSemaphore', 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, 3*18 )  { 0 = Don't wait }
  39.  then begin
  40.       if ( nwSema.Result = $FE )
  41.        then begin
  42.         writeln( 'Sorry, all of the slots for this resource are currently in use' );
  43.         halt(1);
  44.         end
  45.        else begin
  46.             writeln('WaitOnSemaphore returned eror# ',nwSema.result);
  47.             halt(1);
  48.             end;
  49.       end;
  50.  
  51.  
  52. clrscr;
  53. gotoxy(1,4);
  54. Writeln('Testing semaphore functions.');
  55. writeln('Workstation ',INITIAL_SEMAPHORE_VALUE+1,' that starts this testprogram');
  56. writeln('(concurrently) will be refused access to the (imaginary) resource.');
  57. gotoxy( 24,24 );
  58. write( 'Press any key to exit' );
  59.  
  60. IF NOT ExamineSemaphore( semHandle, semValue, openCount )
  61.  then begin
  62.       writeln('Error while examining semaphore value. Error #',nwSema.Result);
  63.       Halt(1);
  64.       end;
  65.  
  66. { Wait loop }
  67. while ( NOT done )
  68. do begin
  69.    gotoxy( 1,23 );
  70.    write( 'Semaphore Test --> Open at [',openCount,
  71.       '] stations *** Value is [',semValue,']              ');
  72.    t:=0;
  73.    While (t<100) and (not done)
  74.    do begin
  75.       delay(WAIT_SECONDS*10); { wait a while };
  76.       done:=KeyPressed;
  77.       inc(t);
  78.       end;
  79.  
  80.    gotoxy( 60,23 );
  81.    write( 'Checking...' ); Delay(500); { wait half a sec }
  82.  
  83.    IF NOT ExamineSemaphore( semHandle, semValue, openCount )
  84.     then writeln('ExamnineSemaphore2 error#',nwsema.result);
  85.    end;
  86.  
  87. { Signal Semaphore (that we're through with the resource) }
  88. SignalSemaphore( semHandle );
  89. { Close Semaphore }
  90. CloseSemaphore( semHandle );
  91. end.
  92.