home *** CD-ROM | disk | FTP | other *** search
/ PC Plus SuperCD (UK) 2000 March / pcp161b.iso / full / delphi / RUNIMAGE / DELPHI30 / SOURCE / VCL / SYNCOBJS.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-08-03  |  3.3 KB  |  158 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Delphi Visual Component Library                 }
  5. {       Win32 Synchronization objects                   }
  6. {                                                       }
  7. {       Copyright (c) 1997 Borland International        }
  8. {                                                       }
  9. {*******************************************************}
  10.  
  11. unit SyncObjs;
  12.  
  13. interface
  14.  
  15. uses Sysutils, Windows, Messages, Classes;
  16.  
  17. type
  18.   TSynchroObject = class(TObject)
  19.   public
  20.     procedure Acquire; virtual;
  21.     procedure Release; virtual;
  22.   end;
  23.  
  24.   THandleObject = class(TSynchroObject)
  25.   private
  26.     FHandle: THandle;
  27.     FLastError: Integer;
  28.   public
  29.     destructor Destroy; override;
  30.     property LastError: Integer read FLastError;
  31.     property Handle: THandle read FHandle;
  32.   end;
  33.  
  34.   TWaitResult = (wrSignaled, wrTimeout, wrAbandoned, wrError);
  35.  
  36.   TEvent = class(THandleObject)
  37.   public
  38.     constructor Create(EventAttributes: PSecurityAttributes; ManualReset,
  39.       InitialState: Boolean; const Name: string);
  40.     function WaitFor(Timeout: Longint): TWaitResult;
  41.     procedure SetEvent;
  42.     procedure ResetEvent;
  43.   end;
  44.  
  45.   TSimpleEvent = class(TEvent)
  46.   public
  47.     constructor Create;
  48.   end;
  49.  
  50.   TCriticalSection = class(TSynchroObject)
  51.   private
  52.     FSection: TRTLCriticalSection;
  53.   public
  54.     constructor Create;
  55.     destructor Destroy; override;
  56.     procedure Acquire; override;
  57.     procedure Release; override;
  58.     procedure Enter;
  59.     procedure Leave;
  60.   end;
  61.  
  62. implementation
  63.  
  64. { TSynchroObject }
  65.  
  66. procedure TSynchroObject.Acquire;
  67. begin
  68. end;
  69.  
  70. procedure TSynchroObject.Release;
  71. begin
  72. end;
  73.  
  74. { THandleObject }
  75.  
  76. destructor THandleObject.Destroy;
  77. begin
  78.   CloseHandle(FHandle);
  79.   inherited Destroy;
  80. end;
  81.  
  82. { TEvent }
  83.  
  84. constructor TEvent.Create(EventAttributes: PSecurityAttributes; ManualReset,
  85.   InitialState: Boolean; const Name: string);
  86. begin
  87.   FHandle := CreateEvent(EventAttributes, ManualReset, InitialState, PChar(Name));
  88. end;
  89.  
  90. function TEvent.WaitFor(Timeout: Longint): TWaitResult;
  91. begin
  92.   case WaitForSingleObject(Handle, Timeout) of
  93.     WAIT_ABANDONED: Result := wrAbandoned;
  94.     WAIT_OBJECT_0: Result := wrSignaled;
  95.     WAIT_TIMEOUT: Result := wrTimeout;
  96.     WAIT_FAILED:
  97.       begin
  98.         Result := wrError;
  99.         FLastError := GetLastError;
  100.       end;
  101.   else
  102.     Result := wrError;    
  103.   end;
  104. end;
  105.  
  106. procedure TEvent.SetEvent;
  107. begin
  108.   Windows.SetEvent(Handle);
  109. end;
  110.  
  111. procedure TEvent.ResetEvent;
  112. begin
  113.   Windows.ResetEvent(Handle);
  114. end;
  115.  
  116. { TSimpleEvent }
  117.  
  118. constructor TSimpleEvent.Create;
  119. begin
  120.   FHandle := CreateEvent(nil, True, False, nil);
  121. end;
  122.  
  123. { TCriticalSection }
  124.  
  125. constructor TCriticalSection.Create;
  126. begin
  127.   inherited Create;
  128.   InitializeCriticalSection(FSection);
  129. end;
  130.  
  131. destructor TCriticalSection.Destroy;
  132. begin
  133.   DeleteCriticalSection(FSection);
  134.   inherited Destroy;
  135. end;
  136.  
  137. procedure TCriticalSection.Acquire;
  138. begin
  139.   EnterCriticalSection(FSection);
  140. end;
  141.  
  142. procedure TCriticalSection.Release;
  143. begin
  144.   LeaveCriticalSection(FSection);
  145. end;
  146.  
  147. procedure TCriticalSection.Enter;
  148. begin
  149.   Acquire;
  150. end;
  151.  
  152. procedure TCriticalSection.Leave;
  153. begin
  154.   Release;
  155. end;
  156.  
  157. end.
  158.