[Back to DATETIME SWAG index] [Back to Main SWAG index] [Original]

    {Created by Carlos Beguinge, Sept 12, 1993}
    {Program to get the systems date using [GetDate] and allowing you to
      change the date using [SetDate]. Feel free to incorporated into any
      other code, and change it as you wish... Enjoy.}
    {P.S. Any changes made to make this code better please post it back to me
      outlining the changes, Thank you.}

    uses Dos, Crt;

    const
      days : array [0..6] of String[9] =         {Array of Weekdays set here}
        ('Sunday','Monday','Tuesday',
         'Wednesday','Thursday','Friday',
         'Saturday');
    var
      y, m, d, dow, I, Code : Word;              {Setting the variables here}
      changedt, cch : Char;
      flagd, flagm, flagy : boolean;
      ch : String;

    procedure start(Code: Word); Forward;        {To allow to go forward in a }
                                                 {procedure. Used for Error   }
                                                 {Checking.                   }

    procedure compute;                           {Called from procedure Start }
    begin                                        {Moves the numeric string to }
      Val(ch, I, Code);                          {numeric value. then checks  }
        if code <> 0 then                        {for errors. if error true   }
        begin                                    {then Call procedure Start   }
          clrscr;
          Writeln('Error in Date Statement', 'Press any key to Start Again ');
          readln;
          start(Code);
        end;                                     {Else Process Month, Day, and}
        if (flagm = false) then                  {Year.                       }
        begin
          m := I;
          flagm := true;
          write(cch);
          cch :=#0;
        end;
        if (flagd = false) and (cch > #0) then
        begin
          d := I;
          flagd := true;
          write(cch);
          cch :=#0;
          end;
        if (flagy = false) and ( cch > #0) then
        begin
          y := I;
          flagy := true;
          cch :=#13;
        end;
      ch := '';
    end;

    procedure ResetVars;                         {Called from procedure Start }
    begin                                        {Resets all variable.        }
      clrscr;
      Code :=0;
      d :=0;
      m :=0;
      y :=0;
      flagd := false;
      flagm := false;
      flagy := false;
      ch :='';
      cch := #0;
    end;

    procedure start;                             {Called from Main Program    }
    begin
      ResetVars;                                 {Calls procedure ResetFields }
      while (cch <> #13) do                      {Gets input from the keyboard}
        begin                                    {until a "/" or "Enter is    }
          cch := readkey;                        {pressed.                    }
          while (cch <> #47) and (cch <> #13) do
            begin
              ch := ch + cch;                    {Adds the each numeric charac}
              write(cch);                        {ter to the string variable  }
              cch := readkey;
            end;
          compute;                               {Calls procedure Compute     }
        end;
    end;

    begin                                        {Main Program which calls    }
      clrscr;                                    {procedure Start             }
      GetDate(y,m,d,dow);
      Writeln('Today is ', days[dow],', ',
              m:0, '/', d:0, '/', y:0);
      Writeln;
      Write('Would you like to change this Date? ');
      readln(changedt);
      if upcase(changedt) ='Y' then
         begin
         start(Code);
         clrscr;
         SetDate(y,m,d);                         {Sets the Date if Changed    }
         Writeln('Today is ', days[dow],', ',
              m:0, '/', d:0, '/', y:0);
         readln;
         end
         else
         begin                                   {Date remains unchanged      }
            Writeln('Today'#39's date Was NOT changed ');
            Writeln('Today is ', days[dow],', ',
               m:0, '/', d:0, '/', y:0);
            readln;
         end;
    end.

[Back to DATETIME SWAG index] [Back to Main SWAG index] [Original]