IdAntiFreezeBase.pas 4.4 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178
  1. {
  2. $Project$
  3. $Workfile$
  4. $Revision$
  5. $DateUTC$
  6. $Id$
  7. This file is part of the Indy (Internet Direct) project, and is offered
  8. under the dual-licensing agreement described on the Indy website.
  9. (http://www.indyproject.org/)
  10. Copyright:
  11. (c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved.
  12. }
  13. {
  14. $Log$
  15. }
  16. {
  17. Rev 1.5 8/17/2004 2:54:38 PM JPMugaas
  18. Made ShouldUse virtual again.
  19. Rev 1.4 2004.06.16 8:08:52 PM czhower
  20. Temp workaround for D.NET
  21. Rev 1.3 2004.03.01 11:27:54 AM czhower
  22. Bug fix for checking of more than one AF
  23. Rev 1.2 2004.02.29 9:38:36 PM czhower
  24. Bug fix for design mode.
  25. Rev 1.1 2004.02.03 3:15:50 PM czhower
  26. Updates to move to System.
  27. Rev 1.0 2004.02.03 2:40:34 PM czhower
  28. Move
  29. Rev 1.3 2004.01.20 10:03:20 PM czhower
  30. InitComponent
  31. Rev 1.2 2003.10.01 12:30:02 PM czhower
  32. .Net
  33. Rev 1.1 2003.10.01 1:12:32 AM czhower
  34. .Net
  35. Rev 1.0 11/13/2002 08:37:44 AM JPMugaas
  36. }
  37. unit IdAntiFreezeBase;
  38. interface
  39. {$I IdCompilerDefines.inc}
  40. uses
  41. IdBaseComponent;
  42. const
  43. ID_Default_TIdAntiFreezeBase_Active = True;
  44. ID_Default_TIdAntiFreezeBase_ApplicationHasPriority = True;
  45. ID_Default_TIdAntiFreezeBase_IdleTimeOut = 250;
  46. ID_Default_TIdAntiFreezeBase_OnlyWhenIdle = True;
  47. type
  48. TIdAntiFreezeBase = class(TIdBaseComponent)
  49. protected
  50. FActive: Boolean;
  51. FApplicationHasPriority: Boolean;
  52. FIdleTimeOut: Integer;
  53. FOnlyWhenIdle: Boolean;
  54. //
  55. procedure InitComponent; override;
  56. public
  57. destructor Destroy; override;
  58. procedure Process; virtual; abstract;
  59. class procedure DoProcess(const AIdle: Boolean = True; const AOverride: Boolean = False);
  60. class function ShouldUse: Boolean;
  61. class procedure Sleep(ATimeout: Integer);
  62. published
  63. property Active: boolean read FActive write FActive
  64. default ID_Default_TIdAntiFreezeBase_Active;
  65. property ApplicationHasPriority: Boolean read FApplicationHasPriority
  66. write FApplicationHasPriority
  67. default ID_Default_TIdAntiFreezeBase_ApplicationHasPriority;
  68. property IdleTimeOut: integer read FIdleTimeOut write FIdleTimeOut
  69. default ID_Default_TIdAntiFreezeBase_IdleTimeOut;
  70. property OnlyWhenIdle: Boolean read FOnlyWhenIdle write FOnlyWhenIdle
  71. default ID_Default_TIdAntiFreezeBase_OnlyWhenIdle;
  72. end;
  73. var
  74. GAntiFreeze: TIdAntiFreezeBase = nil;
  75. implementation
  76. uses
  77. //facilitate inlining only.
  78. {$IFDEF USE_INLINE}
  79. {$IFDEF DOTNET}
  80. System.Threading,
  81. {$ENDIF}
  82. {$IFDEF WINDOWS}
  83. {$IFDEF FPC}
  84. windows,
  85. {$ELSE}
  86. Windows,
  87. {$ENDIF}
  88. {$ENDIF}
  89. {$ENDIF}
  90. {$IFDEF USE_VCL_POSIX}
  91. Posix.SysSelect,
  92. Posix.SysTime,
  93. {$ENDIF}
  94. {$IFDEF KYLIXCOMPAT}
  95. Libc,
  96. {$ENDIF}
  97. IdGlobal,
  98. IdResourceStrings,
  99. IdException;
  100. { TIdAntiFreezeBase }
  101. destructor TIdAntiFreezeBase.Destroy;
  102. begin
  103. if GAntiFreeze = Self then begin
  104. GAntiFreeze := nil;
  105. end;
  106. inherited Destroy;
  107. end;
  108. class procedure TIdAntiFreezeBase.DoProcess(const AIdle: Boolean = True; const AOverride: Boolean = False);
  109. begin
  110. if ShouldUse then begin
  111. if (not GAntiFreeze.OnlyWhenIdle) or AIdle or AOverride then begin
  112. GAntiFreeze.Process;
  113. end;
  114. end;
  115. end;
  116. procedure TIdAntiFreezeBase.InitComponent;
  117. begin
  118. inherited InitComponent;
  119. if not IsDesignTime then begin
  120. if Assigned(GAntiFreeze) then begin
  121. raise EIdException.Create(RSAntiFreezeOnlyOne); // TODO: create a new Exception class for this
  122. end;
  123. GAntiFreeze := Self;
  124. end;
  125. FActive := ID_Default_TIdAntiFreezeBase_Active;
  126. FApplicationHasPriority := ID_Default_TIdAntiFreezeBase_ApplicationHasPriority;
  127. IdleTimeOut := ID_Default_TIdAntiFreezeBase_IdleTimeOut;
  128. FOnlyWhenIdle := ID_Default_TIdAntiFreezeBase_OnlyWhenIdle;
  129. end;
  130. class function TIdAntiFreezeBase.ShouldUse: Boolean;
  131. begin
  132. Result := (GAntiFreeze <> nil) and InMainThread;
  133. if Result then begin
  134. Result := GAntiFreeze.Active;
  135. end;
  136. end;
  137. class procedure TIdAntiFreezeBase.Sleep(ATimeout: Integer);
  138. begin
  139. if ShouldUse then begin
  140. while ATimeout > GAntiFreeze.IdleTimeOut do begin
  141. IndySleep(GAntiFreeze.IdleTimeOut);
  142. Dec(ATimeout, GAntiFreeze.IdleTimeOut);
  143. DoProcess;
  144. end;
  145. IndySleep(ATimeout);
  146. DoProcess;
  147. end else begin
  148. IndySleep(ATimeout);
  149. end;
  150. end;
  151. end.