Componentes.Terceros.RemObjects/internal/6.0.43.801/1/RemObjects Samples/RemObjects SDK for Delphi/Super TCP Channel Chat/PairingStatus.pas

unit PairingStatus;

interface

uses SyncObjs;

type
  TPairingStatus = class(TObject)
  private
    fCode: integer;
    fLastAttempt: TDateTime;
    fLock: TCriticalSection;
    procedure CheckExpired;
  public
    constructor Create;
    destructor Destroy; override; 
    procedure CancelPairing;
    function InitiatePairing: integer;
    property Code: integer read fCode;
  end;

var
  Pairing: TPairingStatus;

implementation

uses SysUtils, DateUtils;

{ TPairingStatus }

procedure TPairingStatus.CancelPairing;
begin
  fLock.Enter;
  fCode := 0;
  fLastAttempt := 0;
  fLock.Leave;
end;

procedure TPairingStatus.CheckExpired;
begin
  if SecondSpan(Now, fLastAttempt) > 60 then begin
    fCode := 0;
    fLastAttempt := 0;
  end;
end;

constructor TPairingStatus.Create;
begin
  inherited;
  fLock := TCriticalSection.Create;
end;

destructor TPairingStatus.Destroy;
begin
  fLock.Free;
  inherited;
end;

function TPairingStatus.InitiatePairing: integer;
begin
  fLock.Enter;
  try
    CheckExpired;
    if fCode <> 0 then Result := 0
    else begin
      fLastAttempt := Now;
      fCode := (Random(8) + 1) * 1000 + Random(9) * 100 + Random(9) * 10 + Random(9);
      Result := fCode;
    end;
  finally
    fLock.Leave;
  end;  
end;

initialization
  Randomize;
  Pairing := TPairingStatus.Create;
finalization
  Pairing.Free;
end.