• Познакомьтесь с пентестом веб-приложений на практике в нашем новом бесплатном курсе

    «Анализ защищенности веб-приложений»

    🔥 Записаться бесплатно!

  • CTF с учебными материалами Codeby Games

    Обучение кибербезопасности в игровой форме. Более 200 заданий по Active Directory, OSINT, PWN, Веб, Стеганографии, Реверс-инжинирингу, Форензике и Криптографии. Школа CTF с бесплатными курсами по всем категориям.

Как бороться с “thread creation error

  • Автор темы msn777
  • Дата начала
Статус
Закрыто для дальнейших ответов.
M

msn777

Мастера подскажите, как бороться с “thread creation error: Недостаточно памяти для обработки команды”, говорит, что, мол, мало памяти, хотя под стек выделено 256M {$M 16384,268435456}, на машине стоит 512М, в диспетчере задач приложение показывает, что для приложения выделено около 5M. Пишу на Delphi 7 под WinXP.
Может, кто сталкивался с такой бедой, из каких соображений принимается решение, что не хватает памяти. До того как в проге было мало элементов (меньше сотни кнопок, меток и т.д.) такое сообщение не выскакивало, сейчас их несколько сотен, такое сообщение выскакивает, после того, как вызываю play_sound для проигрывания wav файла, но ф-н sndPlaySound все время выдает FALSE, хотя перенес этот модуль из старого проекта там все работало, а после этого еще раз play_sound но для пробирования тона, процесс (Thread) созданный sndPlaySound так и остается, а звука нет. Причем если вызывать sndPlaySound с тем же именем файла, но указанным как константа – звук есть, если же переменная (PChar) – звука нет.

Содержание ComboBox’ов (ItemIndex = -1 если задал имя файла ):
нет
100 Гц, 1 гудок
100 Гц, 2 гудка
200 Гц, 1 гудок
200 Гц, 2 гудка
300 Гц, 1 гудок
300 Гц, 2 гудка
500 Гц, 1 гудок
500 Гц, 2 гудка
700 Гц, 1 гудок
700 Гц, 2 гудка
1000 Гц, 1 гудок
1000 Гц, 2 гудка
1500 Гц, 1 гудок
1500 Гц, 2 гудка
2000 Гц, 1 гудок
2000 Гц, 2 гудка

type
TPlayToneThread = class(TThread) // Поток проигрывания тона
private
Frequency: integer; // Частота тона, Гц
Duration: integer; // Длительность выдачи тона, мс
Count: integer; // Кол-во выдаваемых тонов
protected
procedure Execute; override; // Исполняемая часть
end;

//----------------------------------- Выдать на динамик тон ----------------------------------------
procedure Sound(Frequency, Duration: Integer);
asm
push edx
push eax
mov eax, Win32Platform
cmp eax, VER_PLATFORM_WIN32_NT
jne @@9X
call Windows.Beep
ret
@@9X:
pop eax
pop edx
push ebx
push edx
mov bx, ax
mov ax, 34DDh
mov dx, 0012h
cmp dx, bx
jnc @@2
div bx
mov bx, ax
in al, 61h
test al, 3
jnz @@1
or al, 3
out 61h, al
mov al, 0B6h
out 43h, al
@@1:
mov al, bl
out 42h, al
mov al, bh
out 42h, al
call Windows.Sleep
in al, 61h
and al, 0FCh
out 61h, al
jmp @@3
@@2:
pop edx
@@3:
pop ebx
end;


//--------------------------------- Реализация потока проигрывания тона ----------------------------
procedure TPlayToneThread.Execute;
begin
FreeOnTerminate:=True; // По завершению работы освободить память
while Count>0 do
begin
Sound(Frequency,Duration);
sleep(Duration);
dec(Count);
end;
Terminate; // На всяк случай завершаем поток
end;


//--------------------------------- Процедура завершения потока ------------------------------------
procedure TfmOSC_Buzzer.end_thread(Sender: TObject);
begin
PlayToneThread:=nil; // На всяк случай уничтожаем объект
end;

//-------------------------------------- Проиграть звук --------------------------------------------
procedure TfmOSC_Buzzer.play_sound(cbSound: TComboBox; play: boolean = false);
const
Duration: integer = 75;
var
Frequency, Count: integer;
begin
if cbSound.ItemIndex=0 then exit; // Если нечего проигрывать то выходим

if cbSound.ItemIndex<0 then // Если это *.wav файл
try
sndPlaySound(PChar(cbSound.Text),SND_ASYNC); // то просто проигрываем его
except
end
else begin
Frequency:=StrToInt(Trim(Copy(cbSound.Text,1,4))); // Определили частоту и кол-во гудков
if Odd(cbSound.ItemIndex) then Count:=1 else Count:=2;
if IsWindowsNT then
begin
{
if PlayToneThread<>nil then // Если поток существует
if not PlayToneThread.Terminated then // Да он еще и не завершен
begin
if play then // Если нужно проиграть
PlayToneThread.Terminate // то завершили поток
else // Если событие
exit; // то выходим
end;
PlayToneThread:=TPlayToneThread.Create(true); // Создаем поток
PlayToneThread.OnTerminate:=end_thread; // Задали процедуру завершения
PlayToneThread.Priority:=tpNormal; // Задаем нормальный приоритет потоку
PlayToneThread.Frequency:=Frequency;
PlayToneThread.Duration:=Duration;
PlayToneThread.Count:=Count;
PlayToneThread.Resume; // Запускаем поток
}
{}
while Count>0 do
begin
Sound(Frequency,Duration);
sleep(Duration);
dec(Count);
end;
{}
end
else begin
while Count>0 do
begin
Sound(Frequency,Duration);
sleep(Duration);
dec(Count);
end;
end;
end;
end;
 
D

Dico

здесь по исходнику непонятно что именно занесли в регистр eax ( Win32Platform-что это за данные?)?
 
B

Barmutik

Просто так к вопросу: а чем не устраивает системная функция Beep для проигрывания ?
 
Z

zubr

msn777
1. В procedure Sound(Frequency, Duration: Integer) параметры Frequency, Duration нигде не используются.
2. В procedure Sound(Frequency, Duration: Integer) ты обращаешся к системному спикеру, для чего и нужны параметры частота и длительность тона. И в тоже время выдаешь звук через динамики с помощью функции Beep.
3. В procedure TfmOSC_Buzzer.play_sound(cbSound: TComboBox; play: boolean = false) procedure Sound(Frequency, Duration: Integer) выполняется не в потоке.
 
G

Guest

>здесь по исходнику непонятно что именно занесли в регистр eax ( Win32Platform-что это за данные?)?
Это проверка какая платформа NT или нет.

>Просто так к вопросу: а чем не устраивает системная функция Beep для проигрывания ?
Потому что прога должна работать и под 98, а там нет ф-н. проигроваия тона на спикере.

>1. В procedure Sound(Frequency, Duration: Integer) параметры Frequency, Duration нигде не используются.
Есть в Delphi такая штука как соглашение о передаваемых параметрах так вот Frequency, Duration передаются в EAX и EDX.

>2. В procedure Sound(Frequency, Duration: Integer) ты обращаешся к системному спикеру, для чего и нужны параметры частота и длительность тона. И в тоже время выдаешь звук через динамики с помощью функции Beep.
call Windows.Beep – это обращение к спикеру по NT с Frequency Duration

>3. В procedure TfmOSC_Buzzer.play_sound(cbSound: TComboBox; play: boolean = false) procedure Sound(Frequency, Duration: Integer) выполняется не в потоке.
Да потому, что не работает почему-то в потоке после первого вызова sndPlaySound(PChar(cbSound.Text),SND_ASYNC);
 
Z

zubr

Где ты вызываешь procedure TfmOSC_Buzzer.play_sound(cbSound: TComboBox; play: boolean = false)? Может в этом проблема.

Еще можешь попробовать вместо sndPlaySound что то типа этого:
Код:
procedure SoundWavFile(FileName:string);
var
format:TWaveFormatEx;
hzv:HWaveOut;
hider:WaveHdr;
buf:PChar;
fl:TMemoryStream;
begin
fl:=TMemoryStream.Create;
fl.LoadFromFile(FileName);
fl.Position:=0;
buf:=StrAlloc(fl.Size);
fl.Read(buf^, fl.Size);
format.wFormatTag:=WAVE_FORMAT_PCM;
format.nChannels:=2;
format.nSamplesPerSec:=44100;
format.nAvgBytesPerSec:=fl.Size;
format.nBlockAlign:=4;
format.wBitsPerSample:=16;
format.cbSize:=0;
waveOutOpen(@hzv, WAVE_MAPPER, @format, 0, 0, CALLBACK_NULL);
hider.lpData:=@buf^;
hider.dwBufferLength:=fl.Size;
fl.Free;
waveOutPrepareHeader(hzv, @hider, SizeOf(hider));
waveOutWrite(hzv, @hider, SizeOf(hider));
waveOutUnPrepareHeader(hzv, @hider, SizeOf(hider));
waveOutClose(hzv);
StrDispose(buf);
end;
 
Статус
Закрыто для дальнейших ответов.
Мы в соцсетях:

Обучение наступательной кибербезопасности в игровой форме. Начать игру!