globus_ussr
Member | Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
{$M $1000,0,0}
program ScanCode;
uses
crt,dos;
var
OldKey: procedure;
k,c,c1: byte;
vkl,onSound,onSound1: boolean;
Dlit,vHz: integer;
PPr: Boolean;
procedure Int9; assembler; asm nop; nop; nop; end;
{$F+}
procedure Key; interrupt;
begin
asm
pushf
call dword ptr Int9
sti
mov AH,02h
INT 16h
mov k,AL
end;
c1:=c;
c:=Port[$60];
onSound:=(c=1)or(c=129);
if ((k and $01)=$01)and(onSound) then onSound1:=FALSE;
if ((k and $02)=$02)and(onSound) then onSound1:=TRUE;
onSound:=(c<128)and(onSound1);
If c=1 then {- ¦ «Ё ESC}
vkl:=not vkl;{ўЄ«озс- ०Ё¬ ®в®Ўа ¦Ґ-Ёп Є®¤®ў - ¦Ё¬ Ґ¬ле Є« ўЁи}
If vkl Then
Begin
write (' kod=',c,' ');
If c=c1+128 Then Writeln; {®вЇгбвЁ«Ё Є« ўЁиг}
End;
if onSound then
begin
sound(vHz);
delay(Dlit);
nosound;
end;
end;
{$F-}
function _GetNum(aS: string; aMin,aMax: integer; eerror: string): Integer;
var
vCode: Integer;
vRes: Integer;
begin
_GetNum := 0;
if aS = '' then begin
WriteLN(eerror, ' net parametra!');
PPr := True;
Exit;
end;
Val(aS, vRes, vCode);
if vCode <> 0 then begin
WriteLN(eerror, ' ne 4islo!');
PPr := True;
Exit;
end;
if (vRes < aMin) or (vRes > aMax) then begin
WriteLN(eerror, ' vyhodit iz diappazona: ',aMin,'..',aMax);
PPr := True;
Exit;
end;
_GetNum := vRes;
end;
begin
c:=0;
onSound1:=TRUE;
vkl := False;
PPr := False;
Dlit := _GetNum(ParamStr(1), 10, 100, 'Dlitelnost:');
vHz := _GetNum(ParamStr(2), 100, 10000, 'Chastota:');
if PPr then begin
WriteLN('--> Net Parametrov.');
Exit;
end;
writeln('Left Shift + Esc = Sound ON');
writeln('Right Shift + Esc = Sound OFF');
writeln('Esc = Pokazivat ScanCode');
GetIntVec($9,@OldKey);
move(OldKey,ptr(seg(Int9),ofs(Int9))^,4);
SetIntVec($9,@Key);
Keep(0);
end. |
