We don't need a component at all. We can call the API (like UpdateTimer) in your code and use the component hidden window. There is no conflict possible with the WM_TIMER message.
-- Contribute to the SSL Effort. Visit http://www.overbyte.be/eng/ssl.html -- [EMAIL PROTECTED] http://www.overbyte.be ----- Original Message ----- From: "Arno Garrels" <[EMAIL PROTECTED]> To: "ICS support mailing" <twsocket@elists.org> Sent: Wednesday, March 21, 2007 4:42 PM Subject: Re: [twsocket] Architectural question II > Francois Piette wrote: >>>>> Don't use TTimer in any worker thread since it is NOT thread-safe! >>>> >>>> Why is it used in HttpCli then ? >>>> see THttpCli.SendRequest >>> >>> That's true, I would not define UseBandwidthControl in multithreaded >>> applications until a thread-safe timer becomes available. >> >> We could use a bare bone API timer instead. >> What do you think ? > > Something like attached below? It creates its window thread-save, > but I prefer a timer that was able to use the hidden window(s) > of V6, or may be we think about a windowless timer (Thread, signals, > and WaitForMultipleObjects)? > > -- > Arno Garrels [TeamICS] > http://www.overbyte.be/eng/overbyte/teamics.html > > > ----------------------------------------------------------------------- > unit IcsTimers; > > interface > > uses > Windows, Messages, Sysutils, Consts, Classes, Forms; > > type > EIcsTimerException = class(Exception); > TIcsTimer = class(TComponent) > private > FInterval: Cardinal; > FOnTimer: TNotifyEvent; > FEnabled: Boolean; > FWindowHandle : Hwnd; > procedure UpdateTimer; > procedure SetInterval(const Value: Cardinal); > procedure SetOnTimer(Value: TNotifyEvent); > procedure SetEnabled(const Value: Boolean); > procedure AllocateHwnd; > procedure DeallocateHwnd; > public > constructor Create(AOwner: TComponent); override; > destructor Destroy; override; > published > property Enabled: Boolean read FEnabled write SetEnabled default True; > property Interval: Cardinal read FInterval write SetInterval default > 1000; > property OnTimer: TNotifyEvent read FOnTimer write SetOnTimer; > end; > > var > CritSectWndClass: TRtlCriticalSection; > WndCnt: Integer = 0; > > implementation > > procedure Register; > begin > RegisterComponents('FPiette', [TIcsTimer]); > end; > > const > WndClassName: PChar = 'OverbyteIcsTimerWndClass'; > > { TIcsTimer } > > function TimerWndProc(aWnd: HWND; aMsg : Integer; aWParam : WPARAM; > aLParam : LPARAM): Integer; stdcall; > var > Obj : TObject; > begin > if (aMsg <> WM_TIMER) then > Result := DefWindowProc(aWnd, aMsg, aWParam, aLParam) > else begin > Obj := TObject(aWParam); > if (Obj is TIcsTimer) then > begin > Result := 0; > try > if Assigned(TIcsTimer(Obj).OnTimer) then > TIcsTimer(Obj).OnTimer(Obj); > except > Application.HandleException(Obj); > end > end > else > Result := DefWindowProc(aWnd, aMsg, aWParam, aLParam) > end; > end; > > procedure TIcsTimer.AllocateHwnd; > var > WndClass: TWndClass; > Res: Hwnd; > begin > EnterCriticalSection(CritSectWndClass); > try > if FWindowHandle <> 0 then Exit; > if not GetClassInfo(HInstance, WndClassName, WndClass) then > begin > ZeroMemory(@WndClass, SizeOf(TWndClass)); > with WndClass do > begin > lpfnWndProc := @TimerWndProc; > cbWndExtra := SizeOf(Pointer); > hInstance := SysInit.HInstance; > lpszClassName := WndClassName; > end; > Res := Windows.RegisterClass(WndClass); > if Res = 0 then > begin > Res := GetLastError; > raise EIcsTimerException.CreateFmt('RegisterClass failed. Error #%d > %s', > [Res, SysErrorMessage(Res)]); > end; > end; > Res := CreateWindowEx(WS_EX_TOOLWINDOW, WndClassName, > '', WS_POPUP, 0, 0, 0, 0, 0, 0, HInstance, nil); > if Res = 0 then > begin > Res := GetLastError; > raise EIcsTimerException.CreateFmt('CreateWindowEx failed. Error #%d > %s', > [Res, SysErrorMessage(Res)]); > end; > Inc(WndCnt); > FWindowHandle := Res; > finally > LeaveCriticalSection(CritSectWndClass); > end; > end; > > procedure TIcsTimer.DeallocateHwnd; > begin > EnterCriticalSection(CritSectWndClass); > try > if FWindowHandle = 0 then Exit; > DestroyWindow(FWindowHandle); > Dec(WndCnt); > if WndCnt <= 0 then > Windows.UnregisterClass(WndClassName, HInstance); > finally > LeaveCriticalSection(CritSectWndClass); > end; > end; > > constructor TIcsTimer.Create(AOwner: TComponent); > begin > inherited Create(AOwner); > FEnabled := True; > FInterval := 1000; > AllocateHWnd; > end; > > destructor TIcsTimer.Destroy; > begin > FEnabled := False; > UpdateTimer; > DeallocateHWnd; > inherited Destroy; > end; > > procedure TIcsTimer.SetEnabled(const Value: Boolean); > begin > if Value <> FEnabled then > begin > FEnabled := Value; > UpdateTimer; > end; > end; > > procedure TIcsTimer.SetInterval(const Value: Cardinal); > begin > if Value <> FInterval then > begin > FInterval := Value; > UpdateTimer; > end; > end; > > procedure TIcsTimer.SetOnTimer(Value: TNotifyEvent); > begin > FOnTimer := Value; > UpdateTimer; > end; > > procedure TIcsTimer.UpdateTimer; > begin > KillTimer(FWindowHandle, Cardinal(Self)); > if (FInterval <> 0) and FEnabled and Assigned(FOnTimer) then > if SetTimer(FWindowHandle, Cardinal(Self), FInterval, nil) = 0 then > raise EOutOfResources.Create(SNoTimers); > end; > > initialization > InitializeCriticalSection(CritSectWndClass); > > finalization > DeleteCriticalSection(CritSectWndClass); > end. > > ----------------------------------------------------------------------- > > > -- > To unsubscribe or change your settings for TWSocket mailing list > please goto http://www.elists.org/mailman/listinfo/twsocket > Visit our website at http://www.overbyte.be -- To unsubscribe or change your settings for TWSocket mailing list please goto http://www.elists.org/mailman/listinfo/twsocket Visit our website at http://www.overbyte.be
