uevent.pas

楠楠写的DBiocp例子都是源码

unit uEvent;

interface

uses
  Windows, uException, uWin32Const;

type
  TWaitResult = (wrTimeOut, wrSignaled, wrFailed);

  TEvent = class
  protected
    FEvent: THandle;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Pulse;
    procedure SetEvent;
    function WaitFor(TimeOut: Cardinal): TWaitResult; overload;
    function WaitFor: TWaitResult; overload;
    property Handle: THandle read FEvent;
  end;

implementation

constructor TEvent.Create;
begin
  inherited Create;
  FEvent := CreateEvent(Nil, False, False, Nil);
  if FEvent = 0 then
    raise TException.Create(ErrWin32Error, GetLastError(), 'CreateEvent');
end;

destructor TEvent.Destroy;
begin
  if FEvent<>0 then CloseHandle(FEvent);
  inherited Destroy;
end;

procedure TEvent.Pulse;
begin
  PulseEvent(FEvent);
end;

procedure TEvent.SetEvent;
begin
  Windows.SetEvent(FEvent);
end;

function TEvent.WaitFor(TimeOut: Cardinal): TWaitResult;
var ResCode: Cardinal;
begin
  ResCode := WaitForSingleObject(FEvent, TimeOut);
  if ResCode = WAIT_ABANDONED then
    Result := wrFailed
  else if ResCode = WAIT_OBJECT_0 then
    Result := wrSignaled
  else if ResCode = WAIT_TIMEOUT then
    Result := wrTimeOut
  else raise TException.Create(ErrWin32Error, GetLastError(), 'WaitForSingleObject');
end;

function TEvent.WaitFor: TWaitResult;
var ResCode: Cardinal;
begin
  ResCode := WaitForSingleObject(FEvent, INFINITE);
  if ResCode = WAIT_ABANDONED then
    Result := wrFailed
  else if ResCode = WAIT_OBJECT_0 then
    Result := wrSignaled
  else if ResCode = WAIT_TIMEOUT then
    Result := wrTimeOut
  else raise TException.Create(ErrWin32Error, GetLastError(), 'WaitForSingleObject');
end;

end.