Форум: "WinAPI";
Текущий архив: 2003.08.04;
Скачать: [xml.tar.bz2];
ВнизИспользование SetTimer и KillTimer Найти похожие ветки
← →
-=IGA=- (2003-06-03 08:29) [0]Может у когонибудь есть пример, напишите плиз.
← →
Digitman (2003-06-03 09:50) [1]вот, разбирайся :
function TTransportThread.Send(const Data: IDataBlock; WaitResultTimeout: Integer): IDataBlock;
var
Context: DWord;
Msg: TMsg;
hWaitEvent: THandle;
hTimer: THandle;
procedure TimerProc(hWnd: Thandle; uMsg: DWord; idTimer: THandle; dwTime: DWord); stdcall;
begin
KillTimer(0, hTimer);
hTimer := 0;
CloseHandle(hWaitEvent);
hWaitEvent := 0;
end;
begin
Result := nil;
hWaitEvent := 0;
hTimer := 0;
if Assigned(Data) then
begin
if Data.Context = 0 then
Data.Context := GetCurrentThreadId;
if WaitResultTimeout <> 0 then
begin
hWaitEvent := CreateEvent(nil, False, False, nil);
Win32Check(hWaitEvent <> 0);
end;
try
Context := SendMessage(FhWnd, TM_SEND_DATABLOCK, wParam(Data), hWaitEvent);
if Context = 0 then
raise EACSConnectionError.CreateRes(@sACSConnectionError);
if WaitResultTimeout <> INFINITE then
begin
hTimer := SetTimer(0, 0, WaitResultTimeout, @TimerProc);
Win32Check(hTimer <> 0);
end;
try
while True do
case MsgWaitForMultipleObjects(1, hWaitEvent, False, INFINITE, QS_ALLINPUT) of
WAIT_OBJECT_0:
begin
Result := IDataBlock(SendMessage(FhWnd, TM_RECV_DATABLOCK, hWaitEvent, Context));
if not Assigned(Result) then
raise EACSConnectionError.CreateRes(@sACSConnectionError);
end;
WAIT_OBJECT_0 + 1:
while PeekMessage(Msg, 0, 0, 0, PM_REMOVE) do
begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
WAIT_ABANDONED_0:
raise EACSConnectionError.CreateRes(@sACSConnectionError);
WAIT_FAILED:
raise EACSConnectionError.CreateRes(@sACSTimeoutError);
end;
finally
if hTimer <> 0 then
KillTimer(0, hTimer);
end;
finally
if hWaitEvent <> 0 then
CloseHandle(hWaitEvent);
end;
end;
end;
← →
Polevi (2003-06-03 13:20) [2]LOL
Страницы: 1 вся ветка
Форум: "WinAPI";
Текущий архив: 2003.08.04;
Скачать: [xml.tar.bz2];
Память: 0.44 MB
Время: 0.008 c