home *** CD-ROM | disk | FTP | other *** search
/ HAM Radio 1 / HamRadio.cdr / misc / kam401 / kam-dos.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-02-26  |  2.2 KB  |  114 lines
  1. function Date: DateStr;
  2. var
  3.   gm,gd,gy,gdow : word;
  4.   month,day:     string[2];
  5.   year:          string[2];
  6.   yr:            string[4];
  7. begin
  8.   GetDate(gy,gm,gd,gdow);
  9.   str(gy,yr);                  {convert to string}
  10.   str(gd,day);               { " }
  11.   str(gm,month);               { " }
  12.   year := '  ';
  13.   year[1] := yr[3];
  14.   year[2] := yr[4];
  15.   if (month[0] = ^A) then month := '0' + month;
  16.   if (day[0] = ^A) then day := '0' + day;
  17.   date := month+'/'+day+'/'+year;
  18. end;
  19.  
  20. function time: TimeString;
  21. var
  22.   gh,gm,gs,gs100 : word;
  23.   hour,min,sec:     string[2];
  24.  
  25. begin
  26.   GetTime(gh,gm,gs,gs100);
  27.   str(gh, hour);                 {convert to string}
  28.   str(gm, min);                       { " }
  29.   if (hour[0] = ^A) then hour := '0' + hour;
  30.   if (min[0] = ^A) then min := '0' + min;
  31.   time := hour+':'+min;
  32. end;
  33.  
  34. procedure get_time;
  35. var gh,gm,gs,gs100 : word;
  36. begin
  37.   GetTime(gh,gm,gs,gs100);
  38.   hour := gh;
  39.   min  := gm;
  40. end;
  41.  
  42. procedure get_date;
  43. var gy,gm,gd,gdow : word;
  44. begin
  45.   GetDate(gy,gm,gd,gdow);
  46.   year := gy;
  47.   month := gm;
  48.   day := gd;
  49. end;
  50.  
  51. procedure set_time;
  52. begin
  53.   SetTime(hour,min,0,0);
  54. end;
  55.  
  56. procedure set_date;
  57. begin
  58.   SetDate(year,month,day);
  59. end;
  60.  
  61. procedure set_date_time;
  62. begin
  63.   if (time_zone <> 0) then
  64.   begin
  65.     get_date;
  66.     get_time;
  67.     hour := hour + time_zone;
  68.     if (hour > 23) then
  69.     begin
  70.       hour := hour - 24;
  71.       day := day + 1;
  72.       if (day > nbr_days[month]) then
  73.       begin
  74.         day := 1;
  75.         month := month + 1;
  76.         if (month > 12) then
  77.         begin
  78.           month := 1;
  79.           year := year + 1;
  80.         end;
  81.       end;
  82.     end;
  83.   set_date;
  84.   set_time;
  85.   end;
  86. end;
  87.  
  88. procedure reset_date_time;
  89. begin
  90.   if (time_zone <> 0) then
  91.   begin
  92.     get_date;
  93.     get_time;
  94.     hour := hour - time_zone;
  95.     if (hour < 0) then
  96.     begin
  97.       hour := hour + 24;
  98.       day := day - 1;
  99.       if (day = 0) then
  100.       begin
  101.         month := month - 1;
  102.         if (month = 0) then
  103.         begin
  104.           month := 12;
  105.           year := year - 1;
  106.         end;
  107.         day := nbr_days[month];
  108.       end;
  109.     end;
  110.   set_date;
  111.   set_time;
  112.   end;
  113. end;
  114.