Source file: /~heha/hsn/t_und_m.zip/SRC/KEYSHIFT.PAS

library keyshift;
{$W-,K+,S-}
{$C MOVEABLE PRELOAD PERMANENT}	{gleiche Attribute wie Unit SYSTEM}
{$D Grauen Tastenblock hochschieben}
uses WinProcs,WinTypes,Win31;

type
 PtrRec=record
  Ofs,Sel:Word;
 end;

procedure Keybd_Event; far; external 'USER' index 289;
{ah=UpDownFlag   ; 00h for down stroke, 80h for up stroke
 al=VirtualKey	 ; Windows virtual-key code
 bh=PrefixFlag   ; 00h if no prefix, 1 if 0E0h prefix byte
 bl=ScanCode     ; hardware scan code
}
const
 KE_Code: TFarProc=@Keybd_Event;	{Keyboard_Event Adresse}
var
 KE_Data: Pointer;			{Daten-Zeiger}
 OrigBytes: array[0..4] of Byte;	{Original-Bytes}

procedure HookProc; far; forward;

procedure UpdateSel; assembler;
 asm	push	PtrRec[KE_Code].Sel
	push	PtrRec[KE_Data].Sel
	call	PrestoChangoSelector
	mov	PtrRec[KE_Data].Sel,ax
 end;

procedure SetBreak; assembler;
 asm	les	di,[KE_Data]
	mov	al,$EA		{Code für "Far Jump"}
	cld
	stosb
	mov	ax,offset HookProc
	stosw
	mov	ax,cs		{eigenes Codesegment}
	stosw
 end;

procedure SetBytes; assembler;	{gleichzeitig: Uninstall}
 asm	les	di,[KE_Data]
	mov	si,offset OrigBytes
	mov	cx,5
	cld
	rep	movsb		{Original-Bytes zurückspielen}
 end;

procedure HookProc; {far;} assembler;
 asm	push	ds
	 push	seg @data
	 pop	ds
	 pushf
	 push	es
	 pusha
	  call	UpdateSel	{Falls Verschiebungen auftraten: korrigieren}
	  call	SetBytes
	 popa
	 pop	es
	 popf
	 push	dx
	  cmp	bx,1*256+83	{Extended Del?}
	  mov	dx,VK_Snapshot*256+55
	  je	@@mk_ekey
	  cmp	bx,1*256+79	{Extended End?}
	  mov	dx,VK_Scroll*256+70
	  je	@@mk_key
	  cmp	bx,1*256+81	{Extended PgDn?}
	  mov	dx,VK_Pause*256+69
	  je	@@mk_key
	  cmp	bx,1*256+82	{Extended Insert?}
	  mov	dx,VK_Delete*256+83
	  je	@@mk_ekey
	  cmp	bx,1*256+71	{Extended Home?}
	  mov	dx,VK_End*256+79
	  je	@@mk_ekey
	  cmp	bx,1*256+73	{Extended PgUp?}
	  mov	dx,VK_Next*256+81
	  je	@@mk_ekey
	  cmp	al,VK_Snapshot	{PrintSc?}
{	  cmp	bx,0*256+55	geht nicht}
	  mov	dx,VK_Insert*256+82
	  je	@@mk_ekey
	  cmp	bx,0*256+70	{Scroll Lock?}
	  mov	dx,VK_Home*256+71
	  je	@@mk_ekey
	  cmp	bx,0*256+69	{Pause? (Ein künstliches Autorepeat fehlt!)}
	  mov	dx,VK_Prior*256+73
	  jne	@@1
@@mk_ekey:
	  mov	bh,1
@@mk_key:
	  mov	bl,dl
	  mov	al,dh
@@1:	 pop	dx
	 call	[KE_Code]
@@e:	 pushf
	 push	es
	 pusha
	  call	SetBreak
	 popa
	 pop	es
	 popf
	pop	ds
 end;

procedure HookInstall; assembler;
 asm	les	si,[KE_Code]
	mov	PtrRec[KE_Data].Ofs,si
	push	es
	call	AllocSelector
	mov	PtrRec[KE_Data].Sel,ax
	call	UpdateSel
	push	ds
	pop	es		{ES nun Datensegment}
	push	ds
	 lds	si,[KE_Data]
	 mov	di,offset OrigBytes
	 mov	cx,5
	 cld
	 rep	movsb
	pop	ds
	call	SetBreak	{Breakpoint setzen}
 end;

procedure HookUninstall; assembler;
 asm	call	SetBytes
	push	PtrRec[KE_Data].Sel
	call	FreeSelector	{Alias-Selektor freigeben}
 end;

var
 OldExit: Pointer;
procedure NewExit;
 begin
  ExitProc:=OldExit;
  HookUninstall;
 end;

begin
 HookInstall;
 OldExit:=ExitProc;
 ExitProc:=@NewExit;
end.