⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 xpwinsync.pas

📁 类似于Java JUnit的单元测试
💻 PAS
📖 第 1 页 / 共 3 页
字号:
//////////////////////////////////////////////////////////////////////////////

type

  TXPWinSemaphore = class(TXPWinNamedKernelObject, IXPWinSynchro,
    IXPWinSemaphore, IXPWinCreatedSemaphore)
    private

    FCapacity: integer;
    FCount: integer;

    //
    // IXPSynchro implementation
    //

    function Enter: boolean;
    function Leave: boolean;

    //
    // IXPWinSemaphore implementation
    //

    function GetCount: integer;
    function Acquire: boolean;
    procedure Release;

    //
    // IXPWinCreatedSemaphore implementation
    //

    function Open: boolean;
    function GetCapacity: integer;

    protected

    function IsSignaled: boolean; override;
    function Wait: boolean; override;
    function WaitFor(const Millisecs: cardinal): boolean; override;

    public

    constructor Create(const ACapacity: integer; const AName: string;
      const CreateOpen: boolean; const Inheritable: boolean;
      const SecurityDescriptor: Pointer);
    end;

constructor TXPWinSemaphore.Create(const ACapacity: integer;
  const AName: string; const CreateOpen: boolean; const Inheritable: boolean;
  const SecurityDescriptor: Pointer);
  var
  InitCount: integer;

  begin
  inherited Create(AName, Inheritable, SecurityDescriptor);
{$IFDEF XPW32E}
  SetException(EXPWin32Semaphore);
{$ENDIF}
  FCapacity := -1;
  FCount := -1;

  if CreateOpen then
    InitCount := ACapacity
  else
    InitCount := 0;

  FHandle := Windows.CreateSemaphore(@FSecurityAttributes, InitCount,
    ACapacity, PChar(GetName));

  if FHandle = 0 then
    Error('TXPWinSemaphore.Create: Windows.CreateSemaphore failure')
  else if Windows.GetLastError = 0 then
    begin
    FInstance := koCreated;
    FCapacity := ACapacity;
    FCount := InitCount;
    end
  else if Windows.GetLastError = ERROR_ALREADY_EXISTS then
    FInstance := koOpened;

  end;

function TXPWinSemaphore.GetCapacity: integer;
  begin
  Result := FCapacity;
  end;

function TXPWinSemaphore.GetCount: integer;
  begin
  Result := FCount;
  end;

function TXPWinSemaphore.Enter: boolean;
  begin
  Result := Wait;

  if not Result then
    SetLastContext('TXPWinSemaphore.Enter: ' + GetLastContext);

  end;

function TXPWinSemaphore.IsSignaled: boolean;
  begin
  Result := inherited IsSignaled;

  if Result then
    Windows.InterlockedDecrement(FCount)
  else
    SetLastContext('TXPWinSemaphore.IsSignaled: ' + GetLastContext);

  end;

function TXPWinSemaphore.Wait: boolean;
  begin
  Result := inherited Wait;

  if Result then
    Windows.InterlockedDecrement(FCount)
  else
    SetLastContext('TXPWinSemaphore.Wait: ' + GetLastContext);

  end;

function TXPWinSemaphore.WaitFor(const Millisecs: cardinal): boolean;
  begin
  Result := inherited WaitFor(Millisecs);

  if Result then
    Windows.InterlockedDecrement(FCount)
  else
    SetLastContext('TXPWinSemaphore.WaitFor: ' + GetLastContext);

  end;

function TXPWinSemaphore.Leave: boolean;
  const
  ReleaseCount = 1;

  begin
  Result := Windows.ReleaseSemaphore(FHandle, ReleaseCount, @FCount);

  if Result then
    Windows.InterlockedIncrement(FCount)
  else
    Error('TXPWinSemaphore.Leave: Windows.ReleaseSemaphore failure');

  end;

function TXPWinSemaphore.Acquire: boolean;
  begin
  Result := Enter;

  if not Result then
    SetLastContext('TXPWinSemaphore.Acquire: ' + GetLastContext);

  end;

procedure TXPWinSemaphore.Release;
  begin
  Leave;
  end;

function TXPWinSemaphore.Open: boolean;
  begin

  Result := (FCount = 0);

  if not Result then
    exit;

  if not Windows.ReleaseSemaphore(FHandle, FCapacity, @FCount) then
    Error('TXPWinSemaphore.Open: Windows.ReleaseSemaphore failure')
  else
    // Set new Count value
    Windows.InterlockedExchange(FCount, FCount + FCapacity);

  end;

//////////////////////////////////////////////////////////////////////////////
///   TXPCriticalSectiom implementation
//////////////////////////////////////////////////////////////////////////////

type

  TXPWinCriticalSection = class(TXPWinError, IXPWinSynchro)
    private

    FCriticalSection: TRTLCriticalSection;

    //
    // IXPSynchro implementation
    //

    function Enter: boolean;
    function Leave: boolean;

    public

    constructor Create;
    destructor Destroy; override;
    end;

constructor TXPWinCriticalSection.Create;
  begin
{$IFDEF XPW32E}
  inherited Create(EXPWin32);
{$ELSE}
  inherited Create;
{$ENDIF}
  Windows.InitializeCriticalSection(FCriticalSection);
  end;

destructor TXPWinCriticalSection.Destroy;
  begin
  Windows.DeleteCriticalSection(FCriticalSection);
  inherited Destroy;
  end;

function TXPWinCriticalSection.Enter: boolean;
  begin
  Windows.EnterCriticalSection(FCriticalSection);
  Result := true;
  end;

function TXPWinCriticalSection.Leave: boolean;
  begin
  Result := true;
  Windows.LeaveCriticalSection(FCriticalSection);
  end;

//////////////////////////////////////////////////////////////////////////////
///   IXPWinCounter implementation
//////////////////////////////////////////////////////////////////////////////

type

  PInteger = ^integer;

  TXPWinSharedCounter = class(TXPWinNamedKernelObject, IXPSharedCounter)
    private

    FMutex: IXPWinMutex;
    FSync: IXPWinSynchro;
    FCounter: PInteger;

    function GetView: boolean;
    procedure ReleaseView;

    //
    // IXPCounter implementation
    //

    function GetValue: integer;
    procedure SetValue(const Value: integer);
    function Inc(const Delta: integer): integer;
    function Dec(const Delta: integer): integer;

    public

    constructor Create(const InitialValue: integer; const AName: string;
      const Inheritable: boolean; const SecurityDescriptor: Pointer);

    end;

constructor TXPWinSharedCounter.Create(const InitialValue: integer;
  const AName: string; const Inheritable: boolean;
  const SecurityDescriptor: Pointer);
  var
  SerialAccess: IXPRestore;

  const
  PageFileHandle = $FFFFFFFF;
  HiSize = 0;

  begin
  inherited Create(AName, Inheritable, SecurityDescriptor);
{$IFDEF XPW32E}
  SetException(EXPWin32SharedCounter);
{$ENDIF}
  FMutex := XPWinSync.GetMutex(GetName + '.XPCounter.Mutex', Inheritable,
    SecurityDescriptor);
  FSync := FMutex as IXPWinSynchro;
  SerialAccess := TXPWinSerialAccess.Create(FSync);
  // TODO: This call shouldn't be required as we only want to exclude
  // if mutex created - so we can set init value. However, the EnterOnCreate
  // argument doesn't work in Windows NT SP5 as documented, ie you don't get
  // initial ownership when requested if the mutex is created

  // Use this call to create or open file mapping object. Check last error
  // value to determine case
  FHandle := Windows.CreateFileMapping(PageFileHandle,
    @FSecurityAttributes, PAGE_READWRITE, HiSize, System.Sizeof(integer),
    PChar(GetName));

  if FHandle = 0 then
    begin
    Error('TXPWinSharedCounter.Create: Windows.CreateFileMapping failure');
    exit;
    end;

  // Store result from GetLastError
  SetLastError;

  if GetLastError = 0 then
    begin
    FInstance := koCreated;

    // Set initial value
    if GetView then
      begin
      FCounter^ := InitialValue;
      ReleaseView;
      end;

    end
  else if GetLastError = ERROR_ALREADY_EXISTS then
    FInstance := koOpened;

  end;

function TXPWinSharedCounter.GetView: boolean;
  const
  HiOffset = 0;
  LoOffset = 0;
  Length = System.Sizeof(integer);

  begin

  if not FSync.Enter then
    begin
    Error('TXPWinSharedCounter.GetView');
    Result := false;
    end
  else
    begin
    // Create view onto file mapping
    FCounter := Windows.MapViewOfFile(FHandle, FILE_MAP_WRITE,
      HiOffset, LoOffset, Length);
    Result := FCounter <> nil;

    if not Result then
      Error('TXPWinSharedCounter.GetView: Windows.MapViewOfFile failure');

    end;

  end;

procedure TXPWinSharedCounter.ReleaseView;
  begin
  if not FSync.Leave then
    Error('TXPWinSharedCounter.ReleaseView');

  if (FCounter <> nil) and (not Windows.UnmapViewOfFile(FCounter)) then
    Error('TXPWinSharedCounter.ReleaseView: Windows.UnmapViewOfFile failure');

  end;

function TXPWinSharedCounter.Dec(const Delta: integer): integer;
  begin
  Result := Inc(-Delta);
  end;

function TXPWinSharedCounter.GetValue: integer;
  begin

  if GetView then
    begin
    Result := FCounter^;
    ReleaseView;
    end
  else
    Result := XPCounterError;

  end;

function TXPWinSharedCounter.Inc(const Delta: integer): integer;
  begin

  if GetView then
    begin
    System.Inc(FCounter^, Delta);
    Result := FCounter^;
    ReleaseView;
    end
  else
    Result := XPCounterError;

  end;

procedure TXPWinSharedCounter.SetValue(const Value: integer);
  begin

  if GetView then
    begin
    FCounter^ := Value;
    ReleaseView;
    end

  end;

//////////////////////////////////////////////////////////////////////////////
///   IXPSyncRW implementation
//////////////////////////////////////////////////////////////////////////////

  // "Readers and writers" implementation (1)
  //
  // Single writer and multiple (unlimited) readers
  // Priority given to readers, ie writer must wait till all
  // readers have finished. (Can lead to writer starvation)
  // Implementation uses critical sections and is therefore limited
  // to a single process.

type TXPWinThreadRWSynchroniser = class(TSyncRWBase)
    private

    FReaders: integer;
    FAccess: IXPWinSynchro;
    FMutex: IXPWinSynchro;

    protected

    // Use ReadBegin/ReadEnd with a try..finally context
    procedure ReadBegin; override;
    procedure ReadEnd; override;
    // Use WriteBegin/WriteEnd with a try..finally context
    procedure WriteBegin; override;
    procedure WriteEnd; override;

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -