Re: [twsocket] Architectural question II

[Arno Garrels]

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