syncobjs.pp 2.6 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132
  1. {
  2. $Id$
  3. This file is part of the Free Component Library (FCL)
  4. Copyright (c) 1998 by Florian Klaempfl
  5. member of the Free Pascal development team
  6. See the file COPYING.FPC, included in this distribution,
  7. for details about the copyright.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  11. **********************************************************************}
  12. {$mode objfpc}
  13. {$h+}
  14. unit syncobjs;
  15. interface
  16. uses
  17. windows,sysutils;
  18. type
  19. PSecurityAttributes = Windows.PSecurityAttributes;
  20. TSecurityAttributes = Windows.TSecurityAttributes;
  21. TEventHandle = THandle;
  22. {$I syncobh.inc}
  23. implementation
  24. {$I syncob.inc}
  25. procedure TCriticalSection.Acquire;
  26. begin
  27. EnterCriticalSection(CriticalSection);
  28. end;
  29. procedure TCriticalSection.Release;
  30. begin
  31. LeaveCriticalSection(CriticalSection);
  32. end;
  33. constructor TCriticalSection.Create;
  34. begin
  35. inherited Create;
  36. InitializeCriticalSection(CriticalSection);
  37. end;
  38. destructor TCriticalSection.Destroy;
  39. begin
  40. DeleteCriticalSection(CriticalSection);
  41. inherited Destroy;
  42. end;
  43. destructor THandleObject.destroy;
  44. begin
  45. CloseHandle(FHandle);
  46. inherited Destroy;
  47. end;
  48. constructor TEventObject.Create(EventAttributes : PSecurityAttributes;
  49. AManualReset,InitialState : Boolean;const Name : string);
  50. begin
  51. FHandle := CreateEvent(EventAttributes, AManualReset, InitialState, PChar(Name));
  52. end;
  53. destructor TEventObject.destroy;
  54. begin
  55. inherited;
  56. end;
  57. procedure TEventObject.ResetEvent;
  58. begin
  59. Windows.ResetEvent(FHandle)
  60. end;
  61. procedure TEventObject.SetEvent;
  62. begin
  63. Windows.SetEvent(FHandle);
  64. end;
  65. function TEventObject.WaitFor(Timeout : Cardinal) : TWaitResult;
  66. begin
  67. case WaitForSingleObject(Handle, Timeout) of
  68. WAIT_ABANDONED: Result := wrAbandoned;
  69. WAIT_OBJECT_0: Result := wrSignaled;
  70. WAIT_TIMEOUT: Result := wrTimeout;
  71. WAIT_FAILED:
  72. begin
  73. Result := wrError;
  74. FLastError := GetLastError;
  75. end;
  76. else
  77. Result := wrError;
  78. end;
  79. end;
  80. constructor TSimpleEvent.Create;
  81. begin
  82. FHandle := CreateEvent(nil, True, False, nil);
  83. end;
  84. end.
  85. {
  86. $Log$
  87. Revision 1.6 2003-06-17 07:35:58 michael
  88. + Renamed ManualReset parameter to TEventObject constructor
  89. Revision 1.5 2003/06/14 19:16:50 michael
  90. + Some improvements for the Linux version
  91. Revision 1.4 2003/06/11 11:59:52 michael
  92. + Implemented Win32 of syncobjs
  93. Revision 1.3 2002/09/07 15:15:29 peter
  94. * old logs removed and tabs fixed
  95. }