[Back to SOUND SWAG index] [Back to Main SWAG index] [Original]

    {
    >> Can anyone here make me a program that will intercept anything sent
    >> to the pcspeaker so I can shut the speaker off when I am asleep. This
    >> is important because I run a BBS and I am getting tired of being woke
    >> up by callers who play doors that beep at 4:00 am.

    (from my archive of the german pascal echo, author lost)

    why should programmers open their pc case, as proposed, when a tsr will do
    it as well ?? <g> savings of 1,67 $ for a screwdriver to me ;-)))))

    tsr to diable/enable the pc speaker
    }

    program Speaker_off;

    {$S-}
    {$M 1048,0,0}

    uses Dos, Crt;

    type
         PSP  = record
                  dummy  : array [0..$2b] of byte;
                  EnvSeg : word;
                end;
         PSPP = ^PSP;

    const TimeInt       = $1C;
          PrgID      : string  = 'SPEAKOFF V1.0';

    var OldTimer      : pointer;

    PROCEDURE Speaker_aus; interrupt;
    BEGIN
      asm
        in al,61h
        and al,0fch
        out 61h,al
      end;
    END;

    function GetPtr( Adresse : pointer; PSPSeg : word ) : pointer;
    begin
      GetPtr := ptr( PSPSeg + ( Seg(Adresse^)-PrefixSeg ) , Ofs(Adresse^) );
    end;

    function YetInstalled( var IDStr : string ) : word;
    type MCB       = record
                       IdCode : char;
                       PSP : word;
                       Paras : word;
                     end;
         MCBPTR    = ^MCB;
         MCBPTRPTR = ^MCBPTR;
         STRPTR    = ^string;
    var Regs     : Registers;
        AktMCB   : MCBPTR;
        PSPFound : word;
        Ende     : boolean;
        StPtr    : ^string;
    begin
      Regs.AH := $52;
      MsDos( Regs );
      AktMCB := MCBPTRPTR( ptr( Regs.ES, Regs.BX-4 ) )^;
      Ende     := FALSE;
      PSPFound := 0;
      repeat
        if ( STRPTR( GetPtr( @IDStr, AktMCB^.PSP ))^ = IDStr ) and
           ( AktMCB^.PSP <> PRefixSeg ) then
          PSPFound := AktMCB^.PSP;
        if ( AktMCB^.IDCode = 'Z' ) then
          Ende := TRUE
        else
          AktMCB := ptr( Seg(AktMCB^) + AktMCB^.Paras + 1, 0 );
      until ( PSPFound <> 0 ) or Ende;
      YetInstalled := PSPFound;
    end;

    procedure CheckAndInit;
    type ZZ  = ^pointer;
    var
        Regs           : Registers;
        AktPtr         : pointer;
        PrgSeg, VioSeg : word;
        i              : byte;
        Install        : boolean;
        Parameter      : string;
    begin
      Install := TRUE;
      if ( Install = TRUE ) then
        begin
          Regs.ah := 15;
          intr($10, Regs);
          PrgSeg := YetInstalled( PrgID );
          if ( PrgSeg = 0 ) then
            begin
              GetIntVec( TimeInt, OldTimer );
              SetIntVec( TimeInt, @Speaker_aus);
              writeln( 'SPEAKOFF was installed.' );
              writeln( 'a 2. call will remove it from memory.');
              Keep(0);
            end
          else
            if ( ParamCount = 0 ) then
              begin
                GetIntVec( TimeInt, AktPtr );
                if ( AktPtr = GetPtr( @Speaker_aus, PrgSeg ) ) then
                  begin
                    SetIntVec( TimeInt, ZZ( GetPtr( @OldTimer, PrgSeg ))^ );
                    Regs.AH := $49;
                    Regs.ES := PSPP( ptr( PrgSeg, 0) )^.EnvSeg;
                    MsDos( Regs );
                    Regs.AH := $49;
                    Regs.ES := PrgSeg;
                    MsDos( Regs );
                    writeln( 'SPEAKOFF removed from memory.' );
                  end
                else
                  writeln( 'SPEAKOFF cannot be removed, another tsr ',
                           'found above.' );
              end;
        end;
    end;

    begin
      CheckAndInit;
    end.

    { end of code }

[Back to SOUND SWAG index] [Back to Main SWAG index] [Original]