文件hash数据库

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.