Programmer 7500/MAX_PROGRAMMERS.iso/INFO/TURBOPAS/TPPROC19.ZIP/CHECK.PAS

Pascal/Delphi Source File | 1985-09-08 | 6.0 KB | 230 lines

{
a procedure to check to make sure the date was entered (by assuming
that 1980 is invalid) and to request entry of date and offer the
option of entering time. v. 2.0  (c) copyright 1985 -- J. Levine
Public Domain -- a learning exercise -- last update 8/29


-----------------------------------------------------------}
TYPE
REGPACK = record          {establish record for registers}
        case integer of
        1: (Ax,Bx,Cx,Dx,Bp,Di,Si,Ds,Es,Flags : integer);
        2: (Al,Ah,Bl,Bh,Cl,Ch,Dl,Dh : byte);
        END;

VAR
rg : regpack;              {variable to be used within procedures}

{------------------------------------------------------------------------}
function GetChar : char;
VAR
Rg : REGPACK;           { register structure }

   BEGIN
   Rg.Ah := $01;           { set AH and perform DOS interrupt }
   Intr( $21, Rg );
   GetChar := char(Rg.Al);
   END;

{-------------------------------------------------------------------------}

{ Fill passed variables with current date from DOS }

procedure GetDate ( VAR Yr : integer );


BEGIN
With rg DO            {using the registers}
     BEGIN
     Ah := $2A;      { set AH and perform DOS interrupt }
     Intr( $21, Rg );
     Yr := Cx;       { set passed variables to register values }
     END;
END;
{------------------------------------------------------------------------}
procedure requesttime;

TYPE
string1 = string[1];  {set up the string types}
string2 = string[2];
string5 = string[5];

VAR
hour, minutes, code : integer;          {for use with val}
time: string5;
h,m,x : string2;
ok, again : boolean;


BEGIN
ok := true;
again := true;
      WHILE again = true
      DO
            BEGIN
            writeln;
            writeln('Please enter the time (HH:MM)  ');
            writeln;
            readln(time);
            h := copy(time,1,2);  {take first two letters}
            m := copy(time,4,2);  {then next two letters}
            x := copy(time,3,1);  {then get the colon}
            val(h,hour,code)     ;  {return the value of the hours}
            val(m,minutes,code)  ;  {return the value of the minutes}
               IF code >0
               THEN ok := false;  {make sure its an integer}
               IF x <> ':'
               THEN ok := false; {check for colon}
            again := false;

            with rg DO
                 BEGIN
                 Ah := $2d;           { set AH and perform DOS interrupt }
                 Ch := Hour;    { set passed variables to register values }
                 Cl := Minutes;
                 Intr( $21, Rg );

                         IF al <> 0
                         THEN ok := false;
                         WHILE not ok
                         DO
                           BEGIN
                           clrscr;
                           writeln('Ooops! -- not in proper format');
                           writeln('please try again');
                           ok := true;
                           again := true
                           END;
                  END;

        END; {for with rg do}

   END;



{----------------------------------}
procedure putdate;




TYPE
string1 = string[1];
string4 = string[4];  {set up the string types}
string2 = string[2];
string8 = string[8];


VAR
m,d : string2;          {for use with val}
y : string2;
year: string8;
mon,dat,yr,code : integer;
ok, again : boolean;
dasha : string1;
dashb : string1;


BEGIN
ok := true;         { initialize variables }
again := true;

WHILE again
DO
  BEGIN
  writeln;
  writeln('Please enter the date (MM-DD-YY)  ');
  writeln;
  readln(year);
  IF length(year) < 1
  THEN
  ok := false;

  code := 0;
  m := copy(year,1,2);    {take first two letters}
  d := copy(year,4,2);    {then next two letters}
  y := copy(year,7,2);    {then get the year}
  dasha := copy(year,3,1);
  dashb := copy(year,6,1);
  val(m,mon,code)     ;   {return the value of the month}
  val(d,dat,code)  ;      {return the value of the date}
  val(y,yr,code) ;        {returns the value of the year}


      ok := (code = 0) and ((dasha = '-') or (dasha = '/')) and
      ((dashb = '-') or (dashb = '/')) and (yr in [81..99]);

      yr := yr + 1900;

      WITH rg
      DO
        BEGIN
        Ah := $2b;    { set AH and perform DOS interrupt }
        Cx := Yr;    {set passed variables to register values }
        Dh := Mon;
        Dl := Dat;
        Intr( $21, Rg );
        END; {end dos call}

      again :=false;

        WHILE not ok
        DO
          BEGIN
          clrscr;
          writeln('Ooops! -- not in proper format');
          writeln('please try again');
          writeln;
          again := true;
          ok := true
          END; {end while not ok}
        END; {end while}
END; {end procedure}
{------------------------------------------------------------------------}
{ main body of program }

VAR                                    {set up the variables}
Year : integer;
ans : char;


      BEGIN  {body of program}
      Getdate ( Year );    {get the year}
      IF year = 1980
      THEN     {check to see IF year set}
               BEGIN

               clrscr;

               writeln; {drop down from top}
               writeln;
               writeln;
               writeln('You forgot to set the date!');
               writeln;
               writeln('Let''s do it now... ');

               putdate;
               writeln;

                REPEAT
                write('Do you want to enter the time? <Y/N> ');
                ans := upcase(getchar);
                UNTIL
                ans in ['Y','N'];

                IF  ans = 'Y'
                THEN
                    BEGIN
                    clrscr;
                    requesttime;
                    END; {end if ans = Y}
         END;   {end if year = 1980}

END.  {end program}