Componentes.Terceros.RemObjects/internal/5.0.23.613/1/RemObjects SDK for Delphi/Source/uROThread.pas

unit uROThread;

{----------------------------------------------------------------------------}
{ RemObjects SDK Library - Core Library                                      }
{                                                                            }
{ compiler: Delphi 5 and up, Kylix 2 and up                                  }
{ platform: Win32, Linux                                                     }
{                                                                            }
{ (c)opyright RemObjects Software. all rights reserved.                      }
{                                                                            }
{ Using this code requires a valid license of the RemObjects SDK             }
{ which can be obtained at http://www.remobjects.com.                        }
{----------------------------------------------------------------------------}

{$I RemObjects.inc}

interface

uses
  Classes {$IFDEF MSWINDOWS} , Windows {$ENDIF};

type
  TROThread = class(TThread)
  private
    {$IFDEF MSWINDOWS}
    fName:string;
    fFreeWaiting: TObject; // TROEvent
    fIsTerminated: Boolean;
    {$ENDIF MSWINDOWS}
  protected
    {$IFDEF MSWINDOWS}
    procedure SetName(const iName:string);
    property Name:string read fName;
    procedure DoTerminate; override;
    {$ENDIF MSWINDOWS}
    procedure Execute; override;
  public
    constructor Create(iCreateSuspended:Boolean; const iName:string='');
    procedure TerminateWaitFor; virtual;
    {$IFDEF MSWINDOWS}
    function WaitFor: DWord; reintroduce;
    {$IFNDEF FPC}
    procedure Free; reintroduce; // Windows limitation workaround
    {$ENDIF}
    {$ENDIF MSWINDOWS}
  end;

  TROServerCheckMessageThread = class(TROThread)
  private
    fActive: boolean;
    fInterval:integer;
    fEvent:TObject;
    procedure SetActive(const Value: boolean);
  private
    fOwner:TComponent;
  protected
    procedure Execute; override;
    procedure CheckForMessages; virtual; abstract;
    property Owner:TComponent read fOwner;
  public
    constructor Create(aName:string; aOwner:TComponent; iInterval:integer); reintroduce;
    destructor Destroy; override;
    procedure TerminateWaitFor; override;
    property Active:boolean read fActive write SetActive;
  end;

implementation

uses
  SysUtils, uROClasses;

{$IFDEF MSWINDOWS}
type
  TThreadNameInfo = record
    FType: LongWord;     // must be 0x1000
    FName: PChar;        // pointer to name (in user address space)
    FThreadID: LongWord; // thread ID (-1 indicates caller thread)
    FFlags: LongWord;    // reserved for future use, must be zero
  end;
{$ENDIF}

{ TROThread }

constructor TROThread.Create(iCreateSuspended:Boolean; const iName:string='');
begin
  {$IFDEF MSWINDOWS}
  fName := iName;
  {$ENDIF MSWINDOWS}
  inherited Create(iCreateSuspended)
end;

{$IFDEF MSWINDOWS}
procedure TROThread.SetName(const iName:string);
var
  ThreadNameInfo: TThreadNameInfo;
begin
  if iName <> '' then begin
    ThreadNameInfo.FType := $1000;
    ThreadNameInfo.FName := PChar(iName);
    ThreadNameInfo.FThreadID := $FFFFFFFF;
    ThreadNameInfo.FFlags := 0;
    try
      //
      // This exception is EXPECTED to be raised when creating a named thread in
      // the debugger. You can safely ignore it and continue running the program.
      //
      RaiseException( $406D1388, 0, sizeof(ThreadNameInfo) div sizeof(LongWord), @ThreadNameInfo );
    except
    end;
  end;
end;
{$ENDIF}

procedure TROThread.Execute;
begin
  {$IFDEF RemObjects_SetThreadName}
  SetName(fName);
  {$ENDIF RemObjects_SetThreadName}
end;

procedure TROThread.TerminateWaitFor;
begin
  Terminate;
  WaitFor();
end;

{$IFDEF MSWINDOWS}

function TROThread.WaitFor: DWord;
var
  lEvent: TROEvent;
begin
  result := 0;
  if fIsTerminated then exit;
  lEvent := TROEvent.Create(nil, false, false, '');
  try
    fFreeWaiting := lEvent;
    Terminate;
    while Suspended do Resume;
    while not Terminated do lEvent.WaitFor(500);  //lEvent.WaitFor(INFINITE);
    sleep(10); // make sure it's actually terminated
    fFreeWaiting := nil;
  finally
    lEvent.Free;
  end;
end;

{$IFNDEF FPC}
procedure TROThread.Free;
begin
  if self = nil then exit;
  if ModuleIsLib then begin
    // Windows doesn't return from EndThread until DllMain, so waitfor never returns either.
    if fIsTerminated then
      Destroy
    else begin
      FreeOnTerminate := true;
      WaitFor;
    end;
  end else
    Destroy;
end;
{$ENDIF}

procedure TROThread.DoTerminate;
begin
  inherited;
  fIsTerminated := true;
  if fFreeWaiting <> nil then
    TROEvent(fFreeWaiting).SetEvent;
end;
{$ENDIF MSWINDOWS}


{ TROServerCheckMessageThread }

constructor TROServerCheckMessageThread.Create(aName:string; aOwner:TComponent; iInterval:integer);
begin
  inherited Create(true,aName);
  fInterval := iInterval;
  fOwner := aOwner;
  fEvent := TROEvent.Create(nil,false,false,'');
  Resume;
end;

destructor TROServerCheckMessageThread.Destroy;
begin
  TerminateWaitFor();
  FreeAndNil(fEvent);
  inherited;
end;

procedure TROServerCheckMessageThread.TerminateWaitFor;
begin
  Resume();
  TROEvent(fEvent).SetEvent();
  inherited;
end;

procedure TROServerCheckMessageThread.Execute;
begin
  inherited;
  while not Terminated do begin
    if not fActive then Suspend();
    CheckForMessages();
    if Terminated then break;
    TROEvent(fEvent).WaitFor(fInterval*1000); { Interval is in seocnds, we need miliseconds. }
  end;
end;

procedure TROServerCheckMessageThread.SetActive(const Value: boolean);
begin
  if fActive <> Value then begin
    fActive := Value;
    if Active then Resume();
  end;
end;

end.