home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / sampler / 03 / intvec / vectors.pas < prev   
Pascal/Delphi Source File  |  1988-03-16  |  11KB  |  332 lines
  1. {--------------------------------------------------------------}
  2. {                           VECTORS                            }
  3. {                                                              }
  4. {                   Interrupt vector utility                   }
  5. {                                                              }
  6. {                             by Jeff Duntemann                }
  7. {                             Turbo Pascal V4.0                }
  8. {                             Last update 3/15/88              }
  9. {                                                              }
  10. { This program allows you to inspect and change 8086 interrupt }
  11. { vectors, and look at the first 256 bytes pointed to by any   }
  12. { vector.  This allows the spotting of interrupt service       }
  13. { routine "signatures" (typically the vendor's copyright       }
  14. { notice) and also indicates when a vector points to an IRET.  }
  15. {                                                              }
  16. {      From: COMPLETE TURBO PASCAL, 3E  by Jeff Duntemann      }
  17. {    Scott, Foresman & Co., Inc. 1988   ISBN 0-673-38355-5     }
  18. {--------------------------------------------------------------}
  19.  
  20. PROGRAM Vectors;
  21.  
  22. USES DOS;     { For GetIntVec and SetIntVec }
  23.  
  24. {$V-}         { Relaxes type checking on string lengths }
  25.  
  26. CONST
  27.   Up = True;
  28.  
  29. TYPE
  30.   String80    = String[80];
  31.   Block       = ARRAY[0..255] OF Byte;
  32.   PtrPieces   = ARRAY[0..3] OF Byte;
  33.  
  34. VAR
  35.   I             : Integer;
  36.   VectorNumber  : Integer;
  37.   Vector        : Pointer;
  38.   VSeg,VOfs     : Integer;
  39.   NewVector     : Integer;
  40.   MemBlock      : Block;
  41.   ErrorPosition : Integer;
  42.   Quit          : Boolean;
  43.   Command       : String80;
  44.   CommandChar   : Char;
  45.  
  46.  
  47. PROCEDURE StripWhite(VAR Target : String);
  48.  
  49. CONST
  50.   Whitespace  : SET OF Char = [#8,#10,#12,#13,' '];
  51.  
  52. BEGIN
  53.   WHILE (Length(Target) > 0) AND (Target[1] IN Whitespace) DO
  54.     Delete(Target,1,1)
  55. END;
  56.  
  57.  
  58. PROCEDURE WriteHex(BT : Byte);
  59.  
  60. CONST
  61.   HexDigits : ARRAY[0..15] OF Char = '0123456789ABCDEF';
  62.  
  63. VAR
  64.   BZ : Byte;
  65.  
  66. BEGIN
  67.   BZ := BT AND $0F;
  68.   BT := BT SHR 4;
  69.   Write(HexDigits[BT],HexDigits[BZ])
  70. END;
  71.  
  72.  
  73. FUNCTION ForceCase(Up : BOOLEAN; Target : String) : String;
  74.  
  75. CONST
  76.   Uppercase : SET OF Char = ['A'..'Z'];
  77.   Lowercase : SET OF Char = ['a'..'z'];
  78.  
  79. VAR
  80.   I : INTEGER;
  81.  
  82. BEGIN
  83.   IF Up THEN FOR I := 1 TO Length(Target) DO
  84.     IF Target[I] IN Lowercase THEN
  85.       Target[I] := UpCase(Target[I])
  86.     ELSE { NULL }
  87.   ELSE FOR I := 1 TO Length(Target) DO
  88.     IF Target[I] IN Uppercase THEN
  89.       Target[I] := Chr(Ord(Target[I])+32);
  90.   ForceCase := Target
  91. END;
  92.  
  93.  
  94. Procedure ValHex(HexString : String;
  95.                  VAR Value : LongInt;
  96.                  VAR ErrCode : Integer);
  97.  
  98. VAR
  99.   HexDigits  : String;
  100.   Position   : Integer;
  101.   PlaceValue : LongInt;
  102.   TempValue  : LongInt;
  103.   I          : Integer;
  104.  
  105. BEGIN
  106.   ErrCode := 0; TempValue := 0; PlaceValue := 1;
  107.   HexDigits := '0123456789ABCDEF';
  108.   StripWhite(HexString);   { Get rid of leading whitespace }
  109.   IF Pos('$',HexString) = 1 THEN Delete(Hexstring,1,1);
  110.   HexString := ForceCase(Up,HexString);
  111.   IF (Length(HexString) > 8) THEN ErrCode := 9
  112.     ELSE IF (Length(HexString) < 1) THEN ErrCode := 1
  113.   ELSE
  114.     BEGIN
  115.       FOR I := Length(HexString) DOWNTO 1 DO  { For each character }
  116.         BEGIN
  117.           { The position of the character in the string is its value:}
  118.           Position := Pos(Copy(HexString,I,1),HexDigits) ;
  119.           IF Position = 0 THEN   { If we find an invalid character...}
  120.             BEGIN
  121.               ErrCode := I;      { ...set the error code... }
  122.               Exit               { ...and exit the procedure }
  123.             END;
  124.           { The next line calculates the value of the given digit }
  125.           { and adds it to the cumulative value of the string: }
  126.           TempValue := TempValue + ((Position-1) * PlaceValue);
  127.           PlaceValue := PlaceValue * 16;  { Move to next place }
  128.         END;
  129.       Value := TempValue
  130.     END
  131. END;
  132.  
  133.  
  134. PROCEDURE DumpBlock(XBlock : Block);
  135.  
  136. VAR
  137.   I,J,K : Integer;
  138.   Ch    : Char;
  139.  
  140. BEGIN
  141.   FOR I:=0 TO 15 DO        { Do a hexdump of 16 lines of 16 chars }
  142.     BEGIN
  143.       FOR J:=0 TO 15 DO    { Show hex values }
  144.         BEGIN
  145.           WriteHex(Ord(XBlock[(I*16)+J]));
  146.           Write(' ')
  147.         END;
  148.       Write('   |');           { Bar to separate hex & ASCII }
  149.       FOR J:=0 TO 15 DO        { Show printable chars or '.' }
  150.         BEGIN
  151.           Ch:=Chr(XBlock[(I*16)+J]);
  152.           IF ((Ord(Ch)<127) AND (Ord(Ch)>31))
  153.           THEN Write(Ch) ELSE Write('.')
  154.         END;
  155.       Writeln('|')
  156.     END;
  157.   FOR I:=0 TO 1 DO Writeln('')
  158. END;  { DumpBlock }
  159.  
  160.  
  161. PROCEDURE ShowHelp;
  162.  
  163. BEGIN
  164.   Writeln;
  165.   Writeln('Press RETURN to advance to the next vector.');
  166.   Writeln;
  167.   Writeln
  168.   ('To display a specific vector, enter the vector number (0-255)');
  169.   Writeln
  170.   ('in decimal or preceded by a "$" for hex, followed by RETURN.');
  171.   Writeln;
  172.   Writeln('Valid commands are:');
  173.   Writeln;
  174.   Writeln
  175.   ('D : Dump the first 256 bytes pointed to by the current vector');
  176.   Writeln
  177.   ('E : Enter a new value (decimal or hex) for the current vector');
  178.   Writeln('H : Display this help message');
  179.   Writeln('Q : Exit VECTORS ');
  180.   Writeln('X : Exit VECTORS ');
  181.   Writeln('Z : Zero segment and offset of the current vector');
  182.   Writeln('? : Display this help message');
  183.   Writeln;
  184.   Write('The indicator ">>IRET" means the vector');
  185.   Writeln(' points to an IRET instruction');
  186.   Writeln;
  187. END;
  188.  
  189.  
  190. PROCEDURE DisplayVector(VectorNumber : Integer);
  191.  
  192. VAR
  193.   Bump : Integer;
  194.   Chunks : PtrPieces;
  195.   Vector : Pointer;
  196.   Tester : ^Byte;
  197.  
  198. BEGIN
  199.   GetIntVec(VectorNumber,Vector);{ Get the vector }
  200.   Tester := Vector;              { Can't dereference untyped pointer }
  201.   Chunks := PtrPieces(Vector);   { Cast Vector onto Chunks }
  202.   Write(VectorNumber : 3,'  $');
  203.   WriteHex(VectorNumber);
  204.   Write('  [');
  205.   WriteHex(Chunks[3]);       { Write out the chunks as hex digits }
  206.   WriteHex(Chunks[2]);
  207.   Write(':');
  208.   WriteHex(Chunks[1]);
  209.   WriteHex(Chunks[0]);
  210.   Write(']');
  211.   IF Tester^ = $CF           { If vector points to an IRET, say so }
  212.     THEN Write(' >>IRET ')
  213.     ELSE Write('        ');
  214. END;
  215.  
  216.  
  217. PROCEDURE DumpTargetData(VectorNumber : Integer);
  218.  
  219. VAR
  220.   Vector : Pointer;
  221.   Tester : ^Block;
  222.  
  223. BEGIN
  224.   GetIntVec(VectorNumber,Vector);  { Get the vector }
  225.   Tester := Vector;     { Cast the vector onto a pointer to a block }
  226.   MemBlock := Tester^;      { Copy the target block into MemBlock }
  227.   IF MemBlock[0] = $CF THEN { See if the first byte is an IRET }
  228.     Writeln('Vector points to an IRET.');
  229.   DumpBlock(MemBlock)       { and finally, hexdump the block. }
  230. END;
  231.  
  232.  
  233. PROCEDURE ChangeVector(VectorNumber: Integer);
  234.  
  235. VAR
  236.   Vector : Pointer;
  237.   LongTemp,TempValue : LongInt;
  238.   SegPart,OfsPart : Word;
  239.  
  240. BEGIN
  241.   GetIntVec(VectorNumber,Vector); { Get current value of vector }
  242.   LongTemp := LongInt(Vector);    { Cast Pointer onto LongInt }
  243.   SegPart := LongTemp SHR 16;     { Separate pointer seg. from off. }
  244.   OfsPart := LongTemp AND $0000FFFF;  { And keep until changed }
  245.   Write('Enter segment ');
  246.   Write('(RETURN retains current value): ');
  247.   Readln(Command);
  248.   StripWhite(Command);
  249.   { If something other than RETURN was entered: }
  250.   IF Length(Command) > 0 THEN
  251.     BEGIN
  252.       Val(Command,TempValue,ErrorPosition);  { Evaluate as decimal }
  253.       IF ErrorPosition = 0 THEN SegPart := TempValue
  254.         ELSE { If it's not a valid decimal value, evaluate as hex: }
  255.           BEGIN
  256.             ValHex(Command,TempValue,ErrorPosition);
  257.             IF ErrorPosition = 0 THEN SegPart := TempValue
  258.           END;
  259.       { Reset the vector with any changes: }
  260.       Vector := Ptr(SegPart,OfsPart);
  261.       SetIntVec(VectorNumber,Vector);
  262.     END;
  263.   DisplayVector(VectorNumber); { Show it to reflect any changes }
  264.   Writeln;
  265.   Write('Enter offset  ');     { Now get an offset }
  266.   Write('(RETURN retains current value): ');
  267.   Readln(Command);
  268.   StripWhite(Command);
  269.   { If something other than RETURN was entered: }
  270.   IF Length(Command) > 0 THEN
  271.     BEGIN
  272.       Val(Command,TempValue,ErrorPosition);  { Evaluate as decimal }
  273.       IF ErrorPosition = 0 THEN OfsPart := TempValue
  274.         ELSE { If it's not a valid decimal value, evaluate as hex: }
  275.           BEGIN
  276.             ValHex(Command,TempValue,ErrorPosition);
  277.             IF ErrorPosition = 0 THEN OfsPart := TempValue
  278.           END
  279.     END;
  280.   { Finally, reset vector with any changes: }
  281.   Vector := Ptr(SegPart,OfsPart);
  282.   SetIntVec(VectorNumber,Vector);
  283. END;
  284.  
  285.  
  286. BEGIN
  287.   Quit := False;
  288.   VectorNumber := 0;
  289.   Writeln('>>VECTORS<<');
  290.   Writeln('By Jeff Duntemann');
  291.   Writeln('From the book: COMPLETE TURBO PASCAL, 3E');
  292.   Writeln('ISBN 0-673-38355-5');
  293.   ShowHelp;
  294.  
  295.   REPEAT
  296.     DisplayVector(VectorNumber);   { Show the vector # & address }
  297.     Readln(Command);               { Get a command from the user }
  298.     IF Length(Command) > 0 THEN    { If something was typed:     }
  299.       BEGIN
  300.         { See if a number was typed; if one was, it becomes the  }
  301.         { current vector number.  If an error in converting the  }
  302.         { string to a number occurs, Vectors then parses the     }
  303.         { string as a command.   }
  304.         Val(Command,NewVector,ErrorPosition);
  305.         IF ErrorPosition = 0 THEN VectorNumber := NewVector
  306.           ELSE
  307.             BEGIN
  308.               StripWhite(Command);       { Remove leading whitespace }
  309.               Command := ForceCase(Up,Command); { Force to upper case}
  310.               CommandChar := Command[1]; { Isolate first character   }
  311.               CASE CommandChar OF
  312.                 'Q','X' : Quit := True;  { Exit VECTORS }
  313.                 'D'     : DumpTargetData(VectorNumber); { Dump data  }
  314.                 'E'     : ChangeVector(VectorNumber); { Enter vector }
  315.                 'H'     : ShowHelp;
  316.                 'Z'     : BEGIN           { Zero the vector }
  317.                             Vector := NIL;   { NIL is 32 zero bits }
  318.                             SetIntVec(VectorNumber,Vector);
  319.                             DisplayVector(VectorNumber);
  320.                             Writeln('zeroed.');
  321.                             VectorNumber := (VectorNumber + 1) MOD 256
  322.                           END;
  323.                 '?'     : ShowHelp;
  324.               END {CASE}
  325.             END
  326.       END
  327.     { The following line increments the vector number, rolling over }
  328.     { to 0 if the number would have exceeded 255: }
  329.     ELSE VectorNumber := (VectorNumber + 1) MOD 256
  330.   UNTIL Quit;
  331. END.
  332.