home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / PASCAL / PARADIS1 / TIMER.PAS < prev    next >
Pascal/Delphi Source File  |  1991-01-30  |  3KB  |  114 lines
  1. (10689) Sat 25 Jan 92 14:42
  2. By: Chris Barrett
  3. To: Michael Mikelas
  4. Re: Internal timer for door
  5. St:
  6. ---------------------------------------------------------------------------
  7. @EID:cc0a 18397540
  8. @MSGID: 3:690/626.6 2981c04c
  9. @REPLY: 1:129/150.0 297ad3e2
  10. On <Jan 20 08:51>, Michael Mikelas (1:129/150) writes:
  11.  
  12. Hi Michael,
  13.  
  14.  MM>I'm writing a BBS door and have passed the user's time remaining into the
  15.  MM>program via a parameter string...how do I go about setting up an internal
  16.  MM>timer that will exit the program if the user's time expires?  BTW: I'm
  17.  MM>using TP 6.0 if that makes a difference...
  18.  
  19. Here's a unit I wrote...  After the unit is a sample of how I would use it in
  20. your program..
  21.  
  22. (*---------------------------*)
  23.  
  24. Unit Timer;
  25.  
  26. (* Written by Chris Barrett (3:690/626.6) *)
  27. (* Released to the Pubic Domain *)
  28.  
  29. Interface
  30.  
  31. Procedure StartTimer(Time : Word);
  32. Procedure Uninstall_Timer;
  33.  
  34. Var
  35.   TimeUp : Boolean;
  36.  
  37. Implementation
  38.  
  39. Uses
  40.   DOS;
  41.  
  42. Var
  43.   RealInt1C : Pointer;
  44.   Ticks : Longint;
  45.   Sec : Word;
  46.  
  47. Procedure _Timer;
  48. Begin
  49.   Inc(Ticks);
  50.   If Ticks mod 18 = 0 then Dec(Sec);
  51.   If Sec = 0 then TimeUp := True;
  52. End;
  53.  
  54. Procedure FakeInt1C;
  55. Interrupt;
  56. Begin
  57.   _Timer;
  58.   Inline($9C/$FF/$1E/RealInt1C);
  59. End;
  60.  
  61. Procedure Install;
  62. Begin
  63.   GetIntVec($1C,RealInt1C);
  64.   SetIntVec($1C,@FakeInt1C);
  65. End;
  66.  
  67. Procedure Uninstall_Timer;
  68. Begin
  69.   SetIntVec($1C,RealInt1C);
  70. End;
  71.  
  72. Procedure StartTimer(Time : Word);
  73. Begin
  74.   Sec := Time;
  75.   TimeUp := False;
  76. End;
  77.  
  78. Begin
  79.   Install;
  80. End.
  81.  
  82. (*----------------------------*)
  83.  
  84. Put the line "Uses Timer;" at the top of your program.
  85.  
  86. When you want to start the timer with say 'x' seconds remaining call the
  87. procedure 'StartTimer' like this "StartTimer(x);"  Once the 'x' seconds have
  88. expired a boolean flag called 'TimeUp' will be set to True (normally it's set
  89. to  false).
  90.  
  91. If TImeUp is true it wont automatically exit the program.  You'll have to check
  92. if TimeUp is true and then act on it.
  93.  
  94. Repeat
  95.   { your code }
  96. Until TimeUp;
  97. Writeln('Sorry your time is up.  Now returning you to the BBS');
  98.  
  99. At the very end of your program call the 'Uninstall_Timer' procedure.
  100.  
  101. Note : Multiple calls to StartTimer will just set a new countdown.  Multiple
  102. timers are not catered for.
  103.  
  104. I hope this does what you want.  If you need any help fell free to yell.
  105.  
  106. Seeya,
  107.   Chris.
  108.  
  109. --- Msged/sq
  110.  * Origin: Wanted : An original originline! (3:690/626.6)
  111.  
  112. @PATH: 6260/6 690/626 601 644 640/821 124/4115 5125 396/5 1 
  113. @PATH: 170/400 512/0 1007 
  114.