Programmer 7500/MAX_PROGRAMMERS.iso/EDITORES/TSCREDD2.ZIP/SCRDISK4.EXE/VALIDATE.PAS

Pascal/Delphi Source File | 1990-04-01 | 13.2 KB | 556 lines

Procedure S_Find_Min_and_max;
Begin
FillChar(S_CompMin,81,00);
FillChar(S_CompMax,81,00);
S_Done := False;
S_EndLine := False;
While Not S_Done Do
  Begin
  S_Str_Ptr := S_Str_Ptr + 1;
  If  S_Str_Ptr <= Length(S_CurStr) Then
    Begin
    If  S_CurStr[S_Str_Ptr] = #94 Then
      Begin
      S_Str_Ptr  := S_Str_Ptr + 1;
      S_CompMax := S_CurStr[S_Str_Ptr]
      End
    Else
      Begin
      If  S_CurStr[S_Str_Ptr] = #39 Then
        Begin
        If  S_CompMax = '' Then
          S_CompMax := S_CompMin;
        S_Done := True;
        End
      Else
        Begin
        If  S_CompMax = '' then
          S_CompMin := S_CompMin + S_CurStr[S_Str_Ptr]
        Else
          S_CompMax := S_CompMax + S_CurStr[S_Str_Ptr];
        End;
      End;
    If  (S_CompMin = '\') or (S_CompMin = '=') Then
      S_Done := True;
    End
  Else
    Begin
    S_Done := True;
    If  S_CompMin = '' Then S_EndLine    := True;
    End;
  End;
If  S_Upcase Then
  Begin
  S_CompMin := S_UpShiftedStr(S_CompMin);
  S_CompMax := S_UpShiftedStr(S_CompMax);
  End;
S_AutoHelpMsg    := '';
S_EditMask       := '';
S_Force_EditMask := False;
End;





Procedure S_ReadNextRangeRec;
Begin
With S_Validate^ Do
  Begin
  S_ValidateLine := S_NextLine;
  If  S_VRec <> S_NextRec Then
    Begin
    S_VRec := S_NextRec;
    Seek(S_File,S_NextRec);
    Read(S_File,S_Validate^);
    End;
  S_NextRec  := S_RangeRec [S_ValidateLine];
  S_NextLine := S_RangeLine[S_ValidateLine];
  S_CurStr := S_RangeList[S_ValidateLine];
  If  S_InIf Then S_Str_Ptr := 4 Else S_Str_Ptr := 1;
  End;
End;





Procedure S_ProcessDate;
Label S_ProcessDate_Exit;
Var
TestLen,
Error,
M_Pos,
D_Pos,
Y_Pos     : Byte;
T_Month,
T_Day,
T_Year    : Integer;
DateMask  : String[30];
WorkNum   : Integer;

Begin
Error:= 0;
M_Pos:= 0;
D_Pos:= 0;
Y_Pos:= 0;


DateMask := Copy(S_CurStr,Pos('DATE',S_CurStr)+5,Length(S_CurStr)-Pos('DATE',S_CurStr)+4);
S_Str_Ptr:= 1;

If  Length(DateMask) <> Length(S_NewStr) then Error := 1;

While ((Error = 0) and (S_Str_Ptr <= Length(DateMask))) do
  Begin
  Case DateMask[S_Str_Ptr] of
   'Y' : If  Y_Pos = 0 Then
           Begin
           Y_Pos := S_Str_Ptr;
           If  DateMask[S_Str_Ptr+2] = 'Y' Then TestLen := 4 Else TestLen := 2;
           Val(Copy(S_NewStr,S_Str_Ptr,TestLen),T_Year,S_Result);
           If  (S_Result > 0) Or (T_Year = 0) Then
             Error := 2;
           S_Str_Ptr := S_Str_Ptr + (TestLen - 1);
           End;
   'M' : If  M_Pos = 0 Then
           Begin
           M_Pos := S_Str_Ptr;
           Val(Copy(S_NewStr,S_Str_Ptr,2),T_Month,S_Result);
           If  (S_Result > 0) Or (T_Month = 0) Then Error := 3;
             S_Str_Ptr := S_Str_Ptr + 1;
           End;
   'D' : If  D_Pos = 0 Then
           Begin
           D_Pos := S_Str_Ptr;
           Val(Copy(S_NewStr,S_Str_Ptr,2),T_Day,S_Result);
           If  (S_Result > 0) Or (T_Day = 0) Then Error := 4;
           S_Str_Ptr := S_Str_Ptr + 1;
           End;
   Else
     If  S_NewStr[S_Str_Ptr] <> DateMask [S_Str_Ptr] Then Error := 1;
   End;{Case of}
  S_Str_Ptr := S_Str_Ptr + 1;
  End;

If  Error > 0 Then goto S_ProcessDate_Exit;

If  (M_Pos > 0) And (Not (T_Month In [1..12])) Then
  Begin
  Error := 6;{Invalid Month Specified}
  goto S_ProcessDate_Exit;
  End;

If  D_Pos > 0 Then
  Begin
  If  M_Pos > 0 Then
    Begin
    If  (T_Month In [1,3,5,7,8,10,12]) Then
      Begin
      If (T_Day > 31) Then Error := 8;
      End
    Else
      Begin
      If  (T_Month <> 2) Then
        Begin
        If  (T_Day > 30) Then Error := 9;
        End
      Else
        Begin
        If  (T_Year > 0) Then
          Begin
          If  (T_Year Mod 4) <> 0 Then
            Begin
            If  (T_Day > 28) Then Error := 10
            End
          Else
            If  (T_Day > 29) Then Error := 11;
          End
        Else
          If T_Day > 29 Then Error := 11;
        End;
      End;
    End
  Else
    If  T_Day > 31 Then Error := 12;
  End;


S_ProcessDate_Exit:

If  Error > 0 Then
  Begin
  S_ScreenValid := False;
  Case Error Of
    1 : S_ErrorMsg := 'Please enter date in ' + DateMask + ' format.';
    2 : S_ErrorMsg := 'Year contains invalid charcter.';
    3 : S_ErrorMsg := 'Month contains invalid character.';
    4 : S_ErrorMsg := 'Day of date contains invalid character.';
    6 : S_ErrorMsg := 'Month must be 1 thru 12.';
    8 : S_ErrorMsg := 'Only 31 Days in this month.';
    9 : S_ErrorMsg := 'Only 30 Days in this month.';
    10: S_ErrorMsg := 'February only has 28 days.';
    11: S_ErrorMsg := 'February only has 29 days.';
    12: S_ErrorMsg := 'Day can never exceed 31';
  End;
  End;
End;





Procedure S_ProcessIN;
Begin
S_EndLine:= True;
S_Matched:= False;
S_Str_Ptr:= Pos('IN',S_CurStr)+3;
S_CompMin[1]:= #32;

S_EditStr:= S_NewStr;
If  S_Upcase Then
  S_EditStr := S_UpShiftedStr(S_EditStr);

While Not((S_Matched) or (S_CompMin[1] IN ['\','='])) Do
  Begin
  S_Find_Min_and_max;
  If  (S_CompMin <> '\')And(S_CompMin <> '=')And(Not S_EndLine) Then
    Begin
    S_GetFieldType(S_Field^.S_Type[S_Point]);
    If  (S_FType In [0..7]) Then
      Begin
      S_Numeric   := 0;
      S_CompMin_Numeric := 0;
      S_CompMax_Numeric := 0;
      Val(S_EditStr,S_Numeric,S_Result);
      Val(S_CompMin,S_CompMin_Numeric,S_Result);
      Val(S_CompMax,S_CompMax_Numeric,S_Result);
      If  (S_Numeric >= S_CompMin_Numeric) And
        (S_Numeric <= S_CompMax_Numeric) Then
       S_Matched := True;
      End
    Else
      Begin
      If  (S_EditStr >= S_CompMin) And (S_EditStr <= S_CompMax) Then
        S_Matched := True;
      End;
    End;
  If  S_EndLine Then
    Begin
    S_EndLine := False;
    S_ReadNextRangeRec;
    S_Str_Ptr := S_Str_Ptr - 1;
    Repeat
      S_Str_Ptr := S_Str_Ptr + 1;
    Until S_CurStr[S_Str_Ptr] IN [#39,'\','='];
    If  S_CurStr[S_Str_Ptr] <> #39 Then
      S_CompMin := S_CurStr[S_Str_Ptr];
    End;
  End;

If  S_Matched Then
  Begin
  While Not(S_CurStr[S_Str_Ptr] In ['\','=']) Do
    Begin
    S_Str_Ptr := Pos('\',S_CurStr);
    If  S_Str_Ptr = 0 Then S_Str_Ptr := Pos('=',S_CurStr);
    If  S_Str_Ptr = 0 Then
      Begin
      S_ReadNextRangeRec;
      S_Str_Ptr := 1;
      End;
    End;
  If  S_CurStr[S_Str_Ptr] = '=' then
    Begin
    S_ScreenValid := False;
    S_ErrorMsg:= Copy(S_CurStr,(S_Str_Ptr+1),Length(S_CurStr));
    End
  Else
    S_Matched := False;
  End
Else
  Begin
  If  S_CurStr[S_Str_Ptr] = '\' then
    Begin
    S_ScreenValid := False;
    S_ErrorMsg:= Copy(S_CurStr,(S_Str_Ptr+1),Length(S_CurStr));
    End
  End;
End;





Procedure S_ProcessIf;
Var
End_Loop,Or_Found,NOT_Found,THEN_Found : Boolean;
CompField  : String[16];

Begin
S_CompMin:= '';
S_CompMax:= '';
S_Matched:= FALSE;
S_WorkStr:= S_EditStr;
THEN_Found:= False;
S_Skip:= False;
While Not Then_Found do
  Begin
  If  Pos('NOT ',S_CurStr) = 4 Then
    Begin
    S_Str_Ptr:= 8;
    NOT_Found:= True;
    End
  Else
    Begin
    S_Str_Ptr:= 4;
    NOT_Found:= False;
    End;
  CompField:= '';
  While S_CurStr[S_Str_Ptr] <> #39 Do
    Begin
    CompField:= CompField + UpCase(S_CurStr[S_Str_Ptr]);
    S_Str_Ptr:= S_Str_Ptr + 1;
    End;
  S_FieldNo := 1;
  S_Matched := False;
  End_Loop  := False;

  While CompField <> S_UpShiftedStr(S_Field^.S_FieldName [S_FieldNo])Do
    Begin
    S_FieldNo := S_FieldNo + 1;
    If  S_FieldNo > S_Indx^.S_Count[S_Num] Then
      Begin
      S_FieldNo := 1;
      End_Loop  := True;
      CompField := '';
      S_Field^.S_FieldName[1]:='';
      End;
    End;

  S_Get_Field_Value(S_FieldNo);
  S_EditStr  := S_TruncateStr(S_EditStr);

  If  S_Upcase Then S_EditStr := S_UpShiftedStr(S_EditStr);

  S_Matched:= False;
  End_Loop := False;
  While Not End_Loop do
    Begin
    Repeat
      S_Find_Min_and_Max;
      If  S_EndLine Then
        Begin
        S_ReadNextRangeRec;
        S_Str_Ptr := Pos(Chr(39),S_CurStr);
        End;
    Until Not(S_EndLine);
    If  ((S_CompMin='THEN') Or (S_CompMin='OR') Or (S_CompMin='AND')) Then
      End_Loop := True;
    If  Not((End_Loop) Or (S_Matched)) Then
      Begin
      S_GetFieldType(S_Field^.S_Type [S_FieldNo]);
      If  (S_FType In [0..7]) Then
        Begin
        S_Numeric   := 0;
        S_CompMin_Numeric := 0;
        S_CompMax_Numeric := 0;
        Val(S_EditStr,S_Numeric,S_Result);
        Val(S_CompMin,S_CompMin_Numeric,S_Result);
        Val(S_CompMax,S_CompMax_Numeric,S_Result);
        If  Not_Found Then
          Begin
          If  (S_Numeric < S_CompMin_Numeric) Or
              (S_Numeric > S_CompMax_Numeric) Then
            S_Matched := True
          End
        Else
          Begin
          If  (S_Numeric >= S_CompMin_Numeric) And
              (S_Numeric <= S_CompMax_Numeric) Then
            S_Matched := True;
          End;
        End
      Else
        Begin
        If  Not_Found Then
          Begin
          If  (S_EditStr < S_CompMin) Or (S_EditStr > S_CompMax) Then
            S_Matched := True
          End
        Else
          Begin
          If  (S_EditStr >= S_CompMin) And (S_EditStr <= S_CompMax) Then
            S_Matched := True;
          End;
        End;
      End;
    End;

  If  S_CompMin = 'AND' Then
    Begin
    If  Not S_Matched Then
      Begin
      Repeat
        S_ReadNextRangeRec;
      Until ((Pos('THEN',S_CurStr) = Length(S_CurStr)-3) Or
            (Pos('OR',S_CurStr) = Length(S_CurStr)-1));
      If  (Pos('OR',S_CurStr) = Length(S_CurStr)-1)   Then S_CompMin := 'OR';
      If  (Pos('THEN',S_CurStr) = Length(S_CurStr)-3) Then Then_Found := True;
      End
    Else
      S_ReadNextRangeRec;
    End;

  If  S_CompMin = 'OR' Then
    Begin
    If  S_Matched Then
      Repeat
        S_ReadNextRangeRec;
        If  (Pos('THEN',S_CurStr) = Length(S_CurStr)-3) Then Then_Found := True;
      Until Then_Found
    Else
      S_ReadNextRangeRec;
    End;
  If  S_CompMin = 'THEN' Then Then_Found := True;
  End;

If  S_Matched Then
  Begin
  S_Matched := False;
  While S_CurStr <> 'ENDIF' Do
    Begin
    S_ReadNextRangeRec;
    If  (Pos('ERROR',S_CurStr) = 4) Then
      Begin
      S_ScreenValid := False;
      S_ErrorMsg         := Copy(S_CurStr,9,Length(S_CurStr));
      End;
    If  (Pos('DATE',S_CurStr) = 4) Then S_ProcessDate;
    If  S_CurStr = '   SKIP' Then S_Skip := True;
    If  (Pos('IN',S_CurStr) = 4) Then
      Begin
      S_Str_Ptr := 4;
      S_InIf := True;
      S_ProcessIn;
      S_InIf := False;
      End;
    If  (S_ScreenValid = False) Or (S_Skip) Then
      While S_CurStr <> 'ENDIF' Do S_ReadNextRangeRec
    End;
  End
Else
  While S_CurStr <> 'ENDIF' Do S_ReadNextRangeRec;

S_EditStr := S_WorkStr;
End;





Procedure S_Validate_Location;
Var
WorkStr : String[1];
Begin
S_Upcase:= False;
S_ScreenValid:= True;
S_WorkStr:= '';
S_Skip:= False;

With S_Validate^ do
  Begin
  While ((S_NextRec > 0) And (S_ScreenValid)) And (Not S_Skip) Do
    Begin
    S_ReadNextRangeRec;
    If  (S_CurStr[1] = 'I') Then
      If  S_CurStr[2] = 'F' Then S_ProcessIf Else S_ProcessIN;
    If  S_CurStr [1] = 'U' Then
      Begin
      If  S_CurStr[11] = 'N' Then
        Begin
        S_Upcase := True;
        S_EditStr := S_UpShiftedStr(S_EditStr);
        End
      Else
        Begin
        S_Upcase := False;
        S_EditStr := S_NewStr;
        End;
      End;
    If  (S_CurStr[1] = 'S') And (S_EditStr = '') Then S_NextRec  := 0;
    If  (S_CurStr[3] = 'Q') Then {Required}
      Begin
      If  S_EditStr =  '' Then
        Begin
        WorkStr[0] := #01;
        WorkStr[1] := #39;
        S_Str_Ptr  := Pos(WorkStr,S_CurStr);
        S_ScreenValid := False;
        If  S_Str_Ptr = 0 Then
          S_ErrorMsg := 'This field is required'
        Else
          S_ErrorMsg := Copy(S_CurStr,(S_Str_Ptr+1),Length(S_CurStr)-S_Str_Ptr);
        End;
      End;
    If  S_CurStr[1] = 'D' Then S_ProcessDate;
      End;
  End;
End;




Procedure S_ValidateScreen;
Begin
If  S_ValidateField > 0 Then S_Point := S_ValidateField Else S_Point := 1;

S_RecNo := 9999;
S_ScreenValid := True;
S_VDone := False;

{*** Changed ***}
S_FieldCounter := 0;
{*** Changes End ***}

While ((S_Point <= S_Indx^.S_Count[S_Num]) And (S_VDone = False)) Do
  Begin
  While (S_Field^.S_Type [S_Point] > 9) And
    (S_FieldCounter <= S_Indx^.S_Count[S_Num]) do
    Begin
    S_FieldCounter := S_FieldCounter + 1;
    S_Point := S_Field^.S_Next [S_Point];
    End;
  If  S_Point <= S_Indx^.S_Count[S_Num] then
    Begin
    S_Get_Field_Value(S_Point);
    S_EditStr  := S_TruncateStr(S_EditStr);
    S_NewStr   := S_EditStr;
    S_NextRec  := S_Field^.S_RangeNextRec  [S_Point];
    S_NextLine := S_Field^.S_RangeNextLine [S_Point];
    S_Validate_Location;
    If  S_ScreenValid  Then
      Begin
      If  S_ValidateField > 0 then
        S_VDone := True
      Else
        S_Point := S_Point + 1;
      End
    Else
      S_VDone := True;
    End
  Else
    S_VDone := True;
  End;

If  S_ScreenValid Then
    S_Point := S_PrevFld
Else
    If S_IsDupe(S_Point) Then S_SetDupeFields := True;
End;