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.