home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / timer / timebomb / timebomb.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1990-03-30  |  3.0 KB  |  101 lines
  1. {$S-,I-,R-}
  2. {$M 2048,0,655360}
  3. Program HelloWorld;
  4.   Uses Dos,opstring,opInt,OpTsr,Opinline,OpCrt;
  5.   Const
  6.     OneHour=60*60*18.2;
  7.     OneMinute=60*18.2;
  8.     HotKey=$080F;
  9.     WaitForDos = True;
  10.     TimerTic:LongInt=0;
  11.     BootTic:LongInt=0;
  12.     MyIsrHandle = 16;
  13.     IntNumber   = $08;
  14.     code:Integer=0;
  15.     Delim:Charset=[':',' '];
  16.  
  17.   Var
  18.     Hours,Minutes:Integer;
  19.     WordC:Byte;
  20.  
  21.     {$F+}
  22.     Procedure Ticker(BP:Word); Interrupt;
  23.     Var Regs:IntRegisters absolute BP;
  24.       Begin
  25.         Inc(TimerTic);
  26.         If TimerTic>BootTic then Reboot;
  27.         ChainInt(Regs, IsrArray[MyIsrHandle].Origaddr);
  28.       end;
  29.  
  30.     Procedure PopUpEntryPoint(Var Regs:Registers);
  31.       Begin
  32.         FastWrite('Tics until boot='+Long2Str(BootTic-TimerTic)+'   ',
  33.                   1,45,$1F);
  34.       end; {$F-}
  35.  
  36.     Procedure Instructions;
  37.       Begin
  38.         Writeln('TIMEBOMB expects its parm in the HH:MM format');
  39.         Writeln('You may also enter TIMEBOMB TEST to cause a');
  40.         Writeln('boot in 1 minute for testing purposes');
  41.       end;
  42.  
  43.     Begin
  44.       If ParamCount=0 then Begin
  45.         Instructions;
  46.         Exit;
  47.       end
  48.       else Begin
  49.         If StUpCase(ParamStr(1))='TEST' then BootTic := Trunc(oneMinute)
  50.         else Begin
  51.           WordC := Wordcount(ParamStr(1),Delim);
  52.           If WordC < 2 then Begin
  53.             Instructions;
  54.             Exit;
  55.           end
  56.           Else begin
  57.             VAL(ExtractWord(1,ParamStr(1),Delim),Hours,code);
  58.             If Code>0 then Begin
  59.               Writeln('Invalid parameter to TimeBomb ',ParamStr(1));
  60.               Instructions;
  61.               Exit;
  62.             end
  63.             else Begin
  64.               VAL(ExtractWord(2,ParamStr(1),Delim),Minutes,code);
  65.               If Code>0 then Begin
  66.                 Writeln('Invalid parameter to TimeBomb ',ParamStr(1));
  67.                 Instructions;
  68.                 Exit;
  69.               end
  70.               else Begin
  71.                 If (Hours > 24) or (Hours<0) then Begin
  72.                   Writeln('Parameter out of range 0-24 hours is valid');
  73.                   Instructions;
  74.                   Exit;
  75.                 end
  76.                 else if (minutes > 59) or (Minutes<1) then Begin
  77.                   Writeln('Parameter out of range 1-59 minutes is valid');
  78.                   Instructions;
  79.                   Exit;
  80.                 end
  81.                 else begin
  82.                   BootTic := Trunc((Hours*oneHour)+(Minutes*OneMinute));
  83.                   Writeln('TimeBomb going Resident with ',BootTic:10,
  84.                       ' tics until boot');
  85.                 end;
  86.               end;
  87.             end;
  88.           end;
  89.         end;
  90.       end;
  91.       If Initvector(IntNumber,MyIsrHandle,@Ticker) then {};
  92.       If DefinePop(HotKey, PopUpEntryPoint, Ptr(SSEG,SPTR), WaitForDos) then
  93.         Begin
  94.           Writeln('TIMEBOMB Ticking, Press <Alt><Tab> for Tics to Boot Report');
  95.           PopUpsOn;
  96.           StayRes(ParagraphsToKeep, 0);
  97.         end;
  98.       Writeln('TimeBomb failed to go resident');
  99.     end.
  100.  
  101.