erro no comando de som no XP
Tenho um comando de emissão de som pelo auto-falantes interno do pc.
Utilizo ele em diversos sistemas.
No win98 vinha funcionando bem. Mas agora em máquinas com windows XP dá um erro: ´Privileged Instruction´.
Para ver onde dá o erro, executei o sistema dentro do delphi. O erro deu dentro da função getport. No comando in AL, DX
O comando que dou é:
SOUND(3000);
DELAY(100);
SOUND(200);
DELAY(100);
NOsound;
Alguém sabe me dizer como posso resolver este problema???
Obrigado!
As funções são:
{ Pega o valor na porta de som }
function GetPort(address: Word): Word;
var bValue: Byte;
begin
asm
MOV DX, address
in AL, DX
MOV bValue, AL
end;
result := bValue;
end;
{ Grava um valor na porta de som }
procedure SetPort(address, value: Word);
var bValue: Byte;
begin
bValue := trunc(value and 255);
asm
MOV DX, address
MOV AL, bValue
OUT DX, AL
end;
end;
{ Encerra o som }
procedure NoSound;
var wValue: Word;
begin
wValue := GetPort($61);
wValue := wValue and $FC;
SetPort($61, wValue);
end;
{Gera um som com a frequencia informada }
procedure Sound(Freq: Word);
var B: Word;
begin
if Freq > 18 then
begin
Freq := Word(1193181 div LongInt(Freq));
B := GetPort($61);
if (B and 3) = 0 then
begin
SetPort($61, B or 3);
SetPort($43, $B6);
end;
SetPort($42, Freq);
SetPort($42, (Freq SHR 8));
end;
end;
{Da uma pausa por x msegundos }
procedure Delay(MSecs: Integer);
var FirstTickCount : LongInt;
begin
FirstTickCount:=GetTickCount;
repeat
Application.ProcessMessages;
until ((GetTickCount-FirstTickCount) >= LongInt(MSecs));
end;
Utilizo ele em diversos sistemas.
No win98 vinha funcionando bem. Mas agora em máquinas com windows XP dá um erro: ´Privileged Instruction´.
Para ver onde dá o erro, executei o sistema dentro do delphi. O erro deu dentro da função getport. No comando in AL, DX
O comando que dou é:
SOUND(3000);
DELAY(100);
SOUND(200);
DELAY(100);
NOsound;
Alguém sabe me dizer como posso resolver este problema???
Obrigado!
As funções são:
{ Pega o valor na porta de som }
function GetPort(address: Word): Word;
var bValue: Byte;
begin
asm
MOV DX, address
in AL, DX
MOV bValue, AL
end;
result := bValue;
end;
{ Grava um valor na porta de som }
procedure SetPort(address, value: Word);
var bValue: Byte;
begin
bValue := trunc(value and 255);
asm
MOV DX, address
MOV AL, bValue
OUT DX, AL
end;
end;
{ Encerra o som }
procedure NoSound;
var wValue: Word;
begin
wValue := GetPort($61);
wValue := wValue and $FC;
SetPort($61, wValue);
end;
{Gera um som com a frequencia informada }
procedure Sound(Freq: Word);
var B: Word;
begin
if Freq > 18 then
begin
Freq := Word(1193181 div LongInt(Freq));
B := GetPort($61);
if (B and 3) = 0 then
begin
SetPort($61, B or 3);
SetPort($43, $B6);
end;
SetPort($42, Freq);
SetPort($42, (Freq SHR 8));
end;
end;
{Da uma pausa por x msegundos }
procedure Delay(MSecs: Integer);
var FirstTickCount : LongInt;
begin
FirstTickCount:=GetTickCount;
repeat
Application.ProcessMessages;
until ((GetTickCount-FirstTickCount) >= LongInt(MSecs));
end;
Briciosm
Curtidas 0
Respostas
Massuda
12/07/2006
Esse tipo de código não é permitido em máquinas com Windows NT/2K/XP/2K3... nesses SOs não é permitido aos aplicativos ter acesso direto ao hardware. [url=http://forum.clubedelphi.net/viewtopic.php?t=70844]Neste tópico[/url] o colega Dopi cita um programa chamado UserPort que deve permitir que você execute esse tipo de código (vai precisar fazer adaptações); infelizmente, o link que ele cita no post está fora do ar hoje (manutenção).
GOSTEI 0
Briciosm
12/07/2006
Baixei o programa.
Mas não sei como proceder. Que porta liberar...
Alguém poderia me ajudar??
Obrigado.
Mas não sei como proceder. Que porta liberar...
Alguém poderia me ajudar??
Obrigado.
GOSTEI 0
Dedi
12/07/2006
Amigo,
Faça assim ,Primeiro vc testa se é win xp se for use
Faça assim ,Primeiro vc testa se é win xp se for use
Windows.Beep (200, 200); Windows.Beep (500, 300); Windows.Beep (300, 100);
GOSTEI 0
Massuda
12/07/2006
Windows.Beep (200, 200);
Muito mais fácil! Não precisa do driver e funciona extamente onde o código original do briciosm não funciona.GOSTEI 0