home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / sibdemo3.zip / SOURCE.DAT / SOURCE / ADDON / SYNCCOMP.PAS < prev    next >
Pascal/Delphi Source File  |  1998-05-04  |  5KB  |  212 lines
  1. Unit SyncComp;
  2.  
  3. {╔══════════════════════════════════════════════════════════════════════════╗
  4.  ║                                                                          ║
  5.  ║     Sibyl Portable Component Classes                                     ║
  6.  ║                                                                          ║
  7.  ║     Delphi 3 compatible synchronisation components                       ║                           ║
  8.  ║     Copyright (C) 1995,97 SpeedSoft Germany,   All rights reserved.      ║
  9.  ║     Portions Copyright (C) 1997 Borland Inc.                             ║
  10.  ║                                                                          ║
  11.  ╚══════════════════════════════════════════════════════════════════════════╝}
  12.  
  13.  
  14. Interface
  15.  
  16. Uses Classes;
  17.  
  18. {$IFDEF OS2}
  19. Uses BseDos,BseErr;
  20. {$ENDIF}
  21. {$IFDEF WIN32}
  22. Uses WinNT,WinBase;
  23. {$ENDIF}
  24.  
  25. Type
  26.   TSynchroObject = class(TObject)
  27.     Public
  28.       Procedure Acquire; virtual;
  29.       Procedure Release; virtual;
  30.   End;
  31.  
  32.   TWaitResult = (wrSignaled, wrTimeout, wrAbandoned, wrError);
  33.  
  34.   TEvent = class(TObject)
  35.     Private
  36.       FHandle: LongWord;
  37.       FLastError: LongInt;
  38.     Public
  39.       Constructor Create(ManualReset,InitialState: Boolean;Const Name: String);
  40.       Function WaitFor(Timeout: Longint): TWaitResult;
  41.       Procedure SetEvent;
  42.       Procedure ResetEvent;
  43.       Destructor Destroy; Override;
  44.       Property LastError: LongInt read FLastError;
  45.       Property Handle: LongWord read FHandle;
  46.   End;
  47.  
  48.   TSimpleEvent = class(TEvent)
  49.     Public
  50.       Constructor Create;
  51.   End;
  52.  
  53.   TCriticalSection = class(TSynchroObject)
  54.     {$IFDEF WIN32}
  55.     Private
  56.       FSection:CRITICAL_SECTION;
  57.     {$ENDIF}
  58.     Public
  59.       Procedure Acquire; Override;
  60.       Procedure Release; Override;
  61.       Procedure Enter;
  62.       Procedure Leave;
  63.       Constructor Create;Virtual;
  64.       Destructor Destroy;Override;
  65.   End;
  66.  
  67.  
  68. Implementation
  69.  
  70. Procedure TSynchroObject.Acquire;
  71. Begin
  72. End;
  73.  
  74. Procedure TSynchroObject.Release;
  75. Begin
  76. End;
  77.  
  78. Constructor TEvent.Create(ManualReset,InitialState: Boolean; Const Name: String);
  79. Var c:CString;
  80. Begin
  81.   c:=Name;
  82.   {$IFDEF OS2}
  83.   DosCreateEventSem(c,FHandle,0,InitialState);
  84.   {$ENDIF}
  85.   {$IFDEF WIN32}
  86.   FHandle:=CreateEvent(Nil,ManualReset,InitialState,c);
  87.   {$ENDIF}
  88. End;
  89.  
  90. Destructor TEvent.Destroy;
  91. Begin
  92.   {$IFDEF OS2}
  93.   If FHandle<>0 Then DosCloseEventSem(FHandle);
  94.   {$ENDIF}
  95.   {$IFDEF WIN32}
  96.   If FHandle<>0 Then CloseHandle(FHandle);
  97.   {$ENDIF}
  98.   Inherited Destroy;
  99. End;
  100.  
  101. Function TEvent.WaitFor(Timeout: Longint): TWaitResult;
  102. Var Err:LongInt;
  103. Begin
  104.   {$IFDEF OS2}
  105.   Err:= DosWaitEventSem(Handle, Timeout);
  106.   Case Err of
  107.     ERROR_INTERRUPT: Result := wrAbandoned;
  108.     0: Result := wrSignaled;
  109.     ERROR_TIMEOUT: Result := wrTimeout;
  110.     Else
  111.     Begin
  112.        Result := wrError;
  113.        FLastError := Err;
  114.     End;
  115.   End;
  116.   {$ENDIF}
  117.   {$IFDEF WIN32}
  118.   Case WaitForSingleObject(Handle,Timeout) Of
  119.     WAIT_ABANDONED: Result := wrAbandoned;
  120.     WAIT_OBJECT_0: Result := wrSignaled;
  121.     WAIT_TIMEOUT: Result := wrTimeout;
  122.     Else
  123.     Begin
  124.         Result := wrError;
  125.         FLastError := GetLastError;
  126.     End;
  127.   End;
  128.   {$ENDIF}
  129. End;
  130.  
  131. Procedure TEvent.SetEvent;
  132. Begin
  133.   {$IFDEF OS2}
  134.   DosPostEventSem(Handle);
  135.   {$ENDIF}
  136.   {$IFDEF WIN32}
  137.   WinBase.SetEvent(FHandle);
  138.   {$ENDIF}
  139. End;
  140.  
  141. Procedure TEvent.ResetEvent;
  142. Var PostCount:LongWord;
  143. Begin
  144.   {$IFDEF OS2}
  145.   DosResetEventSem(Handle,PostCount);
  146.   {$ENDIF}
  147.   {$IFDEF WIN32}
  148.   WinBase.ResetEvent(FHandle);
  149.   {$ENDIF}
  150. End;
  151.  
  152. Constructor TSimpleEvent.Create;
  153. Begin
  154.   {$IFDEF OS2}
  155.   FHandle := DosCreateEventSem(Nil,FHandle,0,False);
  156.   {$ENDIF}
  157.   {$IFDEF WIN32}
  158.   FHandle:=CreateEvent(Nil,True,False,Nil);
  159.   {$ENDIF}
  160. End;
  161.  
  162. Constructor TCriticalSection.Create;
  163. Begin
  164.      Inherited Create;
  165.  
  166.      {$IFDEF WIN32}
  167.      InitializeCriticalSection(FSection);
  168.      {$ENDIF}
  169. End;
  170.  
  171. Procedure TCriticalSection.Acquire;
  172. Begin
  173.   {$IFDEF OS2}
  174.   DosEnterCritSec;
  175.   {$ENDIF}
  176.   {$IFDEF WIN32}
  177.   EnterCriticalSection(FSection);
  178.   {$ENDIF}
  179. End;
  180.  
  181. Procedure TCriticalSection.Release;
  182. Begin
  183.   {$IFDEF OS2}
  184.   DosExitCritSec;
  185.   {$ENDIF}
  186.   {$IFDEF WIN32}
  187.   LeaveCriticalSection(FSection);
  188.   {$ENDIF}
  189. End;
  190.  
  191. Destructor TCriticalSection.Destroy;
  192. Begin
  193.      {$IFDEF WIN32}
  194.      DeleteCriticalSection(FSection);
  195.      {$ENDIF}
  196.      Inherited Destroy;
  197. End;
  198.  
  199. Procedure TCriticalSection.Enter;
  200. Begin
  201.   Acquire;
  202. End;
  203.  
  204. Procedure TCriticalSection.Leave;
  205. Begin
  206.   Release;
  207. End;
  208.  
  209.  
  210. Initialization
  211. End.
  212.