Simtel MSDOS 1992 June/SIMTEL_0692.cdr/msdos/database/refrecov.arc/VERIFY.INC

Text File | 1986-06-02 | 5.1 KB | 204 lines

type
  TestRec = record
              Failed : boolean;
              Reason : Message;
            end;

procedure VerifyRecSize(var RecBuf : VarLenBuf;
                        FieldCount : byte;
                        var Verified : TestRec);
var
  Min, Max : integer;
begin
  with RecBuf, Verified do
  begin
    Min := 4 + FieldCount;
    Max := 4 + (FieldCount * 2) + (FieldCount * 255);
    if Len < Min then
    begin
      Failed := true;
      Reason := 'The record is too small';
    end
    else
      if Len > Max then
      begin
        Failed := true;
        Reason := 'The record is too large';
      end;
  end;
end; { VerifyRecSize }

procedure VerifyLocText(var RecBuf : VarLenBuf;
                        var Offset : integer;
                        var Verified : TestRec);
var
  TextPos : integer;
  LocalText : Str255;
begin
  with RecBuf, Verified do
  begin
    TextPos := MemW[Seg(Buf^):Ofs(Buf^) + Offset];
    Offset := Offset + 2;             { Move the offset to the next field }
    if TextPos >= Len then   { The text reference over shot end of record }
    begin
      Failed := true;
      Reason := 'The local text offset was out of range';
    end
    else
      GetText(RecBuf, TextPos, LocalText);
  end;
end; { VerifyLocText }

procedure VerifyRepText(var RecBuf : VarLenBuf;
                        FieldNum : byte;
                        var Offset : integer;
                        var Verified : TestRec);
var
  TextPos : integer;
  RepText : Str255;
begin
  with RecBuf, Verified do
  begin
    TextPos := MemW[Seg(Buf^):Ofs(Buf^) + Offset];
    Offset := Offset + 2;    { Move the offset to the next field }
    GetRepText(FieldNum, TextPos, RepText);
    if RepText = '' then
    with Verified do
    begin
      failed := true;
      Reason := 'The text was not returned from the text pool';
    end
  end;
end; { VerifyRepText }

procedure VerifyField(var RecBuf : VarLenBuf;
                      FieldCount : byte;
                      var Offset : integer;
                      var Verified : TestRec);
var
  Form : byte;
  FieldName : Str255;

begin
  with RecBuf, FieldDescriptors[FieldCount]^, Verified do
  begin
    Failed := false;
    GetText(FieldNameText, NameOffset, FieldName);
    case DataType of
      UnTyped   : ;  { Add change of offset }
      LocalText : VerifyLocText(RecBuf, Offset, Verified);
      RepText   : VerifyRepText(RecBuf, FieldCount, Offset, Verified);
      Date, IntVal : Offset := Offset + 2;
      Numeric   : Offset := Offset + 8;
    end;
  end;
end; { VerifyField }

procedure VerifyDataRecord(var RecBuf : VarLenBuf;
                           var Verified : TestRec);
var
  FieldCount : byte;
  Offset : integer;
begin
  GetFieldCount(RecBuf, FieldCount);
  VerifyRecSize(RecBuf, FieldCount, Verified);
  Offset := 4;
  for FieldCount := 0 to (FieldCount - 1) do
    VerifyField(RecBuf, FieldCount, Offset, Verified);
end; { VerifyDataRecord }

procedure ErrorPrompt(RecordNum : integer; var Abort : boolean);
var
  ch : char;
begin
  Writeln(^G, 'Error occured in record # ', RecordNum);
  Write('Do you want to continue (Y/N)? ');
  repeat
    Read(KBD, ch);
    ch := UpCase(ch);
  until ch in ['Y', 'N'];
  Writeln(ch);
  Writeln;
  Abort := ch = 'N';
end; { ErrorPrompt }


procedure DisplayFieldNames(FieldCount : integer;
                            var FieldNameText : VarLenBuf);
var
  NmFields,
  StartText : integer;
  FieldName : Str255;
begin
  ClrScr;
  for NmFields := 0 to FieldCount - 1 do
    with FieldDescriptors[NmFields]^ do
    begin
      GetText(FieldNameText, NameOffset, FieldName);
      Write('Field number ',NmFields,': ', FieldName);
      Writeln(' is of type ',DataFields[DataType]);
      if WhereY > 22 then
      begin
        Readln;
        ClrScr;
      end;
    end;
    Readln;
end; { DisplayFieldNames }

procedure DispHexNum(Num : byte);
const
  HexArray : array[0..$F] of char = '0123456789ABCDEF';
begin
  Write(HexArray[Num shr 4], HexArray[Num mod $10]);
end; { DispHexNum }

procedure DisplayRec(var RecBuf : VarLenBuf);
var
  i : integer;
  CurByte : byte;
begin
  with RecBuf do
    for i := 0 to Len - 1 do
    begin
      if (i mod $10 = 0) and (i > 0) then
        Writeln;
      if (i mod $40 = 0) and (i > 0) then
        Writeln;
      CurByte := Mem[Seg(Buf^):Ofs(Buf^) + i];
      DispHexNum(CurByte);
      Write(' ');
    end;
end; { DisplayRec }

type
  WindowDesc = record
                 X1, Y1, X2, Y2 : byte;
               end;
const
  TopWin : WindowDesc =
             (X1 : 1; Y1 : 1; X2 : 80; Y2 : 12);
  BotWin : WindowDesc =
             (X1 : 1; Y1 : 14; X2 : 80; Y2 : 25);
  StandardWindow : WindowDesc =
             (X1 : 1; Y1 : 1; X2 : 80; Y2 : 25);
var
  CurWindow,
  LastWindow : WindowDesc;

procedure SetWindow(var NewWindow : WindowDesc);
begin
  LastWindow := CurWindow;
  CurWindow := NewWindow;
end; { SetWindow }

procedure DrawLine;
var
  i : byte;
begin
  SetWindow(StandardWindow);
  GotoXY(1, 13);
  for i := 1 to 80 do
    Write('═');
end; { DrawLine }