📄 xpwinsync.pas
字号:
//////////////////////////////////////////////////////////////////////////////
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 + -