Ugly piece of code (Date

 BBS: Inland Empire Archive
Date: 02-11-93 (02:31)             Number: 386
From: RAYMOND KEITH                Refer#: NONE
  To: ROB MCKEE                     Recvd: NO  
Subj: Ugly piece of code (Date       Conf: (2) Quik_Bas

  Rob heres an ugly piece of code. It seems to get the job done but just
  looks sloppy to me.

  '************************************************************************
  '* This routine checks for data entry errors made when a user inputs    *
  '* a date. Proper format ##/##/## is checked as well as proper values,  *
  '* 30 day months, Feb with regards to leap years, range of valid years. *
  '* This routine is good for years 1904 to 1999.                         *
  '************************************************************************

  ErrorFound% = 0
  DateToCheck$ = THE DATE USER INPUT
  SlashCnt% = 0
  Month$ = ""
  Day$ = ""
  Year$ = ""
  FOR I% = 1 TO 12                      'Split field into mm/dd/yy fields
    Char$ = MID$(DateToCheck$, I%, 1)   'I allow dates to be entered like
    IF Char$ <> "/" THEN                '1/1/92 without the leading 0's
      IF SlashCnt% = 0 THEN             'and this correctly handles them
        Month$ = Month$ + Char$
      ELSEIF SlashCnt% = 1 THEN
        Day$ = Day$ + Char$
      ELSE
        Year$ = Year$ + Char$
      END IF
    ELSE
      SlashCnt% = SlashCnt% + 1
    END IF
  NEXT I%

  'Rather than nest these error checks 100 feet deep I just go ahead and
  'check the next four regardless of wether an error was previously found.
  'It's not a time critical peice of code and probably saves a few bytes.
  'These check for typo's. Say a dated was entered as 1/249/2 when they
  'really wanted 1/24/92
  IF SlashCnt% <> 2 THEN ErrorFound% = 1
  MonLen% = LEN(LTRIM$(RTRIM$(Month$)))
  DayLen% = LEN(LTRIM$(RTRIM$(Day$)))
  YearLen% = LEN(LTRIM$(RTRIM$(Year$)))
  IF MonLen% > 2 OR MonLen% < 1 THEN ErrorFound% = 1
  IF DayLen% > 2 OR DayLen% < 1 THEN ErrorFound% = 1
  IF YearLen% > 2 OR YearLen% < 1 THEN ErrorFound% = 1

  'Now if the date was entered in the proper ##/##/## format I check the
  'actual values entered. Also add a leading 0 to dates entered like
  '1/1/92 so it's formatted to 01/01/92.
  IF ErrorFound% = 0 THEN
    IF MonLen% = 1 THEN Month$ = "0" + Month$
    IF DayLen% = 1 THEN Day$ = "0" + Day$
    IF YearLen% = 1 THEN Year$ = "0" + Year$
    MonthNum% = VAL(Month$)
    DayNum% = VAL(Day$)
    YearNum% = VAL(Year$)

    'Here is some preliminary checking
    IF MonthNum% < 1 OR MonthNum% > 12 THEN 'Months 1 to 12
      ErrorFound% = 1
    END IF
    IF DayNum% < 1 OR DayNum% > 31 THEN     'Days 1 to 31
      ErrorFound% = 1
    END IF
    IF YearNum% < 80 OR YearNum% > 99 THEN  'Years 1980 to 1999
      ErrorFound% = 1
    END IF

    'Now some detailed checking for 30 day months exceeding 30 days
    'and Feb is check for 28/29 days based on leap years.
    SELECT CASE MonthNum%
      CASE 4, 6, 9, 11
        '*********************************
        '* 30 day months APR JUN SEP NOV *
        '*********************************
        IF DayNum% > 30 THEN ErrorFound% = 1
          ErrorFound% = 1
        END IF
      CASE 2
        '**************************************************
        '* 28 or 29 day month depending on leap years FEB *
        '**************************************************
        a% = 96
        LeapYear$ = "N"
        DO WHILE a% > 0         'Check for leap years
          IF YearNum% = a% THEN LeapYear$ = "Y"
          IF YearNum% > a% THEN a% = 0
          a% = a% - 4
        LOOP
        IF LeapYear$ = "N" THEN 'If not a leap year 28 days max
          IF DayNum% > 28 THEN
            ErrorFound% = 1
          END IF
        ELSE
          IF DayNum% > 29 THEN  'If a leap year 29 days max
            ErrorFound% = 1
          END IF
        END IF
    END SELECT
  END IF
  '

  'All done. If ErrorFound% = 1 then and error was made typing in the
  'date. In some of my programs I keep track of the type of errors
  'made and notify the user.

  Raymond Keith

--- DB 1.51/003468
 * Origin: R/E Northwest (1:105/224)