home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / TURBOPAS / TP-LA1.LBR / DATEDIT.IQC / DATEDIT.INC
Text File  |  2000-06-30  |  3KB  |  73 lines
  1. {DATEDIT.INC}
  2. PROCEDURE Date_Edit (DE_Date : String8; Var Result : Integer);
  3.  
  4.     {This procedure will verify a date passed as a string in
  5.      MM/DD/YY form and return a result of:
  6.       0, when date is O.K.           4, when YY is invalid
  7.       1, when MM is invalid          5, when MM and YY are invalid
  8.       2, when DD is invalid          6, when DD and YY are invalid
  9.       3, when MM and DD are invalid  7, when all fields are invalid
  10.  
  11.  
  12.     Author     : L. L. Smith; 2827 Klusner Ave.; Parma, OH 44134
  13.     Application: CP/M-80, CP/M-86, MS-DOS, PC-DOS}
  14.  
  15.     var
  16.         DE                         : string[2];
  17.         DE_Month, DE_Day, DE_Year  : integer;
  18.     Begin
  19.         If Length(DE_Date) < 8 then
  20.             DE_Date := '00000000';
  21.         DE := Copy(DE_Date,1,2);
  22.         Val(DE, DE_Month, Result);
  23.         If Result <> 0 then
  24.             DE_Month := 0;
  25.         DE := Copy(DE_Date,4,2);
  26.         Val(DE, DE_Day, Result);
  27.         If Result <> 0 then
  28.             DE_Day := 0;
  29.         DE := Copy(DE_Date,7,2);
  30.         Val(DE, DE_Year, Result);
  31.         If Result <> 0 then
  32.             DE_Year := -1;
  33.         If DE_Month In [1..12] then
  34.             Result := 0
  35.         Else
  36.             Result := 1;
  37.         If DE_Day In [1..31] then
  38.             Result := Result
  39.         Else
  40.             Result := Result + 2;
  41.         If DE_Year < 0 then
  42.             Result := Result + 4
  43.         Else
  44.             If DE_Year > 99 then
  45.                 Result := Result + 4;
  46.         If Result = 0 then
  47.             If DE_Day In [29,30,31] then
  48.                 Case DE_Day of
  49.                     29 : If DE_Month = 2 then
  50.                              Begin
  51.                                  Result := DE_Year Mod 4;
  52.                                  If Result <> 0 then
  53.                                      Result := 2
  54.                                  Else
  55.                                      If DE_Year = 0 then
  56.                                          Result := 2;
  57.                              end; (* of Begin *)
  58.                     30 : If DE_Month = 2 then
  59.                              Result := 2;
  60.                     31 : If DE_Month In [2,4,6,9,11] then
  61.                              Result := 2;
  62.                 end; (* of Case *)
  63.         Case Result of
  64.             0 : Result := 0;
  65.             1 : Error_Msg('MONTH','DATE',Line_Number + 2);
  66.             2 : Error_Msg('DAY','DATE',Line_Number + 2);
  67.             3 : Error_Msg('MONTH and DAY','DATE',Line_Number + 2);
  68.             4 : Error_Msg('YEAR','DATE',Line_Number + 2);
  69.             5 : Error_Msg('MONTH and YEAR','DATE',Line_Number + 2);
  70.             6 : Error_Msg('DAY and YEAR','DATE',Line_Number + 2);
  71.             7 : Error_Msg('DATE','DATE',Line_Number + 2);
  72.         end; (* Case *)
  73.       End; (* Date_Edit *)