unit YxdDB; interface uses Windows, Classes, SysUtils, SyncObjs; type TYXDDBValue = packed record Size: Cardinal; Data: Pointer; end; PYXDDBValue = ^TYXDDBValue; PPYXDDBItem = ^PYXDDBItem; PYXDDBItem = ^TYXDDBItem; TYXDDBItem = record Next: PYXDDBItem; Key: string; Value: TYXDDBValue; end; type TYXDDBHashList = class(TObject) private Buckets: array of PYXDDBItem; function Remove(const Key: string; List: TList): Boolean; overload; protected function Find(const Key: string): PPYXDDBItem; function HashOf(const Key: string): Cardinal; virtual; public constructor Create(Size: Cardinal = 256); destructor Destroy; override; procedure Clear; function Add(const Key: string; Value: PYXDDBValue): PYXDDBItem; function Remove(const Key: string): Boolean; overload; function Modify(const Key: string; Value: PYXDDBValue): Boolean; function ValueOf(const Key: string): PYXDDBValue; end; type TYXDDBBase = class(TObject) protected procedure WriteCardinal(avOut: TStream; avData: Cardinal); virtual; function ReadCardinal(avIn: TStream): Cardinal; virtual; procedure WriteString(avOut: TStream; const avData: string); virtual; function ReadString(avIn: TStream): string; virtual; procedure WriteBuffer(avOut: TStream; avData: Pointer; avLen: Cardinal); virtual; function ReadBuffer(avIn: TStream; var avOut: TBytes): Cardinal; public procedure SaveToFile(const FileName: string); virtual; procedure LoadFromFile(const FileName: string); virtual; procedure SaveToStream(Stream: TStream); virtual; abstract; procedure LoadFromStream(Stream: TStream); virtual; abstract; end; type TYXDBufferDebris = packed record Size: Cardinal; Buffer: PAnsiChar; end; PYXDBufferDebris = ^TYXDBufferDebris; type /// <summary> /// 自增长自释放数据缓存区 (多线程使用时自行处理线程冲突) /// </summary> TYXDAutoBuffer = class(TObject) private FDataBuf: array of PAnsiChar; FBufIndex: Cardinal; FBufSize: Cardinal; FDebrisList: TList; function GetBufSize: Cardinal; function GetBufferPageCount: Integer; protected procedure ClearDebris(); function GetDebrisItem(const Index: Integer): PYXDBufferDebris; function FindDebris(const ASize: Cardinal): Integer; procedure AddDebris(const ASize: Cardinal; ABuffer: Pointer); procedure RemoveDebris(const Index: Integer); public constructor Create(APageSize: Cardinal=1024*1024); destructor Destroy; override; // 释放所有缓冲区内存 procedure Clear; // 将GetBuffer申请的缓冲内存还回缓存区 //(还回时不检查内存地址是否为缓冲区地址,这意味着,可以添加额外的内存到此缓冲区) procedure RePushBuffer(Buffer: Pointer; ASize: Cardinal); // 申请缓冲区(大小不能超过分页大小) function GetBuffer(ASize: Cardinal): Pointer; // 已经申请的缓冲区大小 property BufferSize: Cardinal read GetBufSize; // 分页大小 property PageSize: Cardinal read FBufSize; // 分页总数 property PageCount: Integer read GetBufferPageCount; end; type /// <summary> /// YXD 数据中心 /// </summary> TYXDDB = class(TYXDDBBase) private FList: TList; FLocker: TCriticalSection; FHashList: TYXDDBHashList; FBuffer: TYXDAutoBuffer; FIsChange: Boolean; function GetCount: Integer; function GetItem(Index: Integer): PYXDDBItem; function GetValue(const Key: string): PYXDDBValue; protected procedure AddData(const Key: string; Data: Pointer; Size: Integer); virtual; public constructor Create(IntendCount: Cardinal = 9973); virtual; destructor Destroy; override; procedure Lock; procedure UnLock; procedure Clear; procedure Add(const Key: string; Data: Pointer; Size: Integer); procedure Delete(const Key: string); procedure SaveToStream(Stream: TStream); override; procedure LoadFromStream(Stream: TStream); override; property Count: Integer read GetCount; property Items[Index: Integer]: PYXDDBItem read GetItem; default; property Values[const Key: string]: PYXDDBValue read GetValue; property IsChange: Boolean read FIsChange write FIsChange; end; implementation const ERROR_GETBUFFAILED = 'Gain buffer failed. Want to apply to the Cache size exceed range.'; { TYXDDBHashList } function TYXDDBHashList.Add(const Key: string; Value: PYXDDBValue): PYXDDBItem; var Hash: Integer; Bucket: PYXDDBItem; begin Hash := HashOf(Key) mod Cardinal(Length(Buckets)); New(Bucket); Bucket^.Key := Key; Bucket^.Value := Value^; Bucket^.Next := Buckets[Hash]; Buckets[Hash] := Bucket; Result := Buckets[Hash]; end; procedure TYXDDBHashList.Clear; var I: Integer; P, N: PYXDDBItem; begin for I := 0 to Length(Buckets) - 1 do begin P := Buckets[I]; while P <> nil do begin N := P^.Next; Dispose(P); P := N; end; Buckets[I] := nil; end; end; constructor TYXDDBHashList.Create(Size: Cardinal); begin SetLength(Buckets, Size); end; destructor TYXDDBHashList.Destroy; begin Clear; inherited Destroy; end; function TYXDDBHashList.Find(const Key: string): PPYXDDBItem; var Hash: Integer; begin Hash := HashOf(Key) mod Cardinal(Length(Buckets)); Result := @Buckets[Hash]; while Result^ <> nil do if Result^.Key = Key then Exit else Result := @Result^.Next; end; function TYXDDBHashList.HashOf(const Key: string): Cardinal; var I: Integer; begin Result := 0; for I := 1 to Length(Key) do Result := ((Result shl 2) or (Result shr (SizeOf(Result) * 8 - 2))) xor Ord(Key[I]); end; function TYXDDBHashList.Modify(const Key: string; Value: PYXDDBValue): Boolean; var P: PYXDDBItem; begin P := Find(Key)^; if P <> nil then begin Result := True; P^.Value := Value^; end else Result := False; end; function TYXDDBHashList.Remove(const Key: string; List: TList): Boolean; var P: PYXDDBItem; Prev: PPYXDDBItem; begin Prev := Find(Key); P := Prev^; if P <> nil then begin if List <> nil then List.Remove(P); Prev^ := P^.Next; Dispose(P); Result := True; end else Result := False; end; function TYXDDBHashList.Remove(const Key: string): Boolean; begin Result := Remove(Key, nil) end; function TYXDDBHashList.ValueOf(const Key: string): PYXDDBValue; var P: PYXDDBItem; begin P := Find(Key)^; if P <> nil then Result := @P^.Value else Result := nil; end; { TYXDDBBase } procedure TYXDDBBase.LoadFromFile(const FileName: string); var Mem: TMemoryStream; begin if not FileExists(FileName) then Exit; Mem := TMemoryStream.Create; try Mem.LoadFromFile(FileName); LoadFromStream(Mem); finally FreeAndNil(Mem); end; end; function TYXDDBBase.ReadBuffer(avIn: TStream; var avOut: TBytes): Cardinal; var avLen: Cardinal; begin avLen := ReadCardinal(avIn); if avLen > 0 then begin SetLength(avOut, avLen); avIn.ReadBuffer(avOut[0], avLen); Result := avLen; end else Result := 0; end; function TYXDDBBase.ReadCardinal(avIn: TStream): Cardinal; begin avIn.ReadBuffer(Result, SizeOf(Result)); end; function TYXDDBBase.ReadString(avIn: TStream): string; var l: Integer; begin l := Self.ReadCardinal(avIn); SetLength(Result, l); if l > 0 then avIn.ReadBuffer(Result[1], l); end; procedure TYXDDBBase.SaveToFile(const FileName: string); var Mem: TMemoryStream; begin Mem := TMemoryStream.Create; try SaveToStream(Mem); Mem.SaveToFile(FileName); finally FreeAndNil(Mem); end; end; procedure TYXDDBBase.WriteBuffer(avOut: TStream; avData: Pointer; avLen: Cardinal); var buf: array of Byte; begin avOut.Write(avLen, SizeOf(avLen)); if (avLen) > 0 then begin SetLength(buf, avLen); CopyMemory(@buf[0], avData, avLen); avOut.WriteBuffer(buf[0], avLen); end; end; procedure TYXDDBBase.WriteCardinal(avOut: TStream; avData: Cardinal); begin avOut.WriteBuffer(avData, SizeOf(avData)); end; procedure TYXDDBBase.WriteString(avOut: TStream; const avData: string); var l: Cardinal; begin l := Length(avData); Self.WriteCardinal(avOut, l); if l > 0 then avOut.WriteBuffer(avData[1], l); end; { TYXDAutoBuffer } // 添加内存碎片到碎片列表中 procedure TYXDAutoBuffer.AddDebris(const ASize: Cardinal; ABuffer: Pointer); var I: Integer; Data: PYXDBufferDebris; begin for i := 0 to FDebrisList.Count - 1 do begin Data := GetDebrisItem(i); if (Data^.Buffer = ABuffer) then begin //如果有相同地址的碎片存在,则只更新下碎片大小 if (Data^.Size < ASize) then Data^.Size := ASize; Exit; end; end; New(Data); Data.Size := ASize; Data.Buffer := ABuffer; FDebrisList.Add(Data); end; procedure TYXDAutoBuffer.Clear; var I: Integer; begin FBufIndex := 0; for i := 0 to High(FDataBuf) do FreeMem(FDataBuf[i]); ClearDebris; SetLength(FDataBuf, 0); end; procedure TYXDAutoBuffer.ClearDebris; var i: Integer; begin for i := FDebrisList.Count - 1 downto 0 do RemoveDebris(i); end; constructor TYXDAutoBuffer.Create(APageSize: Cardinal); begin FBufSize := APageSize; FDataBuf := nil; FBufIndex := 0; FDebrisList := TList.Create; end; destructor TYXDAutoBuffer.Destroy; begin Clear; FreeAndNil(FDebrisList); inherited; end; function TYXDAutoBuffer.FindDebris(const ASize: Cardinal): Integer; var i: Integer; begin for I := 0 to FDebrisList.Count - 1 do if GetDebrisItem(i)^.Size <= ASize then begin Result := i; Exit; end; Result := -1; end; function TYXDAutoBuffer.GetBuffer(ASize: Cardinal): Pointer; var I: Integer; Data: PYXDBufferDebris; begin if ASize > FBufSize then raise Exception.Create(ERROR_GETBUFFAILED); I := FindDebris(ASize); if I < 0 then begin // 在碎片内存中没有可用内存 if (FBufIndex + ASize > FBufSize) or (High(FDataBuf) < 0) then begin SetLength(FDataBuf, High(FDataBuf) + 2); FDataBuf[High(FDataBuf)] := AllocMem(FBufSize); FBufIndex := 0; end; Result := @FDataBuf[High(FDataBuf)][FBufIndex]; FBufIndex := FBufIndex + ASize; end else begin // 有足够大的碎片内存可用 Data := GetDebrisItem(I); Result := Data^.Buffer; if Data^.Size > ASize then begin // 碎片内存没有用完,更新下地址和大小 Inc(Data^.Buffer, ASize); Data^.Size := Data^.Size - ASize; end else RemoveDebris(I); end; end; function TYXDAutoBuffer.GetBufferPageCount: Integer; begin Result := High(FDataBuf) + 1; end; function TYXDAutoBuffer.GetBufSize: Cardinal; begin if High(FDataBuf) < 0 then Result := FBufSize else Result := GetBufferPageCount * FBufSize; end; function TYXDAutoBuffer.GetDebrisItem(const Index: Integer): PYXDBufferDebris; begin Result := FDebrisList.Items[index]; end; procedure TYXDAutoBuffer.RemoveDebris(const Index: Integer); var Data: PYXDBufferDebris; begin Data := FDebrisList.Items[index]; FDebrisList.Delete(Index); Dispose(Data); end; procedure TYXDAutoBuffer.RePushBuffer(Buffer: Pointer; ASize: Cardinal); begin if (ASize > 0) and (Buffer <> nil) then AddDebris(ASize, Buffer); end; { TYXDDB } procedure TYXDDB.Add(const Key: string; Data: Pointer; Size: Integer); begin Lock; try AddData(Key, Data, Size); FIsChange := True; finally UnLock; end; end; procedure TYXDDB.AddData(const Key: string; Data: Pointer; Size: Integer); var isNew: Boolean; Item: PYXDDBValue; begin if (Data = nil) or (Size < 1) then Exit; Item := FHashList.ValueOf(Key); if Item = nil then begin New(Item); isNew := True; end else isNew := False; if (Item.Size < Size) then FBuffer.RePushBuffer(Item.Data, Item.Size); if isNew or (Item.Data = nil) or (Item.Size < Size) then Item.Data := FBuffer.GetBuffer(Size); Item.Size := Size; CopyMemory(Item.Data, Data, Size); if isNew then begin FList.Add(FHashList.Add(Key, Item)); Dispose(Item); end; end; procedure TYXDDB.Clear; begin Lock; try FList.Clear; FHashList.Clear; FBuffer.Clear; finally UnLock; end; end; constructor TYXDDB.Create(IntendCount: Cardinal); begin FList := TList.Create; FHashList := TYXDDBHashList.Create(IntendCount); FLocker := TCriticalSection.Create; FBuffer := TYXDAutoBuffer.Create(20*1024*1024); FIsChange := False; end; procedure TYXDDB.Delete(const Key: string); begin Lock; try FHashList.Remove(Key, FList); finally UnLock; end; end; destructor TYXDDB.Destroy; begin Clear; Lock; try FreeAndNil(FBuffer); FreeAndNil(FHashList); FreeAndNil(FList); inherited; finally UnLock; FLocker.Free; end; end; function TYXDDB.GetCount: Integer; begin Result := FList.Count; end; function TYXDDB.GetItem(Index: Integer): PYXDDBItem; begin if Index < FList.Count then Result := FList.Items[index] else Result := nil; end; function TYXDDB.GetValue(const Key: string): PYXDDBValue; begin Result := FHashList.ValueOf(Key); end; procedure TYXDDB.LoadFromStream(Stream: TStream); var i, size, count: Integer; buf: TBytes; key: string; begin Stream.Position := 0; if (ReadString(Stream) <> Self.ClassName) then Exit; count := ReadCardinal(Stream); if Count = 0 then Exit; Lock; try Self.Clear; for i := 0 to count - 1 do begin key := ReadString(Stream); size := ReadBuffer(Stream, buf); if (size > 0) and (size = High(buf) + 1) then AddData(key, @buf[0], High(buf) + 1); end; finally UnLock; end; end; procedure TYXDDB.Lock; begin FLocker.Enter; end; procedure TYXDDB.SaveToStream(Stream: TStream); var i: Integer; begin Lock; try Stream.Position := 0; WriteString(Stream, Self.ClassName); WriteCardinal(Stream, FList.Count); for i := 0 to FList.Count - 1 do begin if Items[i] <> nil then begin WriteString(Stream, Items[i]^.Key); WriteBuffer(Stream, Items[i]^.Value.Data, Items[i]^.Value.Size); end; end; finally UnLock; end; end; procedure TYXDDB.UnLock; begin FLocker.Leave; end; end.