{---------------------------------------------------------------------------
The control program for mass-spectrometer MI1201-AGM
(c) Copyright	 Aleksandrov O.E., 2001

   Molecular Physics department, USTU, Ekaterinsburg, K-2, 620002, RUSSIA
   phone 75-47-15
   E-mail: aleks@dpt.ustu.ru

Программа управления масс-спектрометром МИ1201-АГМ
(c) Собственность     Александрова О.Е., 2001

   620002, Екатеринбург, К-2, УГТУ, Кафедра молекулярной физики
   тел. 75-47-15
   E-mail: aleks@dpt.ustu.ru
----------------------------------------------------------------------------}
unit xSyncObjs;

interface
  uses
    Windows, Classes, SyncObjs;

type
  tSimpleMutexFlag=(fCloseHandle, fAlreadyExist);
  tSimpleMutexFlags=set of tSimpleMutexFlag;

  TSimpleMutex=class(TObject)
    private
      prHandle:THANDLE;
      prFlags:tSimpleMutexFlags;
    protected
      prLastError:cardinal;
      prName:string;
    public
      constructor Create(MutexAttributes: PSecurityAttributes; InitialOwner: Boolean; const Name: string);
      constructor CreateOpen(DesiredAccess:DWORD; InheritHandle:boolean; const Name: string);
      constructor CreateHandle(AMutexHandle:THANDLE);
      destructor Destroy; override;
      property Handle:cardinal read prHandle;
      function WaitFor(ATimeout:cardinal): TWaitResult;
      function Release:boolean;
      property LastError:cardinal read prLastError;
      property Name:string read prName;
  end;

  tMutexFlag=(fWaitForever);
  tMutexFlags=set of tMutexFlag;
  TMutex=class(TSimpleMutex)
    private
      prLocCounter:cardinal;
      prFlags:tMutexFlags;
      prTreadID:cardinal;
      prTimeOut:cardinal;
    protected
      procedure WaitForeverSet(state:boolean);
      function  WaitForeverGet:boolean;
      function  IncLocCount:cardinal;
      function  DecLocCount:cardinal;
    public
      constructor Create(MutexAttributes: PSecurityAttributes; InitialOwner: Boolean; const Name: string);
      constructor CreateOpen(DesiredAccess:DWORD; InheritHandle:boolean; const Name: string);
      constructor CreateHandle(AMutexHandle:THANDLE);
      destructor Destroy; override;
      function WaitFor(ATimeout: cardinal): TWaitResult;
      function WaitForLimitedTime(ATimeout: cardinal): TWaitResult;
      function WaitForEx:TWaitResult;
      function WaitForLimitedTimeEx: TWaitResult;
      function EnterEx:boolean;
      function Enter(ATimeout: cardinal):boolean;
      function TryEnterEx:boolean;
      function TryEnter(ATimeout: cardinal):boolean;
      function Exit:boolean;
      function SetEventAnyway:boolean;
      function Owner:boolean;
      function Locked:boolean;
      function NotLocked:boolean;

      property OwnerID:cardinal read prTreadID;
      property WaitForever:boolean read WaitForeverGet write WaitForeverSet default false;
      property TimeOut:cardinal read prTimeOut write prTimeOut;
      property LocCount:cardinal read prLocCounter;
  end;

implementation
  USES SysUtils;

constructor TSimpleMutex.CreateHandle(AMutexHandle:THANDLE);
begin
  prHandle:=AMutexHandle;
end;

resourcestring
  rsCantCreateMutex='Не удается создать MUTEX: ';
  rsAlreadyExistMutex='Уже существует MUTEX: ';
  rsCantReleaseMutex='Невозможно освободить MUTEX: ';
  rsErrorCode=' Код ошибки: ';

constructor TSimpleMutex.Create(MutexAttributes: PSecurityAttributes; InitialOwner: Boolean; const Name: string);
begin
  prHandle:=CreateMutex(MutexAttributes,	// pointer to security attributes
                      InitialOwner,	// flag for initial ownership
                      PChar(Name));
  prLastError:=GetLastError;
  if prLastError=ERROR_ALREADY_EXISTS then
    Include(prFlags,fAlreadyExist);
  if (prHandle=NULL) then begin
    if (prLastError=ERROR_ALREADY_EXISTS) then begin
      raise EWin32Error.Create(rsAlreadyExistMutex+Name);
    end else begin
      raise EWin32Error.Create(rsCantCreateMutex+Name+rsErrorCode+IntToStr(GetLastError));
    end;
  end else begin
    prName:=Name;
    Include(prFlags,fCloseHandle);
  end;
end;

constructor TSimpleMutex.CreateOpen(DesiredAccess:DWORD; InheritHandle:boolean; const Name: string);
begin
  prFlags:=[];
  prHandle:=OpenMutex(DesiredAccess,  // access flag
                      InheritHandle,  // inherit flag
                      PChar(Name));
  if (prHandle=NULL) then begin
    prLastError:=GetLastError;
    raise EWin32Error.Create(rsCantCreateMutex+Name+rsErrorCode+IntToStr(GetLastError));
  end else begin
    prName:=Name;
    Include(prFlags,fCloseHandle);
  end;
end;

destructor TSimpleMutex.Destroy;
begin
  if fCloseHandle in prFlags then
    CloseHandle(prHandle);
  Inherited Destroy;
end;

function TSimpleMutex.WaitFor(ATimeout: cardinal): TWaitResult;
begin
  case WaitForSingleObject(prHandle,ATimeout) of
    WAIT_OBJECT_0: begin
      Result:=wrSignaled;
    end;
    WAIT_ABANDONED: begin
      Result:=wrAbandoned;
    end;
    WAIT_TIMEOUT: begin
      Result:=wrTimeOut;
    end;
    else begin
      prLastError:=GetLastError;
      Result:=wrError;
    end;
  end;
end;

function TSimpleMutex.Release:boolean;
begin
  Result:=ReleaseMutex(prHandle);
end;

// TMutex --------------------------------------------------------------------

function TMutex.EnterEx:boolean;
begin
  Result:=TryEnter(Timeout);
end;

function TMutex.Enter(ATimeout: cardinal):boolean;
begin
  Result:=not (WaitFor(ATimeout) in [wrTimeOut, wrError]);
end;

function TMutex.TryEnterEx:boolean;
begin
  Result:=TryEnter(Timeout);
end;

function TMutex.TryEnter(ATimeout: cardinal):boolean;
begin
  Result:=not (WaitForLimitedTime(ATimeout) in [wrTimeOut, wrError]);
end;

function TMutex.Exit:boolean;
begin
  Result:=Owner;
  if Result then begin
    DecLocCount;
  end;
end;

constructor TMutex.CreateHandle(AMutexHandle:THANDLE);
begin
  prLocCounter:=0;
  prFlags:=[];
  Inherited;
end;

constructor TMutex.Create(MutexAttributes: PSecurityAttributes; InitialOwner: Boolean; const Name: string);
begin
  prLocCounter:=0;
  prFlags:=[];
  Inherited;
end;

constructor TMutex.CreateOpen(DesiredAccess:DWORD; InheritHandle:boolean; const Name: string);
begin
  prLocCounter:=0;
  prFlags:=[];
  Inherited;
end;

destructor TMutex.Destroy;
begin
  Inherited Destroy;
end;

function TMutex.WaitFor;
begin
  Result:= WaitForLimitedTime(ATimeOut);
  while (Result=wrTimeOut) and (fWaitForever in prFlags) do begin
    Result:=WaitForLimitedTime(ATimeOut);
  end;
end;

function TMutex.WaitForEx;
begin
  Result:= WaitFor(TimeOut);
end;

function TMutex.IncLocCount;
begin
  if prTreadID<>GetCurrentThreadID then begin
    prLocCounter:=0;
  end;
  if (LocCount=0) then
    prTreadID:=GetCurrentThreadID;
  Inc(prLocCounter);
  Exclude(prFlags,fWaitForever);
  Result:=LocCount;
end;

function TMutex.DecLocCount;
begin
  if LocCount>0 then begin
    Dec(prLocCounter);
    if (LocCount=0) then begin
      prTreadID:=0;
    end;
    if not ReleaseMutex(prHandle) then begin
      raise EWin32Error.Create(rsCantReleaseMutex+Name);
    end;
  end;
  Result:=LocCount;
end;

function TMutex.WaitForLimitedTime;
begin
  Result:=Inherited WaitFor(ATimeout);
  case Result of
    wrSignaled, wrAbandoned: IncLocCount;
  end;
end;

function TMutex.WaitForLimitedTimeEx;
begin
  Result:=WaitForLimitedTime(TimeOut);
end;

function TMutex.SetEventAnyway;
begin
  Result:=Owner;
  if Owner then begin
    while LocCount>0 do Result:=Self.Exit;
  end;
end;

procedure TMutex.WaitForeverSet;
begin
  if Owner then begin
    if state then
      Include(prFlags,fWaitForever)
    else
      Exclude(prFlags,fWaitForever)
  end;
end;

function TMutex.WaitForeverGet;
begin
  Result:=fWaitForever in prFlags;
end;

function TMutex.Owner;
begin
  Result:=(OwnerID=GetCurrentThreadId());
end;

function TMutex.NotLocked;
begin
  Result:=(OwnerID=0);
end;

function TMutex.Locked;
begin
  Result:=(OwnerID<>0);
end;

end.