unitopensemaphore.pas

DelphiWin32核心API参考光盘内容.是学习书籍中的源码,便于学习.

unit UnitOpenSemaphore;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Gauges, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Gauge1: TGauge;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

{Whoops! Delphi does not include constant declarations for the desired
 access flags, although the constants for events could be used}
const
  SYNCHRONIZE = $00100000;
  STANDARD_RIGHTS_REQUIRED = $000F0000;
  SEMAPHORE_MODIFY_STATE = $0002;
  SEMAPHORE_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED or SYNCHRONIZE or $3);

{by performing this on a button click, it gives you the chance to move
 the window around and get several on the screen at once}
procedure TForm1.Button1Click(Sender: TObject);
var
  ICount: Integer;               // general loop counter
  SemaphoreHandle: THandle;      // holds the semaphore handle
  PrevCount: DWORD;              // holds the previous semaphore counter
begin
  {Open a handle to the semaphore}
  SemaphoreHandle := OpenSemaphore(SEMAPHORE_ALL_ACCESS, FALSE,
                                   'TheSemaphore');
  Button1.Caption := 'Semaphore opened and waiting';
  Button1.Enabled := FALSE;

  {wait to achieve ownership of the semaphore. this will decrease the
   semaphore's count by 1. if it is currently 0, this will block the
   thread until its count increases}
  WaitForSingleObject(SemaphoreHandle, INFINITE);

  {display a visual indication}
  for ICount := 1 to 100000 do
  begin
    Gauge1.Progress := ICount;
  end;

  {release the semaphore}
  ReleaseSemaphore(SemaphoreHandle, 1, @PrevCount);
end;
end.