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