-
Есть ini-файл, из него считывается время срабатывания таймеров(их несколько) но почему то не срабатывает таймер.. Приведу весь кусок кода:
program TimeServ;
uses
Windows,
Messages,
Classes,
IniFiles,
SysUtils;
var
AMessage: TMsg;
hTimers: array of THandle;
procedure TimerAPCProc(lpArgToCompletionRoutine: PChar; dwTimerLowValue: DWORD; dwTimerHighValue: DWORD); stdcall;
begin
MessageBox(0, '1', '1', 0); end;
function InstallTimers: BOOL;
var
Sections: TStrings;
iTimer: integer;
sysTime: SYSTEMTIME;
fTime: FILETIME;
begin
try
Sections := TStringList.Create;
with TIniFile.Create('TimeManager.ini') do
try
ReadSections(Sections);
if Sections.Count > 0 then
begin
SetLength(hTimers, Sections.Count);
for iTimer := 0 to Sections.Count - 1 do
begin
hTimers[iTimer] := CreateWaitableTimer(nil, false, nil);
DateTimeToSystemTime(StrToDateTime(Sections[iTimer]), sysTime); SystemTimeToFileTime(sysTime, fTime);
LocalFileTimeToFileTime(fTime, fTime);
SetWaitableTimer(hTimers[iTimer], TLargeInteger(fTime), 0, @TimerAPCProc, nil, false);
end;
end;
finally
Free;
end;
finally
Sections.Free;
end;
end;
function UninstallTimers: BOOL;
var
iTimer: integer;
begin
for iTimer := 0 to Length(hTimers) - 1 do
begin
CancelWaitableTimer(hTimers[iTimer]);
CloseHandle(hTimers[iTimer]);
end;
SetLength(hTimers, 0);
end;
begin
InstallTimers;
while GetMessage(AMessage, 0, 0, 0) do
DispatchMessage(AMessage);
UninstallTimers;
end.
Подскажите пожалуйста..
-
SetWaitableTimer - это функция.
-
она возвращает true, т.е. все успешно..
-
> Dmitry_177 (29.10.07 13:44)
> while GetMessage(AMessage, 0, 0, 0) do > DispatchMessage(AMessage);
Это ж не user timer, попробуй, скажем, SleepEx(INFINITE, True).
-- Regards, LVT.
-
> Dmitry_177 (29.10.07 14:09) [2]
If you call SetWaitableTimer and the thread is not in an alertable state, the completion routine is canceled.
Нить находится в тревожном состоянии (alertable state) только в момент исполнения ф-ции WaitForSingleObjectEx, [Msg]WaitForMultipleObjectsEx, Read/WriteFileEx, SleepEx.
-
т.е. вот так чтоли? =)
begin
InstallTimers;
SleepEx(INFINITE, True);
UninstallTimers;
end.
-
Ну хотя бы так.
-
эм.. сработало :) но только вот программа после срабатывания выключилась почему то.. что-то непойму почему, ведь бесконечное же ожидание..
-
А справку читать - дело не царское ? Там же логика работы этой (и других упомянутых) ф-ции описана довольно четко.
-
Прочитал повнимательней.. понял в чем дело.. а вот как сделать так чтобы все таймеры сработали? Что-то я не придумаю никак.. Может SleepEx в бесконечный цикл поставить? Ведь программа вылетает при первом же срабатывании..
-
> Dmitry_177 (29.10.07 18:08) [9]
> Прочитал повнимательней.. понял в чем дело.. а вот как сделать > так чтобы все таймеры сработали?
Если таймеров не более 64, то все можно отслеживать в одном потоке путем WaitForMultipleObjects|Ex.
Ну, а если более, то в нескольких потоках.
-- Regards, LVT.
-
само время срабатывания таймеров может быть записано в файле совсем не по порядку(т.е. не по возрастанию).. а если будет так что более позднее срабатывание считается первее чем более раннее?
-
> Dmitry_177 (29.10.07 19:48) [11]
А то.
-- Regards, LVT.
-
я сделал в цикле SleepEx, вроде все работает =) только у меня еще один вопрос возник.. Мне нужно в процедуру TimerAPCProc передать значение Sections[iTimer], т.е. дату с временем в строке, делаю так:
SetWaitableTimer(hTimers[iTimer], TLargeInteger(fTime), 0, @TimerAPCProc, PChar(Sections[iTimer]), false);
а в lpArgToCompletionRoutine обрезанная строка, т.е. например исходная такая: 29.10.2007 21:33:00 а в процедуре она такая: 29.10.2007 21:33
-
> а в lpArgToCompletionRoutine обрезанная строка, т.е. например > исходная такая: 29.10.2007 21:33:00 а в процедуре она такая: > 29.10.2007 21:33 >
"Гложат меня смутные сомнения. У Шпака - магнитофон, у посла - медальон"? Очень смущают "конечные нули", на которых строка обрезается. Возможно я и не прав. Но...
-
> Dmitry_177 (29.10.07 22:30) [13]
Так делать нельзя вообще. Выражением PChar(Sections[iTimer]) ты передал адрес строки, время жизни которой равно времени жизни объекта Sections, который уничтожается тобой сразу же по возврату из InstallTimers.
-
да уж.. а как тогда? Может так тогда? var
str: string;
function InstallTimers: BOOL;
begin
...
str := PChar(Sections[iTimer]);
SetWaitableTimer(hTimers[iTimer], TLargeInteger(fTime), 0, @TimerAPCProc, PChar(str), false);
...
end;
-
блин, торможу сорри.. сделал Sections глобальной переменной и все ок
-
Еще маленький вопросик, можно ли в TimerAPCProc определить какой таймер сработал? Ведь если таймер с периодом он так и будет дергать TimerAPCProc, так вот если уже больше он не понадобится, чтоб можно его было хлопнуть в этой же TimerAPCProc..
-
> можно ли в TimerAPCProc определить какой таймер сработал?
На то у TimerAPCProc и существует 1-й параметр - передавай через него хоть хэндл, хоть черта лысого)
-
мне нужно еще и строку передавать..
-
> мне нужно еще и строку передавать
А про record'ы ты что-нить слышал ?)
-
свою структуру? в принципе да.. т.е. если сделать как-нибудь так: type
TDataTimer = packed record
hTimer: THandle;
Str: PChar;
end; то придется еще и массив этих структур создавать?
-
function InstallTimers: BOOL;
var
DataTimer: TDataTimer;
begin
...
DataTimer.hTimer := hTimers[iTimer];
DataTimer.StrDateTime := PChar(Sections[iTimer]);
SetWaitableTimer(hTimers[iTimer], TLargeInteger(fTime), 60000, @TimerAPCProc, Pointer(DataTimer), false);
...
end; Вот так ошибка: Invalid typecast
-
> придется еще и массив этих структур создавать? >
Нафига ?
> Вот так ошибка: Invalid typecast
Почему бы и нет, если ты тип, несовместимый с указательным, пытаешься привести к указательному ?
-
> Нафига ?
а что тогда можно сделать?
-
- Перед вызовом SetWaitableTimer создать экз-р структуры TDataTimer - Заполнить поле hTimer этой структуры хэндлом соотв.таймера - Вызвать SetWaitableTimer, передав параметром указатель на этот экз-р - В теле TimerAPCProc при необходимости уничтожить этот экз-р, ибо ссылка на него передана 1-м параметром и доступна.
-
> - Перед вызовом SetWaitableTimer создать экз-р структуры > TDataTimer
если она объявлена в разделе описания переменных: var
DataTimer: TDataTimer; она разве не создана?
-
> она разве не создана? >
Создана. В единственном экз-ре.
А у тебя куча объектов-таймеров, и каждый из них при таком решении нуждается в собственном экз-ре.
-
а как их тогда создавать?
-
например, так:
PDataTimer = ^TDataTimer;
TDataTimer = packed record .. end;
.. pdt: PDataTimer;
..
New(pdt);
-
Спасибо! соответственно и удалято тогда Dispose(pdt) ?
-
разумеется !
-
Только ведь в теле TimerAPCProc у тебя не будет никаких pdt, а будет 1-й параметр указательного типа, его и указывай в кач-ве параметра для Dispose
-
я так и понял :) спасибо!
-
Блин! Решил еще добавить событие на считывание новых значений из этого же файла.. SleepEx уже не спасает..
function ThreadEvent(Param: Pointer): DWORD; stdcall;
begin
while true do
begin
if WaitForSingleObject(hEvent, INFINITE) = WAIT_OBJECT_0 then
begin
UninstallTimers;
InstallTimers;
end;
end;
Result := 0;
end;
...
InstallTimers;
hEvent := CreateEvent(nil, false, false, EventName);
CloseHandle(CreateThread(nil, 0, @ThreadEvent, nil, 0, idThread));
while true do
SleepEx(INFINITE, True);
-
т.е. дело в том что событие не срабатывает.. сделал трассировку, в функции события ThreadEvent останавливается на WaitForSingleObject и все..
-
тебе не надоело на куче формов одно и то же писать? ))
-
> SleepEx уже не спасает
> останавливается на WaitForSingleObject и все
У попа была собака..
Goto [4]
-
непонимаю всеравно в чем дело.. может этот SleepEx срабатывает первей и не дает сработать WaitForSingleObject-у в другом потоке?
-
Причем здесь другой поток ?
SleepEx у тебя сработал ? Сработал. TimerAPCProc вызывается при этом ? Вызывается. Ответ на вопрос ты получил ? Получил.
Так в чем же дело ?
-
Dmitry_177 (30.10.07 18:59) [35] и Dmitry_177 (30.10.07 19:07) [36]
-
> Dmitry_177 (01.11.07 15:37) [41]
> SleepEx уже не спасает
А от чего он должен "спасти" ?
От "несрабатывания таймера" он тебя "спас", что ты еще от него хочешь ?
-
чтобы в такой "конструкции" событие срабатывало или может как-то подругому сделать..
-
Каким боком SleepEx относится к "срабатыванию события" ? Никаким.
-
странно почему тогда оно не срабатывает, приведу весь код: первая программа, та которая устанавливает таймеры и реагирует на событие для считывания новых таймеров из файла(запущена постоянно):program TimeServ;
uses
Windows,
Messages,
ShFolder,
Classes,
IniFiles,
SysUtils;
const
EventName = '';
type
PDataTimer = ^TDataTimer;
TDataTimer = packed record hTimer: THandle;
StrDateTime: PChar;
end;
var
hEvent: THandle;
idThread: DWORD;
hTimers: array of THandle;
StrFilePath: string;
Sections: TStrings;
function GetStrFilePath: string;
var
StrBuffer: array [0 .. MAX_PATH - 1] of Char;
StrAppDataFolder: string;
begin
ShGetFolderPath(0, CSIDL_APPDATA, 0, 0, StrBuffer);
StrAppDataFolder := StrBuffer + '\TimeManager';
if not DirectoryExists(StrAppDataFolder) then
ForceDirectories(StrAppDataFolder);
Result := StrAppDataFolder + '\TimeManager.ini';
end;
procedure TimerAPCProc(lpArgToCompletionRoutine: PDataTimer; dwTimerLowValue: DWORD; dwTimerHighValue: DWORD); stdcall;
begin
with TIniFile.Create(StrFilePath) do
try
if MessageBox(0, PChar(ReadString(lpArgToCompletionRoutine.StrDateTime, 'Note', '') + #13#10#13#10 + 'Удалить это напоминание?'), 'Напоминание', MB_ICONQUESTION or MB_YESNO) = idYes then
begin
CancelWaitableTimer(lpArgToCompletionRoutine.hTimer);
CloseHandle(lpArgToCompletionRoutine.hTimer);
EraseSection(lpArgToCompletionRoutine.StrDateTime);
Dispose(lpArgToCompletionRoutine);
end;
finally
Free;
end;
end;
procedure InstallTimers;
var
iTimer: integer;
sysTime: SYSTEMTIME;
fTime: FILETIME;
DataTimer: PDataTimer;
begin
with TIniFile.Create(StrFilePath) do
try
ReadSections(Sections);
if Sections.Count > 0 then
begin
SetLength(hTimers, Sections.Count);
for iTimer := 0 to Sections.Count - 1 do
begin
hTimers[iTimer] := CreateWaitableTimer(nil, false, nil);
DateTimeToSystemTime(StrToDateTime(Sections[iTimer]), sysTime);
SystemTimeToFileTime(sysTime, fTime);
LocalFileTimeToFileTime(fTime, fTime);
New(DataTimer);
DataTimer.hTimer := hTimers[iTimer];
DataTimer.StrDateTime := PChar(Sections[iTimer]);
SetWaitableTimer(hTimers[iTimer], TLargeInteger(fTime), Round(Frac(StrToDateTime(ReadString(Sections[iTimer], 'Period', '0'))) * 86400) * 1000, @TimerAPCProc, DataTimer, false); end;
end;
finally
Free;
end;
end;
procedure UninstallTimers;
var
iTimer: integer;
begin
for iTimer := 0 to Length(hTimers) - 1 do
begin
CancelWaitableTimer(hTimers[iTimer]);
CloseHandle(hTimers[iTimer]);
end;
SetLength(hTimers, 0);
Sections.Clear;
end;
function ThreadEvent(Param: Pointer): DWORD; stdcall;
begin
while true do
begin
if WaitForSingleObject(hEvent, INFINITE) = WAIT_OBJECT_0 then
begin
UninstallTimers;
InstallTimers;
end;
end;
Result := 0;
end;
begin
StrFilePath := GetStrFilePath;
Sections := TStringList.Create;
InstallTimers;
hEvent := CreateEvent(nil, false, false, EventName);
CloseHandle(CreateThread(nil, 0, @ThreadEvent, nil, 0, idThread));
while true do
SleepEx(INFINITE, True);
UninstallTimers;
Sections.Free;
end. теперь вторая, та которая записывает таймеры и дергает событие(запускается нерегулярно):в ней в принципе ничего сложного нету, она записывает в файл таймеры, которые вводятся с использованием форм и по завершению дергает событие.. Я думаю саму запись ненужно показывать, приведу FormClose, который собственно и дергает событие: procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); var
hEvent: THandle;
begin
hEvent := CreateEvent(nil, false, false, EventName);
if hEvent = INVALID_HANDLE_VALUE then
Exit;
if GetLastError = ERROR_ALREADY_EXISTS then
SetEvent(hEvent);
CloseHandle(hEvent);
end; Код трассировал, SetEvent срабатывает, т.е. само событие 100% дергается..
-
Все понятно. Но причем здесь SleepEx ? Она не имеет никакого отношения к потоку, выполняющему ф-цию ThreadEvent.
-
странно, но почему тогда событие не работает? останавливается на WaitForSingleObject в ThreadEvent и все..
-
Значит константы EventName в этих проектах не совпадают.
-
смотрел, 100% совпадают.. еслиб даже не совпадали бы то в FormClose не сработало бы условие: if GetLastError = ERROR_ALREADY_EXISTS then Значение EventName как вы наверно догадались я генерировал Ctl+Shift+G
-
А нафига этот поток нужен вообще ?
Чем не устроила WaitForSingleObjectEx прямо в основном потоке ? И почем в осн.потоке нет цикла вызова Ex-функции ? Ты вообще в [8] вник ?
-
> Чем не устроила WaitForSingleObjectEx прямо в основном потоке > ?
А как ее применить в основном потоке? Вот так?
InstallTimers;
hEvent := CreateEvent(nil, false, false, EventName);
while true do
begin
if WaitForSingleObjectEx(hEvent, INFINITE, True) = WAIT_OBJECT_0 then
begin
UninstallTimers;
InstallTimers;
end;
end;
-
> Dmitry_177 (01.11.07 21:58) [51]
RTFM бы ты, Джеф Рихтер: Windows для профи. Ну, или, хотя б, msdn.
-- Regards, LVT.
-
а действительно так заработало, как я написал в Dmitry_177 (01.11.07 21:58) [51]
кстати мы создаем в InstallTimers, структуры TDataTimer: New(DataTimer); удаляем их в TimerAPCProc: Dispose(lpArgToCompletionRoutine);.. А если время срабатывания будет удалено в той второй программе, то получается DataTimer не удалится?
-
на самом деле как тогда удалять DataTimer? вот задам я таймер в той программе, в этой создастся DataTimer и установится таймер.. А потом в той программе удалю этот таймер.. то что будет с DataTimer? Как его удалять?
|