1 //环形缓冲区实现类
  2 //2014-03-20 16:20
  3 //QQ 287413288
  4 unit uCircleBuffer;
  5 
  6 interface
  7 
  8 uses
  9   Windows,Classes;
 10 
 11 type
 12   TCircleBuffer=class
 13   private
 14     FMS:TMemoryStream;
 15     FUserData:Pointer;
 16     function GetMemory: Pointer;
 17   protected
 18     FReadPosition:Integer;
 19     FWritePosition:Integer;
 20     FCanReadCount:Integer;
 21     FCanWrieCount:Integer;
 22   public
 23     constructor Create(const BuffSize:Integer);virtual;
 24     destructor  Destroy();override;
 25     function    Write(const Buffer;Count:Integer):integer;virtual;
 26     function    Read(var Buffer;Count:Integer):Integer;virtual;
 27   public
 28     property ReadPosition:Integer  read FReadPosition;
 29     property WritePosition:Integer read FWritePosition;
 30     property CanReadCount:Integer  read FCanReadCount;
 31     property CanWrieCount:Integer  read FCanWrieCount;
 32     property Memory:Pointer read GetMemory;
 33     property UserData:Pointer read FUserData write FUserData;
 34   end;
 35 
 36   //线程安全版本
 37   TCircleBufferThread=class(TCircleBuffer)
 38   private
 39     FCS:TRTLCriticalSection;
 40     function GetReadPosition():Integer;
 41     function GetWritePosition():Integer;
 42     function GetCanReadCount():Integer;
 43     function GetCanWrieCount():Integer;
 44   public
 45     constructor Create(const BuffSize:Integer);override;
 46     destructor  Destroy();override;
 47     function    Write(const Buffer;Count:Integer):integer;override;
 48     function    Read(var Buffer;Count:Integer):Integer;override;
 49   public
 50     property ReadPosition:Integer  read GetReadPosition;
 51     property WritePosition:Integer read GetWritePosition;
 52     property CanReadCount:Integer  read GetCanReadCount;
 53     property CanWrieCount:Integer  read GetCanWrieCount;
 54   end;
 55 
 56 implementation
 57 
 58 { TCircleBuffer }
 59 
 60 constructor TCircleBuffer.Create(const BuffSize: Integer);
 61 begin
 62   FMS := TMemoryStream.Create();
 63   FMS.Size := BuffSize;
 64   FMS.Position := 0;
 65   FWritePosition := 0;
 66   FReadPosition  := 0;
 67   FCanWrieCount  := BuffSize;
 68   FCanReadCount  := 0;
 69   //\\
 70   ZeroMemory(FMS.Memory,FMS.Size);
 71 end;
 72 
 73 destructor TCircleBuffer.Destroy;
 74 begin
 75   inherited;
 76   FMS.Free();
 77 end;
 78 
 79 function TCircleBuffer.GetMemory: Pointer;
 80 begin
 81   Result := FMS.Memory;
 82 end;
 83 
 84 function TCircleBuffer.Read(var Buffer; Count: Integer): Integer;
 85 var
 86   P:PAnsiChar;
 87   Len,DataLen:Integer;
 88 begin
 89   Result := 0;
 90   //(I)
 91   if FCanReadCount <= 0 then
 92   begin
 93     Exit;
 94   end;
 95 
 96   if Count > FCanReadCount then
 97     DataLen := FCanReadCount
 98   else DataLen := Count;
 99 
100   FMS.Position := FReadPosition mod FMS.Size;
101   Result := FMS.Read(Buffer,DataLen);
102   Dec(FCanReadCount,Result);
103   Dec(Count,Result);
104 
105   //(II)
106   if (Count > 0) and (FCanReadCount > 0) then //继续读
107   begin
108     DataLen := Count;
109     if DataLen > FCanReadCount then DataLen := FCanReadCount;
110     FMS.Position := 0;
111     P := @Buffer;
112     Inc(P,Result);
113     Len := FMS.Read(P^,DataLen);
114     Inc(Result,Len);
115     Dec(FCanReadCount,Len);
116   end;
117 
118   //增加可写字节数
119   Inc(FCanWrieCount,Result);
120   if FCanWrieCount > FMS.Size then FCanWrieCount := FMS.Size;
121 
122   //调整读指针位置
123   Inc(FReadPosition,Result);
124   if FReadPosition > FMS.Size then Dec(FReadPosition,FMS.Size);
125 
126 end;
127 
128 function TCircleBuffer.Write(const Buffer; Count: Integer): integer;
129 var
130   Len,DataLen:Integer;
131   P:PAnsiChar;
132 begin
133   Result := 0;
134   //(I)
135   if FCanWrieCount <= 0 then
136   begin
137     Exit;
138   end;
139 
140   if Count > FCanWrieCount then DataLen := FCanWrieCount else DataLen := Count;
141   FMS.Position := FWritePosition mod FMS.Size;
142   P := @Buffer;
143   Result := FMS.Write(Buffer,DataLen);
144   P := FMS.Memory;
145   if P = nil then
146     Exit;
147   Dec(Count,Result);
148   Dec(FCanWrieCount,Result);
149   if (Count > 0) and (FCanWrieCount > 0) then
150   begin
151     //(II)
152     P := @Buffer;
153     Inc(P,Result);
154     Len := FReadPosition  - 0;
155     if Count > Len then DataLen := Len else DataLen := Count;
156     FMS.Position := 0;
157     Len := FMS.Write(P^,DataLen);
158     Inc(Result,Len);
159     Dec(FCanWrieCount,Len);
160   end;
161 
162   //增加可读字节数
163   Inc(FCanReadCount,Result);
164   if FCanReadCount > FMS.Size then FCanReadCount := FMS.Size;
165 
166   //调整写指针位置
167   Inc(FWritePosition,Result);
168   if FWritePosition > FMS.Size then
169     FWritePosition := FWritePosition - FMS.Size;
170 end;
171 
172 { TCircleBufferThread }
173 
174 constructor TCircleBufferThread.Create(const BuffSize: Integer);
175 begin
176   InitializeCriticalSection(FCS);  //初始化
177   inherited Create(BuffSize);
178 end;
179 
180 destructor TCircleBufferThread.Destroy;
181 begin
182   DeleteCriticalSection(FCS);
183   inherited;
184 end;
185 
186 function TCircleBufferThread.GetCanReadCount: Integer;
187 begin
188   EnterCriticalSection(FCS);
189   Result := FCanReadCount;
190   LeaveCriticalSection(FCS);
191 end;
192 
193 function TCircleBufferThread.GetCanWrieCount: Integer;
194 begin
195   EnterCriticalSection(FCS);
196   Result := FCanWrieCount;
197   LeaveCriticalSection(FCS);
198 end;
199 
200 function TCircleBufferThread.GetReadPosition: Integer;
201 begin
202   EnterCriticalSection(FCS);
203   Result := FReadPosition;
204   LeaveCriticalSection(FCS);
205 end;
206 
207 function TCircleBufferThread.GetWritePosition: Integer;
208 begin
209   EnterCriticalSection(FCS);
210   Result := FWritePosition;
211   LeaveCriticalSection(FCS);
212 end;
213 
214 function TCircleBufferThread.Read(var Buffer; Count: Integer): Integer;
215 begin
216   EnterCriticalSection(FCS);
217   try
218     Result := inherited read(Buffer,Count);
219   finally
220     LeaveCriticalSection(FCS);
221   end;
222 end;
223 
224 function TCircleBufferThread.Write(const Buffer; Count: Integer): integer;
225 begin
226   EnterCriticalSection(FCS);
227   try
228     Result := inherited Write(Buffer,Count);
229   finally
230     LeaveCriticalSection(FCS);
231   end;
232 end;
233 
234 end.

  1 procedure TForm1.btn1Click(Sender: TObject);
  2 var
  3   obj:TCircleBuffer;
  4   TmpStr:AnsiString;
  5   Len:Integer;
  6   Buf:array[1..4096] of AnsiChar;
  7   ASize,APosition:Integer;
  8   P:PAnsiChar;
  9 begin
 10 
 11   obj := TCircleBuffer.Create(10);
 12   ZeroMemory(@Buf,SizeOf(Buf));
 13 
 14   TmpStr := '0123456789';
 15   Len := obj.Write(TmpStr[1],Length(TmpStr));
 16   P := Obj.Memory;
 17   if P = nil then
 18     Exit;
 19 
 20   TmpStr := 'ABCD';
 21   Len := obj.Write(TmpStr[1],Length(TmpStr));
 22   if Len < 0 then
 23     Exit;
 24   P := Obj.Memory;
 25   if P = nil then
 26     Exit;
 27 
 28   TmpStr := '0123456789';
 29   Len := obj.Read(Buf,10);
 30   if Len < 0 then
 31     Exit;
 32 
 33     P := Obj.Memory;
 34   if P = nil then
 35     Exit;
 36 
 37   Len := obj.Read(Buf,10);
 38   if Len < 0 then
 39     Exit;
 40 
 41 
 42   P := Obj.Memory;
 43   if P = nil then
 44     Exit;
 45 
 46 
 47   tmpStr := 'ABC';
 48   Len := Obj.Write(TmpStr[1],3);
 49   if Len < 0 then
 50     Exit;
 51 
 52   tmpStr := '123456#';
 53   Len := Obj.Write(TmpStr[1],Length(TmpStr));
 54   if Len < 0 then
 55     Exit;
 56 
 57 
 58   P := Obj.Memory;
 59   if P = nil then
 60     Exit;
 61 
 62 
 63   FillChar(Buf,SizeOf(Buf),$32);
 64  // ZeroMemory(@Buf,SizeOf(Buf));
 65   Len := obj.Read(Buf,3);
 66     if Len < 0 then
 67     Exit;
 68 
 69   ZeroMemory(@Buf,SizeOf(Buf));
 70   Len := obj.Read(Buf,10);
 71     if Len < 0 then
 72     Exit;
 73 
 74 
 75    P := Obj.Memory;
 76   if P = nil then
 77     Exit;
 78 
 79   TmpStr := 'AB';
 80   Len := obj.Write(TmpStr[1],2);
 81   if Len < 0 then
 82    Exit;
 83 
 84      P := Obj.Memory;
 85   if P = nil then
 86     Exit;
 87 
 88 
 89   TmpStr := 'abcdefghijklmnopqrst';
 90   Len := obj.Write(TmpStr[1],Length(TmpStr));
 91   if Len < 0 then
 92    Exit;
 93 
 94 
 95 
 96 
 97    ZeroMemory(@Buf,SizeOf(Buf));
 98   Len := obj.Read(Buf,10);
 99     if Len < 0 then
100     Exit;
101 
102   if obj <> nil then
103     obj.Free();
104 
105      P := Obj.Memory;
106   if P = nil then
107     Exit;
108 
109 end;