home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / UTILITY / SYSTEM / GETTIME.ZIP / GETTIME.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-12-10  |  1.7 KB  |  83 lines
  1. program gtime;
  2. uses crt, comunit, stopwatch, dos, ioerrmsg;
  3. var cl1: clock;
  4.     s1: string[80];
  5.     hour, min, sec, sec100: word;
  6.     i: byte;
  7.     res: integer;
  8.     parmfile: text;
  9.     timezone: 0..23;
  10.     comport: 1..2;
  11.     dialcmd: string[80];
  12.     resetcmd: string[80];
  13. procedure checktime;
  14. begin
  15.    if stopclock(cl1)>30 then begin
  16.      writeln('TIMEOUT');
  17.      if dcd then hangup;
  18.      halt;
  19.    end;
  20. end;
  21.  
  22. procedure check_io;
  23. var i: integer;
  24. begin
  25.   i := IOresult;
  26.   if i<> 0 then begin
  27.      writeln('I/O error #',i, ' on PARMFILE: ', errmsg(i));
  28.      halt;
  29.   end;
  30. end;
  31.  
  32. begin
  33.   echo_on := true;
  34.   status_change_proc := do_nothing;
  35.   ClrScr;
  36.   {$I-}
  37.   assign(parmfile,'parmfile');
  38.   check_io;
  39.   reset(parmfile);
  40.   readln(parmfile,timezone);
  41.   check_io;
  42.   readln(parmfile,comport);
  43.   check_io;
  44.   readln(parmfile,resetcmd);
  45.   check_io;
  46.   readln(parmfile,dialcmd);
  47.   check_io;
  48.   close(parmfile);
  49.   check_io;
  50.   {$I+}
  51.   startclock(cl1);
  52.   display_error := true;
  53.   initcom(comport,200,B1200,8,1,no_par);
  54.   sendln(resetcmd);
  55.   repeat
  56.     s1 := getln;
  57.     checktime;
  58.   until s1='OK';
  59.   sendln(dialcmd);
  60.   repeat
  61.     checktime
  62.   until dcd;
  63.   repeat
  64.     s1 := getln;
  65.     checktime;
  66.   until (length(s1)>=10) and (copy(s1,length(s1)-2,3)='UTC');
  67.   i := length(s1)-9;
  68.   val(copy(s1,i,2), hour, res);
  69.   val(copy(s1,i+2,2), min, res);
  70.   val(copy(s1,i+4,2), sec, res);
  71.   hour := (hour+24-timezone) mod 24;
  72.   settime (hour, min, sec, 0);
  73.   hangup;
  74.   end_com;
  75.   gotoxy(1,23);
  76.   write ('Press any key to exit.');
  77.   repeat
  78.     gettime(hour , min,sec,sec100);
  79.     gotoxy(1,24);
  80.     write (hour:2,':',min:2,':',sec:2);
  81.   until keypressed;
  82. end.
  83.