home *** CD-ROM | disk | FTP | other *** search
/ Der Mediaplex Sampler - Die 6 von Plex / 6_v_plex.zip / 6_v_plex / DISK6 / OS_19 / WUNDERKI.ZIP / COMPATIB.PAS < prev    next >
Pascal/Delphi Source File  |  1993-09-19  |  3KB  |  105 lines
  1. Unit Compatib;
  2.  
  3. Interface
  4.  
  5. Const
  6.   FCarry     = $0001;
  7.   FParity    = $0004;
  8.   FAuxiliary = $0010;
  9.   FZero      = $0040;
  10.   FSign      = $0080;
  11.   FOverflow  = $0800;
  12.  
  13. Type
  14.   Registers = Record
  15.                 Case Integer of
  16.                   0: (AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags : Word);
  17.                   1: (AL,AH,BL,BH,CL,CH,DL,DH          : Byte);
  18.               End;
  19.  
  20.   { Nur die Int-Vektoren für INT 0,4,5,6,7,$10 können }
  21.   { gesetzt/gelesen werden.                           }
  22.  
  23.   Procedure GetIntVec(IntNo : Byte;Var Vector : Pointer);
  24.   Procedure SetIntVec(IntNo : Byte;Vector : Pointer);
  25.   Procedure Intr(IntNo : Byte;Var Regs : Registers);
  26.   Procedure MsDos(Var Regs : Registers);
  27.  
  28. Implementation
  29.  
  30.   Function VioWrtTTY(s : PChar;Len : Word;VioHandle : Word) : Word; Far;
  31.     External 'VIOCALLS' Index 19;
  32.   Function DosSetVec(VecNum : Word;Handler : Pointer;Var PrevHandler : Pointer) : Word; Far;
  33.     External 'DOSCALLS' Index 89;
  34.   Procedure DosWrite(Handle : Word;Var Buf;Count : Word;Var WCount : Word); Far;
  35.     External 'DOSCALLS' Index 138;
  36. Type
  37.   TKbdKeyInfo = Record
  38.                   chChar    : Char;
  39.                   chScan    : Char;
  40.                   fbStatus  : Byte;
  41.                   bNlsShift : Byte;
  42.                   fsState   : Word;
  43.                   time      : LongInt;
  44.                 End;
  45.   Function KbdPeek(Var KeyInfo : TKbdKeyInfo;KbdHandle : Word) : Word; Far;
  46.     External 'KBDCALLS' Index 22;
  47.  
  48.   Procedure GetIntVec(IntNo : Byte;Var Vector : Pointer);
  49.   Var
  50.     p : Pointer;
  51.   Begin
  52.     Vector := Nil;
  53.     If DosSetVec(IntNo,Nil,p) = 0 then
  54.       Begin
  55.         Vector := p;
  56.         DosSetVec(IntNo,p,p);
  57.       End;
  58.   End;
  59.  
  60.   Procedure SetIntVec(IntNo : Byte;Vector : Pointer);
  61.   Var
  62.     p : Pointer;
  63.   Begin
  64.     DosSetVec(IntNo,Vector,p);
  65.   End;
  66.  
  67.   Procedure Intr(IntNo : Byte;Var Regs : Registers);
  68.   Var
  69.     w : Word;
  70.     KeyInfo : TKbdKeyInfo;
  71.   Begin
  72.     Case IntNo of
  73.       $16 : Case Regs.AH of
  74.               $01 : Begin  { Check for keystroke. }
  75.                       KbdPeek(KeyInfo,0);
  76.                       If (KeyInfo.fbStatus And $40) <> 0 then
  77.                         Begin
  78.                           Regs.Flags := Regs.Flags And Not(FZero);
  79.                           Regs.AL    := Ord(KeyInfo.chChar);
  80.                           Regs.AH    := Ord(KeyInfo.chScan);
  81.                         End
  82.                       else
  83.                         Regs.Flags := Regs.Flags Or FZero;
  84.                       Exit;
  85.                     End;
  86.             End;
  87.       $21 : Case Regs.AH of
  88.               $09 : Begin  { Write string to standard output. }
  89.                       w := 0;
  90.                       While Mem[Regs.DS:Regs.DX + w] <> Ord('$') do Inc(w);
  91.                       DosWrite(1,Ptr(Regs.DS,Regs.DX)^,w,w);
  92.                       Exit;
  93.                     End;
  94.             End;
  95.     End;
  96.     VioWrtTTY('Unsupported INT'^M^J,17,0);
  97.     RunError(99);
  98.   End;
  99.  
  100.   Procedure MsDos(Var Regs : Registers);
  101.   Begin
  102.     Intr($21,Regs);
  103.   End;
  104.  
  105. End.