Delphi · 2026年1月21日

多线程安全缓存对象(引入计数器管理对象生命周期)

现代处理器均支持多线程操作，在程序运行中的并发请求，经常会消耗大量的数据库资源，而我们都直到数据库资源是很宝贵的，所以会将经常访问的资源做成缓存来减少数据库的访问；比如使用Redis等，但网络延迟等原因会造成并发堵塞；对于数据量小但访问量高的数据Redis并不是最优解； 内存表(TFDmemtable/TClientDataSet)效率高，但是操作并不是太方便；那只能自己写一个咯~

代码实现了一个线程安全的用户信息管理模块，核心目标是通过接口（IUser）自动管理用户对象（TUser）的生命周期，同时利用读写锁(TMREWSync)保证多线程场景下的并发安全(多读少写的应用场景效率很高)，支持用户的添加、删除、查询、更新和 JSON 枚举等操作。关于数据库的部分，因为各个系统的特色自行添加即可~

unit uManager_User;

interface

uses
  System.SysUtils, System.Generics.Collections, System.Rtti, qjson ;

type
  ///  <summary> 用户参数 </summary>
  TUserParams = Record
    key : string;    //必须且固定的字段
    name: string;
    age: Integer;
    // 初始化空记录
    procedure InitEmpty;
  End;

  ///  --------所有操作通过 IUser 接口或 TUserManager 方法完成---------
  ///  <summary> 用户接口（核心：引用计数管理生命周期） </summary>
  IUser = interface
    ['{5E8A1B2C-3D4E-5F6A-7B8C-9D0E1F2A3B4C}']
    function GetKey: string;
    function GetName: string;
    function GetAge: Integer;
    // 暴露参数记录（方便外部获取完整数据）
    function GetParams: TUserParams;
    procedure UpdateInfo(AParams: TUserParams);

    property key: string read GetKey;
    property name: string read GetName;
    property age: Integer read GetAge;
  end;

  ///  <summary> 用户对象（实现接口，自动引用计数） </summary>
  ///  <summary> TUser 由 IUser进行自动管理，不可引用或手动释放(free) </summary>
  TUser = class(TInterfacedObject, IUser)
  private
    FUserRecord : TUserParams;
    function GetKey: string;
    function GetName: string;
    function GetAge: Integer;
  public
    constructor Create(AParams:TUserParams);
    function GetParams: TUserParams;
    procedure UpdateInfo(AParams:TUserParams);
  end;

  ///  <summary> 用户管理对象 </summary>
  TUserManager = class(TObject)
  private
    ///  <summary>  泛型字典类（引用计数管理,不需要手动释放对象）</summary>
    FDict: TDictionary<string, IUser>;
    ///  <summary>  读写锁同步对象; </summary>
    ///  <summary>  适用于读多写少的场景；可支持高并发读取; </summary>
    FMREW: TMREWSync;
  public
    ///  <summary>  管理对象创建  </summary>
    constructor Create;

    ///  <summary>  管理对象释放(重载)  </summary>
    destructor Destroy; override;

    ///  <summary>  对象引用清空(不释放对象)  </summary>
    ///  <returns> 无 </returns>
    procedure Clear;

    ///  <summary> 获取对象数量  </summary>
    ///  <returns> Integer - 返回对象数量 </returns>
    function Count: Integer;

    ///  <summary>  添加对象  </summary>
    ///  <param name="AParams"> 对象参数 </param>
    ///  <returns> 无 </returns>
    procedure AddUser(AParams : TUserParams);

    ///  <summary>  移除对象  </summary>
    /// <param name="AKey"> 主键值 </param>
    ///  <returns> Boolean - True：成功  False：失败 </returns>
    function RemoveUser(AKey: string): Boolean;

    ///  <summary>  获取对象 - 根据主键值  </summary>
    ///  <param name="AKey"> 主键值 </param>
    ///  <returns> IUser - 对象(接口) 外部访问安全(自动管理生命周期) </returns>
    function GetUser(AKey: string): IUser;

    ///  <summary>  获取对象 - 根据索引号  </summary>
    /// <param name="AIndex"> 索引号 </param>
    ///  <returns> IUser - 对象(接口) 外部访问安全(自动管理生命周期) </returns>
    function GetUserByIndex(AIndex : integer): IUser;

    ///  <summary>  枚举对象  </summary>
    ///  <returns> string - Json字符串（数组） </returns>
    function EnumerateUsers:string;
  end;

implementation

{ TUserParams }
procedure TUserParams.InitEmpty;
begin
  key := '';
  name := '';
  age := 0;
end;

{ TUser }
constructor TUser.Create(AParams:TUserParams);
begin
  inherited Create;
  FUserRecord := AParams;
end;

function TUser.GetKey: string;
begin
  Result := FUserRecord.key;
end;

function TUser.GetName: string;
begin
  Result := FUserRecord.name;
end;

function TUser.GetAge: Integer;
begin
  Result := FUserRecord.age;
end;

function TUser.GetParams: TUserParams;
begin
  Result := FUserRecord;
end;

procedure TUser.UpdateInfo(AParams: TUserParams);
begin
  if (AParams.key = '') or (FUserRecord.key <> AParams.key) then Exit;
  FUserRecord.name := AParams.name;
  FUserRecord.age := AParams.age;
end;

{ TUserManager }
constructor TUserManager.Create;
begin
  inherited;
  FMREW := TMREWSync.Create;
  // 改为普通字典，不再托管值的释放（由接口引用计数管理）
  FDict := TDictionary<string, IUser>.Create;
end;

destructor TUserManager.Destroy;
begin
  //字典释放仅移除接口引用，对象由引用计数自动销毁
  FreeAndNil(FDict);
  FreeAndNil(FMREW);
  inherited;
end;

procedure TUserManager.Clear;
begin
  FMREW.BeginWrite;
  try
    // 移除所有接口引用，无引用的对象会自动销毁
    FDict.Clear;
  finally
    FMREW.EndWrite;
  end;
end;

function TUserManager.Count: Integer;
begin
  FMREW.BeginRead;
  try
    Result := FDict.Count;
  finally
    FMREW.EndRead;
  end;
end;

procedure TUserManager.AddUser(AParams : TUserParams);
var
  _User: IUser;
begin
  if AParams.key = '' then Exit;
  FMREW.BeginWrite;
  try
    if FDict.TryGetValue(AParams.key, _User) then
    begin
      _User.UpdateInfo(AParams); // 存在则更新
    end
    else
    begin
      _User := TUser.Create(AParams); // 接口自动管理引用计数
      FDict.Add(AParams.key, _User);
    end;
  finally
    FMREW.EndWrite;
  end;
end;

function TUserManager.RemoveUser(AKey: string): Boolean;
var
  _IUser : IUser;
begin
  Result := False;
  if AKey = '' then Exit;
  FMREW.BeginWrite;
  try
    if FDict.TryGetValue(AKey, _IUser) then
    begin
      // 仅移除字典中的接口引用，对象是否销毁由外部引用数决定
      FDict.Remove(AKey);
      Result := True;
    end
    else
    begin
      //不存在直接返回成功
      Result := True;
    end;
  finally
    FMREW.EndWrite;
  end;
end;

function TUserManager.GetUser(AKey: string): IUser;
begin
  Result := nil;
  if AKey = '' then Exit;
  FMREW.BeginRead;
  try
    // 返回对象接口，引用计数+1
    FDict.TryGetValue(AKey, Result);
  finally
    FMREW.EndRead;
  end;
end;

function TUserManager.GetUserByIndex(AIndex: integer): IUser;
var
  _Pair: TPair<string, IUser>;
  _iIndex : integer;
begin
  Result := nil;
  if AIndex < 0 then Exit;
  FMREW.BeginRead;
  try
    if AIndex >= FDict.Count then Exit;
    _iIndex := 0;
    for _Pair in FDict do
    begin
      if _iIndex = AIndex then
      begin
        // 返回对象接口，引用计数+1
        Result := _Pair.Value;
        Break;
      end;
      inc(_iIndex);
    end;
  finally
    FMREW.EndRead;
  end;
end;

function TUserManager.EnumerateUsers: string;
var
  _Pair: TPair<string, IUser>;
  _QJson, _ItemJson: TQJson;
begin
  Result := '[]'; // 默认返回空JSON数组
  _QJson := TQJson.Create;
  try
    _QJson.DataType := jdtArray;
    FMREW.BeginRead;
    try
      for _Pair in FDict do
      begin
        _ItemJson := TQJson.Create;
        _ItemJson.FromRecord(_Pair.Value.GetParams); // 序列化接口指向的对象
        _QJson.add(_ItemJson);
      end;
      Result := _QJson.AsString;
    finally
      FMREW.EndRead;
    end;
  finally
    if Assigned(_QJson) then FreeAndNil(_QJson);
  end;
end;

end.
Pascal

使用方法如下：

uses
  uManager_User;	
	
	
var
  FUserManager : TUserManager;	
  _UserParams : TUserParams ;
  _IUser : IUser;
begin
  FUserManager := TUserManager.Create;
  try
    try
      //添加	
      _UserParams.key  := '20';
      _UserParams.Name := 'test';
      _UserParams.Age  := 34;
      FUserManager.AddUser(_UserParams);
	  
	    //读取
      _IUser := FUserManager.GetUser('20');
	    if Assigned(_IUser) then
	    begin
	      _IUser.key;
		    _IUser.Name;
		    _IUser.Age;
	    end;
	  
	    //移除
	    FUserManager.RemoveUser('20');
	  
	    //清空
	    FUserManager.Clear;
	  
	  except
	    on E: Exception do
	    begin
	    //记录日志  
	    end
	  end
  finally		
    if Assigned(FUserManager) then FreeAndNil(FUserManager);
  end;
end;
Pascal

多线程测试：

//写入线程
  TThread.CreateAnonymousThread(
    procedure
    var
      I : integer;
      F : TProc<integer>;
    begin
      Randomize;
      For I := 1 to 1500 do
      begin
        F := procedure(i:integer)
        begin
          TTask.Run(
          procedure
          var
            J : integer;
            _UserParams : TUserParams;
          begin
            J := Random(20);
            sleep(J * 100);
            _UserParams.key  := inttostr(J);
            _UserParams.Name := 'test' + inttostr(I);
            _UserParams.Age  := I;
            FUserManager.AddUser(_UserParams);
            TInterlocked.Increment(iCount_Complete);
          end);
        end;
        F(i);
      end;
      iCount_All := iCount_All + I - 1;
    end).Start;

  //读取线程
  TThread.CreateAnonymousThread(
    procedure
    var
      I : integer;
      F : TProc<integer>;
    begin
      Randomize;
      For I := 1 to 20000 do
      begin
        F := procedure(i:integer)
        begin
          TTask.Run(
          procedure
          var
            J : integer;
            _IUser : IUser;
          begin
            J := Random(20);
            sleep(J);
            _IUser := FUserManager.GetUser(inttostr(J));
            if assigned(_IUser) then
            begin
              _IUser.key;
              _IUser.name;
              _IUser.age;
            end;
            TInterlocked.Increment(iCount_Complete);
          end);
        end;
        F(i);
      end;
      iCount_All := iCount_All + I - 1;
    end).Start;


  //删除线程
  TThread.CreateAnonymousThread(
    procedure
    var
      I : integer;
      F : TProc<integer>;
    begin
      Randomize;
      For I := 1 to 1000 do
      begin
        F := procedure(i:integer)
        begin
          TTask.Run(
          procedure
          var
            J : integer;
          begin
            J := Random(20);
            sleep(J);
            FUserManager.RemoveUser(inttostr(J));
            TInterlocked.Increment(iCount_Complete);
          end);
        end;
        F(i);
      end;
      iCount_All := iCount_All + I - 1;
    end).Start;
Pascal

以上代码在开始执行时，因为有新增和删除，存在写入锁读取执行较慢~ 后面无新增和删除时，读取速度就起来了~ 并且无内存泄漏；如果有更好的方法，请联系我~ 342667266@qq.com

您可能还喜欢...