Delphi 高效读写锁_语言综合

概述本人设计了一个高效读写锁，可实现多个线程读一个线程写的锁，应该比Delphi自带的读写锁高效，本人没有做对比测试。本文的锁不可以在一个线程里重入，否则会锁死，另外读写锁最多支持65535个线程同时读。 // [email protected]// 跨平台简易高效锁 unit utLocker; interface type // 多读单写锁 // 1.写的时候阻塞其他所有写

本人设计了一个高效读写锁，可实现多个线程读一个线程写的锁，应该比Delphi自带的读写锁高效，本人没有做对比测试。

本文的锁不可以在一个线程里重入，否则会锁死，另外读写锁最多支持65535个线程同时读。

// [email protected]// 跨平台简易高效锁 unit utLocker; interface type  // 多读单写锁  // 1.写的时候阻塞其他所有写和读  // 2.读的时候不阻塞其他读，但阻塞所有写，当阻塞了一个或以上的写后，将阻塞所有后来新的读  TMultiReadSingleWriteLocker = class  protected    [Volatile]    FLocker: Integer;  public    procedure LockRead;    procedure UnLockRead; inline;    procedure LockWrite;    procedure UnLockWrite; inline;    function TryLockRead: Boolean; inline;    function TryLockWrite: Boolean; inline;    constructor Create;  end;   TSimpleLocker = class  protected    [Volatile]    FLocker: Integer;  public    procedure Lock;    procedure UnLock; inline;    function TryLock: Boolean; inline;  end; implementation uses System.SyncObJs,System.SysUtils,System.Classes; type  TSpinWait = record  private const    YIEldThreshold = 10;    Sleep1Threshold = 20;    Sleep0Threshold = 5;  private    FCount: Integer;    function GetNextSpinCycleWillYIEld: Boolean; inline;  public    procedure reset;inline;    procedure SpinCycle;inline;     property Count: Integer read FCount;    property NextSpinCycleWillYIEld: Boolean read GetNextSpinCycleWillYIEld;  end;   { TSpinWait } function TSpinWait.GetNextSpinCycleWillYIEld: Boolean;begin  Result := (FCount > YIEldThreshold) or (cpuCount = 1);end; procedure TSpinWait.reset;begin  FCount := 0;end; procedure TSpinWait.SpinCycle;var  SpinCount: Integer;begin  if NextSpinCycleWillYIEld then  begin    if FCount >= YIEldThreshold then      SpinCount := FCount - YIEldThreshold    else      SpinCount := FCount;    if SpinCount mod Sleep1Threshold = Sleep1Threshold - 1 then      TThread.Sleep(1)    else if SpinCount mod Sleep0Threshold = Sleep0Threshold - 1 then      TThread.Sleep(0)    else      TThread.YIEld;  end  else    TThread.SpinWait(4 shl FCount);  Inc(FCount);  if FCount < 0 then    FCount := YIEldThreshold + 1;end; { TMultiReadSingleWriteLocker } procedure TMultiReadSingleWriteLocker.LockRead;var  CurLock: Integer;  Wait: TSpinWait;begin  Wait.reset;  while True do  begin    CurLock := FLocker;    if CurLock <= $FFFF then    begin      if TInterlocked.CompareExchange(FLocker,CurLock + 1,CurLock) = CurLock      then        Exit;    end;    Wait.SpinCycle;  end;end; procedure TMultiReadSingleWriteLocker.LockWrite;var  CurLock: Integer;  Wait: TSpinWait;begin  Wait.reset;  while True do  begin    CurLock := FLocker;    if CurLock <= $FFFF then    begin      if TInterlocked.CompareExchange(FLocker,CurLock + $10000,CurLock) = CurLock      then        Exit;    end;    Wait.SpinCycle;  end;end; function TMultiReadSingleWriteLocker.TryLockRead: Boolean;var  CurLock: Integer;begin  CurLock := FLocker;  if CurLock <= $FFFF then    Result := TInterlocked.CompareExchange(FLocker,CurLock + 1,CurLock)      = CurLock  else    Result := False;end; function TMultiReadSingleWriteLocker.TryLockWrite: Boolean;var  CurLock: Integer;begin  CurLock := FLocker;  if CurLock <= $FFFF then    Result := TInterlocked.CompareExchange(FLocker,CurLock + $10000,CurLock)      = CurLock  else    Result := False;end; procedure TMultiReadSingleWriteLocker.UnLockWrite;begin  if FLocker < $10000 then    raise Exception.Create(‘TMultiReadSingleWriteLocker Error‘);   TInterlocked.Add(FLocker,-$10000);end; procedure TMultiReadSingleWriteLocker.UnLockRead;begin  TInterlocked.Decrement(FLocker);end; constructor TMultiReadSingleWriteLocker.Create;begin  FLocker := 0;end; { TSimpleLocker } procedure TSimpleLocker.Lock;var  Wait: TSpinWait;begin  Wait.reset;  while True do  begin    if FLocker = 0 then    begin      if TInterlocked.CompareExchange(FLocker,1,0) = 0 then        Exit;    end;    Wait.SpinCycle;  end;end; function TSimpleLocker.TryLock: Boolean;begin  if FLocker = 0 then  begin    Result := TInterlocked.CompareExchange(FLocker,0) = 0;  end  else    Result := False;end; procedure TSimpleLocker.UnLock;begin  if TInterlocked.CompareExchange(FLocker,0,1) <> 1 then    raise Exception.Create(‘TSimpleLocker Error‘);end; end.

一个简易无锁池

1.所有读写无等待，不需要判断条件直接读写(除自动扩充容量时），效率是一般带锁或带条件判断池的两倍以上。

2.预先开辟2的幂大小容量，可自增，每次翻倍

3.仅提供思路，工程应用可靠性还不确定。

// 无锁池// hezihang @cnblogs.com// 20160228 增加代引用计数器内存块的池，增加编译指令POolGROW功能，可打开关闭池的自动翻倍增长功能// 20160225 修正Grow中FWritePtr没有增长BUG// 20140609 增加Grow临界区，减少等待时间// 20140608 修正可能存在同时Grow的BUGunit Iocp.AtomPool;interface{ .$define POolGROW }Uses  System.SysUtils,System.SyncObJs;Type  Int32 = Integer;  UInt32 = Cardinal;  TAtomPoolAbstract = class  private    FWritePtr: Int32;    FReadPtr: Int32;    FHighBound: UInt32;    FData: array of Pointer;{$IFDEF POolGROW}    FCs: TCriticalSection;    FLock: Int32;    procedure CheckGrow; inline;    procedure Grow; inline;{$ENDIF}  Protected    function AlLocitemResource: Pointer; virtual; abstract;    procedure FreeItemResource(Item: Pointer); virtual; abstract;    function GetCapacity: UInt32;    procedure FreeResources;  Public    procedure AllocResources;    function Get: Pointer;    procedure Put(Item: Pointer);    Constructor Create(Capacity: UInt32); Virtual;    Destructor Destroy; OverrIDe;    property Capacity: UInt32 read GetCapacity;  End;  TAtomPoolMem4K = class(TAtomPoolAbstract)    function AlLocitemResource: Pointer; overrIDe;    procedure FreeItemResource(Item: Pointer); overrIDe;  end;  // 内存块带引用计数器的池,池容量恒定不能增长  TAtomMemoryPoolRef = class  private    FMemory: PByteArray;    FWritePtr: Int32;    FReadPtr: Int32;    FHighBound: UInt32;    FMemSize: UInt32;    FData: array of Pointer;    FDataRef: array of Int32;  Protected    function GetCapacity: UInt32;    procedure AllocResources;    procedure FreeResources;  Public    function Get: Pointer;    procedure Put(Item: Pointer);    function IncRef(Item: Pointer): Int32;    function DecRef(var Item: Pointer): Int32;    Constructor Create(Capacity: UInt32; MemSize: UInt32);    Destructor Destroy; OverrIDe;    property Capacity: UInt32 read GetCapacity;    property MemSize:UInt32 read FMemSize;  End;Implementationconst  MAXTHREADCOUNT = 1000; // 从池中申请资源最大线程数  // 创建池，大小必须是2的幂,并且必须大于MAXTHREADCOUNTConstructor TAtomPoolAbstract.Create(Capacity: UInt32);var  OK: Boolean;Begin  inherited Create;  OK := (Capacity and (Capacity - 1) = 0);  OK := OK and (Capacity > MAXTHREADCOUNT);  if not OK then    raise Exception.Create(Format(‘池长度必须大于%d并为2的幂‘,[MAXTHREADCOUNT]));{$IFDEF POolGROW}  FCs := TCriticalSection.Create;{$ENDIF}  FHighBound := Capacity - 1;  FReadPtr := 0;End;Destructor TAtomPoolAbstract.Destroy;Begin  FreeResources;  SetLength(FData,0);{$IFDEF POolGROW}  FCs.Free;{$ENDIF}  inherited;End;procedure TAtomPoolAbstract.AllocResources;var  i: UInt32;begin  try    SetLength(FData,Capacity);    for i := 0 to FHighBound do      FData[i] := AlLocitemResource;  except    Raise Exception.Create(‘池申请内存失败‘);  end;end;procedure TAtomPoolAbstract.FreeResources;var  i: UInt32;begin  for i := FHighBound downto 0 do    Self.FreeItemResource(FData[i]);end;procedure TAtomPoolAbstract.Put(Item: Pointer);var  N: UInt32;begin{$IFDEF POolGROW}  CheckGrow;{$ENDIF}  N := TInterlocked.Increment(FWritePtr);  FData[N and FHighBound] := Item;end;Function TAtomPoolAbstract.Get: Pointer;var{$IFDEF POolGROW}  N,M,K: UInt32;{$ELSE}  N: UInt32;{$ENDIF}begin{$IFDEF POolGROW}  N := FWritePtr and FHighBound;  M := FReadPtr and FHighBound;  K := (M + MAXTHREADCOUNT) and FHighBound;  if (N > M) and (N < K) then  // if ((N > M) and (N < K)) or ((N < M) and (N > K)) then  begin    Grow  end;{$ENDIF}  N := TInterlocked.Increment(FReadPtr);  Result := FData[N and FHighBound];end;function TAtomPoolAbstract.GetCapacity: UInt32;begin  Result := FHighBound + 1;end;{$IFDEF POolGROW}procedure TAtomPoolAbstract.CheckGrow;begin  if TInterlocked.Add(FLock,0) > 0 then  begin    while FLock = 1 do      Sleep(0);    FCs.Enter;    FCs.Leave;  end;end;procedure TAtomPoolAbstract.Grow;var  i,N: Integer;begin  if TInterlocked.CompareExchange(FLock,0) = 0 then // 加锁  begin    FCs.Enter;    TInterlocked.Increment(FLock);    N := Length(FData);    SetLength(FData,N + N);    for i := N to High(FData) do      FData[i] := AlLocitemResource;    TInterlocked.Increment(FLock);    FHighBound := High(FData);    FWritePtr := FHighBound;    FCs.Leave;    TInterlocked.Exchange(FLock,0);  end  else    CheckGrow;end;{$ENDIF}{ TAtomPoolMem4K }function TAtomPoolMem4K.AlLocitemResource: Pointer;begin  GetMem(Result,4096);end;procedure TAtomPoolMem4K.FreeItemResource(Item: Pointer);begin  FreeMem(Item,4096);end;Constructor TAtomMemoryPoolRef.Create(Capacity: UInt32; MemSize: UInt32);var  OK: Boolean;Begin  inherited Create;  OK := (Capacity and (Capacity - 1) = 0);  OK := OK and (Capacity > MAXTHREADCOUNT);  if not OK then    raise Exception.Create(Format(‘池长度必须大于%d并为2的幂‘,[MAXTHREADCOUNT]));  if FMemSize and $10 <> 0 then    raise Exception.Create(‘内存块大小必须是16的倍数‘);  FMemSize := MemSize;  try    AllocResources;    FHighBound := Capacity - 1;    FWritePtr := FHighBound;    FReadPtr := 0;  except    Raise Exception.Create(‘池申请内存失败‘);  end;End;function TAtomMemoryPoolRef.DecRef(var Item: Pointer): Int32;var  N: Integer;begin  N := (NativeUInt(Item) - NativeUInt(FMemory)) div FMemSize;  if (N>=0) and (N<=FHighBound) then  begin    Result := TInterlocked.Decrement(FDataRef[N]);    if Result = 0 then    begin      Put(Item);      Item := nil;    end;  end  else Result:=-1;end;Destructor TAtomMemoryPoolRef.Destroy;Begin  FreeResources;  inherited;End;procedure TAtomMemoryPoolRef.AllocResources;var  i: UInt32;  P: PByteArray;begin  SetLength(FData,Capacity);  SetLength(FDataRef,Capacity);  FillChar(FDataRef[0],Capacity * Sizeof(FDataRef[0]),0);  GetMem(FMemory,Length(FData) * FMemSize); // 一次申请所有内存  P := FMemory;  for i := 0 to FHighBound do  begin    FData[i] := P;    Inc(P,FMemSize);  end;end;procedure TAtomMemoryPoolRef.FreeResources;begin  FreeMem(FMemory,Length(FData) * FMemSize);  SetLength(FData,0);  SetLength(FDataRef,0);end;procedure TAtomMemoryPoolRef.Put(Item: Pointer);var  N: UInt32;begin  N := TInterlocked.Increment(FWritePtr);  FData[N and FHighBound] := Item;end;Function TAtomMemoryPoolRef.Get: Pointer;var  N: UInt32;begin  N := TInterlocked.Increment(FReadPtr);  Result := FData[N and FHighBound];end;function TAtomMemoryPoolRef.GetCapacity: UInt32;begin  Result := FHighBound + 1;end;function TAtomMemoryPoolRef.IncRef(Item: Pointer): Int32;var  N: Integer;begin  N := (NativeInt(Item) - NativeInt(FMemory)) div FMemSize;  if (N>=0) and (N<=FHighBound) then    Result := TInterlocked.Increment(FDataRef[N])  else    Result:=-1;end;End.

简易高效的Delphi原子队列

本文提供Delphi一个基于原子 *** 作的无锁队列，简易高效。适用于多线程大吞吐量 *** 作的队列。

可用于AndroID系统和32，64位windows系统。

感谢歼10和qsl提供了修改建议！

有如下问题：

1.必须事先足够大开辟内存，大到不会出现队列溢出了。

2.队列大小必须是2的幂

3.不能压入空指针

4.本程序还未经过工程应用考验

unit Iocp.AtomQueue;interfaceUses  SysUtils,SyncObJs;Type  TAtomFIFO = Class  Protected    FWritePtr: Integer;    FReadPtr: Integer;    FCount:Integer;    FHighBound:Integer;    FisEmpty:Integer;    FData: array of Pointer;    function GetSize:Integer;  Public    procedure Push(Item: Pointer);    function Pop: Pointer;    Constructor Create(Size: Integer); Virtual;    Destructor Destroy; OverrIDe;    Procedure Empty;    property Size: Integer read GetSize;    property UsedCount:Integer read FCount;  End;Implementation//创建队列，大小必须是2的幂，需要开辟足够大的队列，防止队列溢出Constructor TAtomFIFO.Create(Size: Integer);var  i:NativeInt;  OK:Boolean;Begin  inherited Create;  OK:=(Size and (Size-1)=0);  if not OK then raise Exception.Create(‘FIFO长度必须大于等于256并为2的幂‘);  try    SetLength(FData,Size);    FHighBound:=Size-1;  except    Raise Exception.Create(‘FIFO申请内存失败‘);  end;End;Destructor TAtomFIFO.Destroy;Begin  SetLength(FData,0);  inherited;End;procedure TAtomFIFO.Empty;begin  while (TInterlocked.Exchange(FReadPtr,0)<>0) and  (TInterlocked.Exchange(FWritePtr,0)<>0) and  (TInterlocked.Exchange(FCount,0)<>0) do;end;function TAtomFIFO.GetSize: Integer;begin  Result:=FHighBound+1;end;procedure TAtomFIFO.Push(Item:Pointer);var  N:Integer;begin  if Item=nil then Exit;  N:=TInterlocked.Increment(FWritePtr) and FHighBound;  FData[N]:=Item;  TInterlocked.Increment(FCount);end;Function TAtomFIFO.Pop:Pointer;var  N:Integer;begin  if TInterlocked.Decrement(FCount)<0 then  begin    TInterlocked.Increment(FCount);    Result:=nil;  end  else  begin    N:=TInterlocked.Increment(FReadPtr) and FHighBound;    //假设线程A调用了Push,并且正好是第1个push，    //执行了N:=TInterlocked.Increment(FWritePtr) and FHighBound,    //还没执行FData[N]:=Item,被切换到其他线程    //此时假设线程B调用了Push，并且正好是第2个push,并且执行完毕，这样出现FCount=1,第2个Item不为空，而第一个Item还是nil（线程A还没执行赋值）    //假设线程C执行Pop，由于Count>0（线程B的作用）所以可以执行到这里，但此时FData[N]=nil（线程A还没执行赋值），    //因此线程C要等待线程A完成FData[N]:=Item后，才能取走FData[N]    //出现这种情况的概率应该比较小，基本上不会浪费太多cpu    while FData[N]=nil do Sleep(1);    Result:=FData[N];    FData[N]:=nil;  end;end;End.

性能测试：

采用天地弦提供的评估程序，进行了一些修改，分别对使用不同的临界区的队列进行对比结果如下：

其中Swith是因队列读空，进行线程上下文切换的次数

Delphi的FIFO实现

FIFO主要用于多个不同线程或进程之间数据交换时做缓冲区用，尤其适合实时数据通讯应用中的数据缓冲，接收线程（进程）将数据写入FIFO，处理线程（进程）从FIFO取出数据

本单元中：

TMemoryFIFO类适用于单进程内不同线程之间交换数据

TMapfileFIFO类适用于不同进程之间交换数据

Unit UtFIFO; Interface Uses  windows,SysUtils,SyncObJs; Type  PFIFOStruct= ^TFIFOStruct;   TFIFOStruct= Record    FSize: Integer;    FWritePtr: Integer;    FReadPtr: Integer;    FBuffer: TByteArray;  End;   TFIFOReadFunc= Function(Buf: Pointer; Count: Integer): Integer;  TFIFOReadFuncOfObject= Function(const Buf;  Count: Integer): Integer Of Object;   TAbstractFIFO= Class  Protected    FSelfAccess: Boolean;    FDataStruct: PFIFOStruct; // 数据区指针    Procedure AllocateResource(Size: Integer); Virtual; Abstract;    Procedure FreeResources; Virtual; Abstract;    Procedure Lock; Virtual; Abstract;    Procedure UnLock; Virtual; Abstract;  Public    Function FIFOFreeSpace: Integer;    Function FIFOUsedspace: Integer;    Function CheckFIFOFull: Boolean;    Function CheckFIFOEmpty: Boolean;    Function WriteData(const Buf: Pointer; Count: Integer): Integer; Virtual;    Function ReadData(Buf: Pointer; Count: Integer): Integer; Virtual;    Function ReadDataByFunc(Func: TFIFOReadFuncOfObject;      Count: Integer): Integer; Virtual;    Constructor Create(Size: Integer); Virtual;    Destructor Destroy; OverrIDe;    Procedure Empty;    Function Size: Integer;  End;   TMemoryFIFO= Class(TAbstractFIFO)  Protected    FLocker: TCriticalSection;    Procedure AllocateResource(Size: Integer); OverrIDe;    Procedure FreeResources; OverrIDe;    Procedure Lock; OverrIDe;    Procedure UnLock; OverrIDe;  Public    Constructor Create(Size: Integer); OverrIDe;    Destructor Destroy; OverrIDe;  End;   TfileMapFIFO= Class(TAbstractFIFO)  Private    FMaster:Boolean;    FMapHandle: THandle; // 内存映射文件句柄    FMutexHandle: THandle; // 互斥句柄    FMapname: String; // 内存映射对象    FPVHandle: THandle;  Protected    Procedure AllocateResource(Size: Integer); OverrIDe;    Procedure FreeResources; OverrIDe;    Procedure Lock; OverrIDe;    Procedure UnLock; OverrIDe;  Public    Constructor Create(Const Mapname: String; Size: Integer;bMaster:Boolean); Overload;    Destructor Destroy; OverrIDe;    Function WriteData(const Buf: Pointer; Count: Integer): Integer; OverrIDe;    Function ReadData(Buf: Pointer; Count: Integer): Integer; OverrIDe;    property PVHandle:NativeUInt  read FPVHandle;  End; Implementation Function Min(Const A,B: Integer): Integer; inline;begin  if A>B then Result:=B else Result:=Aend; Constructor TAbstractFIFO.Create(Size: Integer);Begin  inherited Create;  AllocateResource(Size);   If Not Assigned(FDataStruct) Then    Raise Exception.Create(‘FIFO申请内存失败‘);End; Destructor TAbstractFIFO.Destroy;Begin  FreeResources;  inherited;End; Function TAbstractFIFO.FIFOFreeSpace;Begin  With FDataStruct^ Do  Begin    Lock;    If FWritePtr> FReadPtr Then      Result:= (FSize- FWritePtr)+ FReadPtr- 1    Else    If FWritePtr< FReadPtr Then      Result:= FReadPtr- FWritePtr- 1    Else      Result:= FSize;    UnLock;  End;End; Function TAbstractFIFO.FIFOUsedspace;Begin  With FDataStruct^ Do  Begin    Lock;    If FWritePtr> FReadPtr Then      Result:= FWritePtr- FReadPtr    Else    If FWritePtr< FReadPtr Then      Result:= (FSize- FReadPtr)+ FWritePtr    Else      Result:= 0;    UnLock;  End;End; Function TAbstractFIFO.CheckFIFOFull: Boolean;Begin  With FDataStruct^ Do  Begin    Lock;    If (FWritePtr= FSize- 1)And (FReadPtr= 0) Then      Result:= True    Else    If (FWritePtr+ 1= FReadPtr) Then      Result:= True    Else      Result:= False;    UnLock;  End;End; Function TAbstractFIFO.CheckFIFOEmpty: Boolean;Begin  With FDataStruct^ Do  Begin    Lock;    Result:= (FWritePtr= FReadPtr);    UnLock;  End;End; Function TAbstractFIFO.WriteData(const Buf: Pointer; Count: Integer): Integer;Var  N: Integer;Begin   Result:= 0;  If Count<= 0 Then    Exit;  With FDataStruct^ Do  Begin    Lock;    If FWritePtr< FReadPtr Then               //如果没有满或已满    Begin      Result:= Min(Count,FReadPtr- FWritePtr- 1);      Move(Buf^,FBuffer[FWritePtr],Result);      FWritePtr:= (FWritePtr+ Result)Mod FSize;    End    Else    If FWritePtr = FReadPtr Then //Buffer 空    Begin      Result:= Min(Count,FSize- 1);      Move(Buf^,FBuffer[0],Result);      FWritePtr:= Result;      FReadPtr:= 0;    End    Else    Begin      Result:= Min(Count,FSize- FWritePtr);      Move(Buf^,Result);      if Result=Count then FWritePtr:= (FWritePtr+ Result) Mod FSize      else      Begin          N:= Min(Count- Result,FReadPtr);          Move(PByteArray(Buf)^[Result],N);          FWritePtr:= N;          Result:= Result+ N;      End;    End;    UnLock;  End;End; Function TAbstractFIFO.ReadData(Buf: Pointer; Count: Integer): Integer;Var  N: Integer;Begin  Result:= 0;  If Count<= 0 Then    Exit;  With FDataStruct^ Do  Begin    Lock;    If FReadPtr< FWritePtr Then    Begin      Result:= Min(Count,FWritePtr- FReadPtr);      Move(FBuffer[FReadPtr],Buf^,Result);      FReadPtr:= (FReadPtr+ Result)Mod FSize;    End    Else if FReadPtr>FWritePtr Then    Begin      Result:= Min(Count,FSize- FReadPtr);      Move(FBuffer[FReadPtr],Result);      if Result=Count then FReadPtr:=(FReadPtr+Result) mod FSize      else      Begin          N:= Min(Count- Result,FWritePtr);          Move(FBuffer[0],PByteArray(Buf)[Result],N);          FReadPtr:= N;          Result:= Result+ N;      End;    End;    UnLock;  End;End; Function TAbstractFIFO.ReadDataByFunc(Func: TFIFOReadFuncOfObject;  Count: Integer): Integer;Var  N,M: Integer;Begin  Result:= 0;  If Count<= 0 Then    Exit;   With FDataStruct^ Do  Begin    Lock;    Try      If FReadPtr< FWritePtr Then      Begin        Result:= Func(FBuffer[FReadPtr],Min(Count,FWritePtr- FReadPtr));        FReadPtr:= (FReadPtr+ Result)Mod FSize;      End      Else if FReadPtr>FWritePtr Then      Begin        Result:= Func(FBuffer[FReadPtr],FSize- FReadPtr));        if Result=Count then FReadPtr:=(FReadPtr+Result) mod FSize        else        Begin            N:= Func(FBuffer[0],Min(Count- Result,FWritePtr));            FReadPtr:= N;            Result:= Result+ N;        End;      End;    Finally      UnLock;    End;  End;End; Procedure TAbstractFIFO.Empty;Begin  Lock;  With FDataStruct^ Do  Begin    FWritePtr:= 0;    FReadPtr:= 0;  End;  UnLock;End; Function TAbstractFIFO.Size: Integer;Begin  Result:= FDataStruct^.FSize- 1;End; Constructor TMemoryFIFO.Create(Size: Integer);Begin  inherited Create(Size);  FLocker:= TCriticalSection.Create;End; Destructor TMemoryFIFO.Destroy;Begin  FLocker.Free;  inherited;End; Procedure TMemoryFIFO.AllocateResource(Size: Integer);Begin  inherited;  GetMem(FDataStruct,Size+ 3* Sizeof(Integer));  With FDataStruct^ Do  Begin    FSize:= Size;    FWritePtr:= 0;    FReadPtr:= 0;  End;End; Procedure TMemoryFIFO.FreeResources;Begin  FreeMem(FDataStruct,FDataStruct^.FSize+ 3* Sizeof(Integer));  inherited;End; Procedure TMemoryFIFO.Lock;Begin  FLocker.Enter;End;Procedure TMemoryFIFO.UnLock;Begin  FLocker.Leave;End; // 构造函数Constructor TfileMapFIFO.Create(Const Mapname: String; Size: Integer;bMaster:Boolean);Begin  FMapname:= Mapname;  FMaster:=bMaster;  inherited Create(Size);End; Destructor TfileMapFIFO.Destroy;Begin  CloseHandle(FPVHandle);  inherited;End; Procedure TfileMapFIFO.AllocateResource(Size: Integer);Begin  inherited;  if FMaster then  begin    FMapHandle:= CreatefileMapPing($FFFFFFFF,Nil,PAGE_READWRITE,0,Size+ 3* Sizeof(Integer),PChar(FMapname));     If (FMapHandle= INVALID_HANDLE_VALUE)Or (FMapHandle= 0) Then      Raise Exception.Create(‘创建文件映射对象失败!‘);  end  else    FMapHandle:=OpenfileMapPing(file_MAP_ALL_ACCESS,False,PChar(FMapname));   FDataStruct:= MapVIEwOffile(FMapHandle,file_MAP_ALL_ACCESS,0);   // 创建互斥对象，在写文件映射空间时用到它，以保持数据同步  FMutexHandle:= windows.CreateMutex(Nil,PChar(FMapname+ ‘.Mtx‘));  FPVHandle := CreateEvent(nil,True,PChar(FMapname + ‘.PV‘));  If (FMutexHandle= 0)or(FPVHandle = 0) Then    Raise Exception.Create(‘创建互斥对象失败‘);   // 判断是否已经建立文件映射了  If (FMapHandle <> 0)And (GetLastError = ERROR_ALREADY_EXISTS) Then  Begin  End  Else  Begin    FillChar(FDataStruct^,Size+ 3* Sizeof(Integer),0);    FDataStruct^.FSize:= Size;  EndEnd; Procedure TfileMapFIFO.FreeResources;Begin  UnmapVIEwOffile(FDataStruct);  CloseHandle(FMutexHandle);  CloseHandle(FMapHandle);  inherited;End;Procedure TfileMapFIFO.Lock;Begin  WaitForSingleObject(FMutexHandle,INFINITE); // =WAIT_OBJECT_0)End; Procedure TfileMapFIFO.UnLock;Begin  ReleaseMutex(FMutexHandle);End; Function TfileMapFIFO.WriteData(const Buf: Pointer; Count: Integer): Integer;Begin  Lock;  Result:= inherited WriteData(Buf,Count);  SetEvent(FPVHandle);  UnLock;End; Function TfileMapFIFO.ReadData(Buf: Pointer; Count: Integer): Integer;Begin  Lock;  Result:= inherited ReadData(Buf,Count);  UnLock;End; End.