usemaphore.pas

楠楠写的DBiocp例子都是源码

unit uSemaphore;

interface

uses
  Windows, uException, uWin32Const;

type
  TWaitResult = (wrTimeOut, wrSignaled, wrFailed);
  
  TSemaphore = class
  protected
    FSemaphore: THandle;
  public
    constructor Create(InitialCount, MaxCount: Integer);
    destructor Destroy; override;
    function  Wait(TimeOut: Cardinal): TWaitResult; overload;
    function  Wait: TWaitResult; overload;
    procedure Release;
  end;

implementation
 
constructor TSemaphore.Create(InitialCount, MaxCount: Integer);
begin
  inherited Create;
  FSemaphore := CreateSemaphore(Nil, InitialCount, MaxCount, Nil);
  if FSemaphore = 0 then
    raise TException.Create(ErrWin32Error, GetLastError(), 'CreateSemaphore');
end;

destructor TSemaphore.Destroy;
begin
  if FSemaphore <> 0 then CloseHandle(FSemaphore);
  inherited Destroy;
end;

function  TSemaphore.Wait(TimeOut: Cardinal): TWaitResult;
begin
  case WaitForSingleObject(FSemaphore, TimeOut) of
    WAIT_OBJECT_0:
      Result := wrSignaled;
    WAIT_ABANDONED:
      Result := wrFailed;
    WAIT_TIMEOUT:
      Result := wrTimeOut;
    else
      Result := wrFailed;
  end;
end;

function  TSemaphore.Wait: TWaitResult;
begin
  Result := Self.Wait(INFINITE);
end;

procedure TSemaphore.Release;
begin
  ReleaseSemaphore(FSemaphore, 1, Nil);
end;

end.