home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / PASCAL / TEF10.ZIP / tef.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1992-06-11  |  2.9 KB  |  98 lines
  1. Program Timed_Execution_Facility;
  2.  
  3. {$M 4096,0,0}
  4.  
  5. Uses CRT,DOS;
  6.  
  7. Const
  8.   Off = False;
  9.   On  = True;
  10.   HaltKey = (#45);    { ScanCode for Alt-X }
  11.   HaltStr = 'Alt-X';  { String to display  }
  12.  
  13. Var
  14.   TimeToRun,
  15.   ProgramToRun : String;
  16.   Ch : Char;
  17.  
  18. {=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=}
  19. {=  Function: CurrentTime                                                  =}
  20. {=  Returns : Time in 24-hour format                                       =}
  21. {=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=}
  22.  
  23. Function CurrentTime : String;
  24. Var
  25.   Hour, Min, Sec, i : Integer;
  26.   HStr, MStr, SStr, Temp : String[2];
  27.   Regs : Registers;
  28. Begin
  29.   With Regs do
  30.     Begin
  31.     AH:=44;  AL:=0;
  32.     MsDos(Regs);               { Pull the time }
  33.     Hour:=CH;  Min:=CL;        { DL=100ths sec }
  34.     Sec:=DH;
  35.     End;  { with }
  36.   Str(Hour,Hstr);              { Cvt hour to string }
  37.   Str(Min,MStr);               { Cvt min to string  }
  38.   Str(Sec,SStr);               { Cvt sec to string  }
  39.   If Length(MStr) = 1 then MStr := '0'+MStr;
  40.   If Length(SStr) = 1 then SStr := '0'+SStr;
  41.   CurrentTime:=HStr+':'+MStr+':'+SStr;
  42. End;  { CurrentTime }
  43.  
  44. {=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=}
  45. {=  Procedure: Cursor                                                      =}
  46. {=  Returns  : Nothing - Turns cursor on/off                               =}
  47. {=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=}
  48.  
  49. Procedure Cursor(Status : Boolean);
  50. Var
  51.   Regs : Registers;
  52.   i    : Integer;
  53. Begin
  54.   FillChar(Regs,SizeOf(Regs),0);
  55.   If (Mem[0000:1040] AND 48) <> 48 Then i := 0  { mono }
  56.   Else i := 6;               { color }
  57.   Regs.AH := $01;
  58.   If (Status = On) then begin  { Turn ON  }
  59.     Regs.CH:=$6+i;
  60.     Regs.CL:=$7+i;
  61.     end
  62.   Else begin                   { Turn OFF }
  63.     Regs.CH := $20;
  64.     Regs.CL := $20;
  65.     end;
  66.   Intr($10,Regs);
  67. End; { Cursor }
  68.  
  69. {=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=}
  70. {=  Procedure: Help                                                        =}
  71. {=  Returns  : Nothing - Aborts program with USAGE message                 =}
  72. {=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=}
  73.  
  74. Procedure Help;
  75. Begin
  76.   Writeln;
  77.   Writeln('USAGE: TEF [24-hr time] [command]');
  78.   Writeln;
  79.   Cursor(On);
  80.   Halt;
  81. End; { Help }
  82.  
  83. {=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=}
  84. {=  Procedure: Parse                                                       =}
  85. {=  Returns  : TimeToRun, ProgramToRun                                     =}
  86. {=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=}
  87.  
  88. Procedure Parse (Var Time, Command : String);
  89. Var Loop  : Integer;
  90.     P1,P2 : String;
  91.     FoundTime : Boolean;
  92. Begin
  93.   If (ParamCount <> 2) then Help
  94.   Else begin
  95.     FoundTime:=False;
  96.     P1:=ParamStr(1);  P2:=ParamStr(2);
  97.     For Loop:=1 to Length(P1) do
  98.       If (P1[Loop]=':