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.

文件hash数据库的更多相关文章

  1. sqlserver多文件组数据库的备份和还原实战

    数据库文件过大时就要进行数据分区,就是讲数据库拆分到多个文件组中.已方便数据文件管理,提高数据库的读取效能,多文件组如何进行数据库的备份和还原呢,今天主要做多文件组数据库的备份和还原实验. 第一步 创 ...

  2. 小型单文件NoSQL数据库SharpFileDB初步实现

    小型单文件NoSQL数据库SharpFileDB初步实现 我不是数据库方面的专家,不过还是想做一个小型的数据库,算是一种通过mission impossible进行学习锻炼的方式.我知道这是自不量力, ...

  3. Rafy 领域实体框架演示(4) - 使用本地文件型数据库 SQLCE 绿色部署

    本系列演示如何使用 Rafy 领域实体框架快速转换一个传统的三层应用程序,并展示转换完成后,Rafy 带来的新功能. <福利到!Rafy(原OEA)领域实体框架 2.22.2067 发布!> ...

  4. 解剖SQLSERVER 第八篇 OrcaMDF 现在支持多数据文件的数据库(译)

    解剖SQLSERVER 第八篇  OrcaMDF 现在支持多数据文件的数据库(译) http://improve.dk/orcamdf-now-supports-databases-with-mult ...

  5. Android通过xml文件配置数据库

    之前一段时间自己封装了两个数据库,一个是ORM数据库,另一个是事件流数据库,项目相应的地址如下: ORM数据库:https://github.com/wenjiang/SimpleAndroidORM ...

  6. Unity打包同一文件Hash不一样

    问题起因 游戏开发基本都会涉及到资源版本管理及更新,本文记录我在打包过程中遇到的一小问题: 开过中常用于标记资源版本的方法有计算文件Hash.VCS的版本等. 在Unity中对同一个资源文件进行多次打 ...

  7. SQLServer2008R2 mdf文件还原数据库

    偶然遇到要用mdf文件restore数据库,试了2个小时才弄出来,百度查出来的我试了都不太好用,或者是我没理解. 下面把我用的记录一下,以防忘记. 工具:SQLServer 2008R2 步骤: 1. ...

  8. Sql Server 附加没有日志文件的数据库(.mdf)文件方法

    附加数据库,附加的时候会提醒找不到log文件 针对以上现象有两个写法的语句能解决: 写法一: USE MASTER; EXEC sp_detach_db @dbname = 'TestDB'; EXE ...

  9. log4net--帮助程序员将日志信息输出到各种目标(控制台、文件、数据库等)的工具

    1. log4net库是Apache log4j框架在Microsoft .NET平台的实现,是一个帮助程序员将日志信息输出到各种目标(控制台.文件.数据库等)的工具. 2. Log4net的结构如下 ...

随机推荐

  1. EaseType缓动函数

    http://sol.gfxile.net/interpolation/   一篇很详细的图文

  2. bugfree安装

    1.下载xampp文件:xampp-linux-x64-5.5.30-3-installer.run 2.安装此文件,用root账号安装,安装命令:./xampp-linux-x64-5.5.30-3 ...

  3. C#窗体 WinForm 对话框,流

    一.对话框 ColorDialog:颜色选择控件 private void button1_Click(object sender, EventArgs e) { //显示颜色选择器 colorDia ...

  4. 编写HTML表单提交并接受数据信息(获取用户通过表单提交的内容)

    MyInfoForm.java package com.fxl; import java.io.IOException; import java.io.PrintWriter; import java ...

  5. canvas 绘制 矩形 圆形

    <!DOCTYPE html><html xmlns="http://www.w3.org/1999/xhtml"><head> <tit ...

  6. C语言基础--for循环

    for循环格式: for (初始化表达式;条件表达式;循环后增量表达式) { 语句; ... } 条件表达式: 和while, dowhile一样, 只有条件满足才会执行循环体 初始化表达式: 在整个 ...

  7. CentOS6.4安装Hadoop2.0.5 alpha - Single Node Cluster

    1.安装JDK7 rpm到/usr/java/jdk1.7.0_40,并建立软链接/usr/java/default到/usr/java/jdk1.7.0_40 [root@server-308 ~] ...

  8. blocked file type by sharepoint 分类: Sharepoint 2015-07-05 07:45 6人阅读 评论(0) 收藏

    o add or remove blocked file types by using Central Administration Verify that you have the followin ...

  9. iOS 注释的5要3不要和编码规范的26个方面

    注释 代码注释,可以说是比代码本身更重要.这里有一些方法可以确保你写在代码中的注释是友好的: 不要重复阅读者已经知道的内容 能明确说明代码是做什么的注释对我们是没有帮助的. // If the col ...

  10. LR手工制作webServices接口类脚本

    首先通过抓包获得某个接口的码流消息,请求报文码分消息头和消息体,所以在制作脚本的时候也需要添加消息头和消息体. POST /jboss-bet/services/&** HTTP/1.1SOA ...