Power-Programmierung/CD1.mdf/pascal/library/dos/sampler/03/intvec/vectors.pas

Pascal/Delphi Source File | 1988-03-16 | 10.4 KB | 332 lines

{--------------------------------------------------------------}
{                           VECTORS                            }
{                                                              }
{                   Interrupt vector utility                   }
{                                                              }
{                             by Jeff Duntemann                }
{                             Turbo Pascal V4.0                }
{                             Last update 3/15/88              }
{                                                              }
{ This program allows you to inspect and change 8086 interrupt }
{ vectors, and look at the first 256 bytes pointed to by any   }
{ vector.  This allows the spotting of interrupt service       }
{ routine "signatures" (typically the vendor's copyright       }
{ notice) and also indicates when a vector points to an IRET.  }
{                                                              }
{      From: COMPLETE TURBO PASCAL, 3E  by Jeff Duntemann      }
{    Scott, Foresman & Co., Inc. 1988   ISBN 0-673-38355-5     }
{--------------------------------------------------------------}

PROGRAM Vectors;

USES DOS;     { For GetIntVec and SetIntVec }

{$V-}         { Relaxes type checking on string lengths }

CONST
  Up = True;

TYPE
  String80    = String[80];
  Block       = ARRAY[0..255] OF Byte;
  PtrPieces   = ARRAY[0..3] OF Byte;

VAR
  I             : Integer;
  VectorNumber  : Integer;
  Vector        : Pointer;
  VSeg,VOfs     : Integer;
  NewVector     : Integer;
  MemBlock      : Block;
  ErrorPosition : Integer;
  Quit          : Boolean;
  Command       : String80;
  CommandChar   : Char;


PROCEDURE StripWhite(VAR Target : String);

CONST
  Whitespace  : SET OF Char = [#8,#10,#12,#13,' '];

BEGIN
  WHILE (Length(Target) > 0) AND (Target[1] IN Whitespace) DO
    Delete(Target,1,1)
END;


PROCEDURE WriteHex(BT : Byte);

CONST
  HexDigits : ARRAY[0..15] OF Char = '0123456789ABCDEF';

VAR
  BZ : Byte;

BEGIN
  BZ := BT AND $0F;
  BT := BT SHR 4;
  Write(HexDigits[BT],HexDigits[BZ])
END;


FUNCTION ForceCase(Up : BOOLEAN; Target : String) : String;

CONST
  Uppercase : SET OF Char = ['A'..'Z'];
  Lowercase : SET OF Char = ['a'..'z'];

VAR
  I : INTEGER;

BEGIN
  IF Up THEN FOR I := 1 TO Length(Target) DO
    IF Target[I] IN Lowercase THEN
      Target[I] := UpCase(Target[I])
    ELSE { NULL }
  ELSE FOR I := 1 TO Length(Target) DO
    IF Target[I] IN Uppercase THEN
      Target[I] := Chr(Ord(Target[I])+32);
  ForceCase := Target
END;


Procedure ValHex(HexString : String;
                 VAR Value : LongInt;
                 VAR ErrCode : Integer);

VAR
  HexDigits  : String;
  Position   : Integer;
  PlaceValue : LongInt;
  TempValue  : LongInt;
  I          : Integer;

BEGIN
  ErrCode := 0; TempValue := 0; PlaceValue := 1;
  HexDigits := '0123456789ABCDEF';
  StripWhite(HexString);   { Get rid of leading whitespace }
  IF Pos('$',HexString) = 1 THEN Delete(Hexstring,1,1);
  HexString := ForceCase(Up,HexString);
  IF (Length(HexString) > 8) THEN ErrCode := 9
    ELSE IF (Length(HexString) < 1) THEN ErrCode := 1
  ELSE
    BEGIN
      FOR I := Length(HexString) DOWNTO 1 DO  { For each character }
        BEGIN
          { The position of the character in the string is its value:}
          Position := Pos(Copy(HexString,I,1),HexDigits) ;
          IF Position = 0 THEN   { If we find an invalid character...}
            BEGIN
              ErrCode := I;      { ...set the error code... }
              Exit               { ...and exit the procedure }
            END;
          { The next line calculates the value of the given digit }
          { and adds it to the cumulative value of the string: }
          TempValue := TempValue + ((Position-1) * PlaceValue);
          PlaceValue := PlaceValue * 16;  { Move to next place }
        END;
      Value := TempValue
    END
END;


PROCEDURE DumpBlock(XBlock : Block);

VAR
  I,J,K : Integer;
  Ch    : Char;

BEGIN
  FOR I:=0 TO 15 DO        { Do a hexdump of 16 lines of 16 chars }
    BEGIN
      FOR J:=0 TO 15 DO    { Show hex values }
        BEGIN
          WriteHex(Ord(XBlock[(I*16)+J]));
          Write(' ')
        END;
      Write('   |');           { Bar to separate hex & ASCII }
      FOR J:=0 TO 15 DO        { Show printable chars or '.' }
        BEGIN
          Ch:=Chr(XBlock[(I*16)+J]);
          IF ((Ord(Ch)<127) AND (Ord(Ch)>31))
          THEN Write(Ch) ELSE Write('.')
        END;
      Writeln('|')
    END;
  FOR I:=0 TO 1 DO Writeln('')
END;  { DumpBlock }


PROCEDURE ShowHelp;

BEGIN
  Writeln;
  Writeln('Press RETURN to advance to the next vector.');
  Writeln;
  Writeln
  ('To display a specific vector, enter the vector number (0-255)');
  Writeln
  ('in decimal or preceded by a "$" for hex, followed by RETURN.');
  Writeln;
  Writeln('Valid commands are:');
  Writeln;
  Writeln
  ('D : Dump the first 256 bytes pointed to by the current vector');
  Writeln
  ('E : Enter a new value (decimal or hex) for the current vector');
  Writeln('H : Display this help message');
  Writeln('Q : Exit VECTORS ');
  Writeln('X : Exit VECTORS ');
  Writeln('Z : Zero segment and offset of the current vector');
  Writeln('? : Display this help message');
  Writeln;
  Write('The indicator ">>IRET" means the vector');
  Writeln(' points to an IRET instruction');
  Writeln;
END;


PROCEDURE DisplayVector(VectorNumber : Integer);

VAR
  Bump : Integer;
  Chunks : PtrPieces;
  Vector : Pointer;
  Tester : ^Byte;

BEGIN
  GetIntVec(VectorNumber,Vector);{ Get the vector }
  Tester := Vector;              { Can't dereference untyped pointer }
  Chunks := PtrPieces(Vector);   { Cast Vector onto Chunks }
  Write(VectorNumber : 3,'  $');
  WriteHex(VectorNumber);
  Write('  [');
  WriteHex(Chunks[3]);       { Write out the chunks as hex digits }
  WriteHex(Chunks[2]);
  Write(':');
  WriteHex(Chunks[1]);
  WriteHex(Chunks[0]);
  Write(']');
  IF Tester^ = $CF           { If vector points to an IRET, say so }
    THEN Write(' >>IRET ')
    ELSE Write('        ');
END;


PROCEDURE DumpTargetData(VectorNumber : Integer);

VAR
  Vector : Pointer;
  Tester : ^Block;

BEGIN
  GetIntVec(VectorNumber,Vector);  { Get the vector }
  Tester := Vector;     { Cast the vector onto a pointer to a block }
  MemBlock := Tester^;      { Copy the target block into MemBlock }
  IF MemBlock[0] = $CF THEN { See if the first byte is an IRET }
    Writeln('Vector points to an IRET.');
  DumpBlock(MemBlock)       { and finally, hexdump the block. }
END;


PROCEDURE ChangeVector(VectorNumber: Integer);

VAR
  Vector : Pointer;
  LongTemp,TempValue : LongInt;
  SegPart,OfsPart : Word;

BEGIN
  GetIntVec(VectorNumber,Vector); { Get current value of vector }
  LongTemp := LongInt(Vector);    { Cast Pointer onto LongInt }
  SegPart := LongTemp SHR 16;     { Separate pointer seg. from off. }
  OfsPart := LongTemp AND $0000FFFF;  { And keep until changed }
  Write('Enter segment ');
  Write('(RETURN retains current value): ');
  Readln(Command);
  StripWhite(Command);
  { If something other than RETURN was entered: }
  IF Length(Command) > 0 THEN
    BEGIN
      Val(Command,TempValue,ErrorPosition);  { Evaluate as decimal }
      IF ErrorPosition = 0 THEN SegPart := TempValue
        ELSE { If it's not a valid decimal value, evaluate as hex: }
          BEGIN
            ValHex(Command,TempValue,ErrorPosition);
            IF ErrorPosition = 0 THEN SegPart := TempValue
          END;
      { Reset the vector with any changes: }
      Vector := Ptr(SegPart,OfsPart);
      SetIntVec(VectorNumber,Vector);
    END;
  DisplayVector(VectorNumber); { Show it to reflect any changes }
  Writeln;
  Write('Enter offset  ');     { Now get an offset }
  Write('(RETURN retains current value): ');
  Readln(Command);
  StripWhite(Command);
  { If something other than RETURN was entered: }
  IF Length(Command) > 0 THEN
    BEGIN
      Val(Command,TempValue,ErrorPosition);  { Evaluate as decimal }
      IF ErrorPosition = 0 THEN OfsPart := TempValue
        ELSE { If it's not a valid decimal value, evaluate as hex: }
          BEGIN
            ValHex(Command,TempValue,ErrorPosition);
            IF ErrorPosition = 0 THEN OfsPart := TempValue
          END
    END;
  { Finally, reset vector with any changes: }
  Vector := Ptr(SegPart,OfsPart);
  SetIntVec(VectorNumber,Vector);
END;


BEGIN
  Quit := False;
  VectorNumber := 0;
  Writeln('>>VECTORS<<');
  Writeln('By Jeff Duntemann');
  Writeln('From the book: COMPLETE TURBO PASCAL, 3E');
  Writeln('ISBN 0-673-38355-5');
  ShowHelp;

  REPEAT
    DisplayVector(VectorNumber);   { Show the vector # & address }
    Readln(Command);               { Get a command from the user }
    IF Length(Command) > 0 THEN    { If something was typed:     }
      BEGIN
        { See if a number was typed; if one was, it becomes the  }
        { current vector number.  If an error in converting the  }
        { string to a number occurs, Vectors then parses the     }
        { string as a command.   }
        Val(Command,NewVector,ErrorPosition);
        IF ErrorPosition = 0 THEN VectorNumber := NewVector
          ELSE
            BEGIN
              StripWhite(Command);       { Remove leading whitespace }
              Command := ForceCase(Up,Command); { Force to upper case}
              CommandChar := Command[1]; { Isolate first character   }
              CASE CommandChar OF
                'Q','X' : Quit := True;  { Exit VECTORS }
                'D'     : DumpTargetData(VectorNumber); { Dump data  }
                'E'     : ChangeVector(VectorNumber); { Enter vector }
                'H'     : ShowHelp;
                'Z'     : BEGIN           { Zero the vector }
                            Vector := NIL;   { NIL is 32 zero bits }
                            SetIntVec(VectorNumber,Vector);
                            DisplayVector(VectorNumber);
                            Writeln('zeroed.');
                            VectorNumber := (VectorNumber + 1) MOD 256
                          END;
                '?'     : ShowHelp;
              END {CASE}
            END
      END
    { The following line increments the vector number, rolling over }
    { to 0 if the number would have exceeded 255: }
    ELSE VectorNumber := (VectorNumber + 1) MOD 256
  UNTIL Quit;
END.