humdb.pas

来自「FIR引擎最新源码+注册」· PAS 代码 · 共 794 行 · 第 1/2 页

unit HumDB;

interface
uses
  Windows, Classes, SysUtils, Forms, MudUtil;
type
  TDBHeader = packed record
    nLastIndex: Integer;
    dLastDate: TDateTime;
    nHumCount: Integer;
    n6C: Integer;
    n70: Integer;
    dUpdateDate: TDateTime;
  end;
  pTDBHeader = ^TDBHeader;

  TIPRecordHeader = packed record //Size
    boDeleted: Boolean;
    nUserQQ: Integer;
    sAccount: string[32];
    sUserIPaddr: string[15];
    dLastDate: TDateTime; //最后登陆时间
  end;
  pTIPRecordHeader = ^TIPRecordHeader;

  TRecordDataInfo = packed record //Size
    IPHeader: TIPRecordHeader;
    sAccount: string[32];
    sPassword: string[32];
    sSerialNumber: string[32];
    sUserIPaddr: string[15];
    boDeleted: Boolean;
    dCreateDate: TDateTime;
    nUserQQ: Integer;
    btPermission: Byte; //权限
    nOwnerUserQQ: Integer;
    btBind: Byte; //1=绑定机器 2=绑定IP
    btMode: Byte;
    btSoftType: Byte;
    dStartDate: TDateTime; //开始时间
    dEndDate: TDateTime; //结束时间
    nMainVersion: Integer; //引擎版本
    nLicCount: Integer; //授权剩余次数
    nLicDays: Integer; //授权剩余天数
    nUserCount: Integer; //用户数

    DateArray: array[0..60 - 1] of Byte;
  end;
  pTRecordDataInfo = ^TRecordDataInfo;

  TFileHumDB = class
    n4: Integer; //0x4
    m_nFileHandle: Integer; //0x08
    nC: Integer;
    m_OnChange: TNotifyEvent; //0x10
    m_boChanged: Boolean; //0x18
    m_nLastIndex: Integer; //0x1C
    m_dUpdateTime: TDateTime; //0x20
    m_Header: TDBHeader; //0x28
    m_QuickIPList: TQuickList;
    m_DeletedList: TList; //已被删除的记录号
    m_sDBFileName: string;
  private
    procedure LoadQuickList;
    function GetRecord(nIndex: Integer; var IPRecord: TRecordDataInfo): Boolean;
    function UpdateRecord(nIndex: Integer; var IPRecord: TRecordDataInfo; boNew: Boolean): Boolean;
    function DeleteRecord(nIndex: Integer): Boolean;
  public
    constructor Create(sFileName: string);
    destructor Destroy; override;
    procedure Lock;
    procedure UnLock;
    function Open(): Boolean;
    function OpenEx(): Boolean;
    procedure Close();
    function Index(sName: string): Integer;
    function Get(nIndex: Integer; var IPRecord: TRecordDataInfo): Integer;
    function Update(nIndex: Integer; var IPRecord: TRecordDataInfo): Boolean;
    function Add(var IPRecord: TRecordDataInfo): Boolean;
    function Find(sChrName: string; List: TStrings): Integer;

    procedure Rebuild();
    function Count(): Integer;
    function Delete(sName: string): Boolean; overload;
    function Delete(nIndex: Integer): Boolean; overload;
  end;

  TFileGMHumDB = class
    n4: Integer; //0x4
    m_nFileHandle: Integer; //0x08
    nC: Integer;
    m_OnChange: TNotifyEvent; //0x10
    m_boChanged: Boolean; //0x18
    m_nLastIndex: Integer; //0x1C
    m_dUpdateTime: TDateTime; //0x20
    m_Header: TDBHeader; //0x28
    m_QuickIDList: TQuickList;
    m_DeletedList: TList; //已被删除的记录号
    m_sDBFileName: string;
  private
    procedure LoadQuickList;
    function GetRecord(nIndex: Integer; var IPRecord: TRecordDataInfo): Boolean;
    function UpdateRecord(nIndex: Integer; var IPRecord: TRecordDataInfo; boNew: Boolean): Boolean;
    function DeleteRecord(nIndex: Integer): Boolean;
  public
    constructor Create(sFileName: string);
    destructor Destroy; override;
    procedure Lock;
    procedure UnLock;
    function Open(): Boolean;
    function OpenEx(): Boolean;
    procedure Close();
    function Index(sName: string): Integer;
    function Get(nIndex: Integer; var IPRecord: TRecordDataInfo): Integer;
    function Update(nIndex: Integer; var IPRecord: TRecordDataInfo): Boolean;
    function Add(var IPRecord: TRecordDataInfo): Boolean;
    function Find(sChrName: string; List: TStrings): Integer;

    procedure Rebuild();
    function Count(): Integer;
    function Delete(sName: string): Boolean; overload;
    function Delete(nIndex: Integer): Boolean; overload;
  end;

var
  HumDataDB: TFileHumDB;
  GMHumDataDB: TFileGMHumDB;
implementation

uses Share, HUtil32;

{ TFileHumDB }

constructor TFileHumDB.Create(sFileName: string);
begin
  n4 := 0;
  n4ADAE4 := 0;
  n4ADAE8 := 0;
  n4ADAF0 := 0;
  m_sDBFileName := sFileName;
  m_QuickIPList := TQuickList.Create;
  m_DeletedList := TList.Create;
  m_nLastIndex := -1;
  LoadQuickList();
end;

destructor TFileHumDB.Destroy;
begin
  m_QuickIPList.Free;
  m_DeletedList.Free;
  inherited;
end;

procedure TFileHumDB.LoadQuickList;
var
  nIndex: Integer;
  DBHeader: TDBHeader;
  RecordHeader: TIPRecordHeader;
begin
  n4 := 0;
  m_QuickIPList.Clear;
  m_DeletedList.Clear;
  n4ADAE4 := 0;
  n4ADAE8 := 0;
  n4ADAF0 := 0;
  try
    if Open then begin
      FileSeek(m_nFileHandle, 0, 0);
      if FileRead(m_nFileHandle, DBHeader, SizeOf(TDBHeader)) = SizeOf(TDBHeader) then begin
        n4ADAF0 := DBHeader.nHumCount;
        for nIndex := 0 to DBHeader.nHumCount - 1 do begin
          Inc(n4ADAE4);
          if FileSeek(m_nFileHandle, nIndex * SizeOf(TRecordDataInfo) + SizeOf(TDBHeader), 0) = -1 then Break;
          if FileRead(m_nFileHandle, RecordHeader, SizeOf(TIPRecordHeader)) <> SizeOf(TIPRecordHeader) then Break;
          if not RecordHeader.boDeleted then begin
            if IsIpAddr(RecordHeader.sUserIPaddr) then begin
              m_QuickIPList.AddObject(RecordHeader.sUserIPaddr, TObject(nIndex));
              Inc(n4ADAE8);
            end else m_DeletedList.Add(TObject(nIndex));
          end else begin
            m_DeletedList.Add(TObject(nIndex));
            Inc(n4ADAEC);
          end;
          Application.ProcessMessages;
          if Application.Terminated then begin
            Close;
            Exit;
          end;
        end;
      end;
    end;
  finally
    Close();
  end;
  m_QuickIPList.SortString(0, m_QuickIPList.Count - 1);
  m_nLastIndex := m_Header.nLastIndex;
  m_dUpdateTime := m_Header.dLastDate;
end;

procedure TFileHumDB.Lock;
begin
  EnterCriticalSection(HumDB_CS);
end;
procedure TFileHumDB.UnLock;
begin
  LeaveCriticalSection(HumDB_CS);
end;

function TFileHumDB.Open: Boolean;
begin
  Lock();
  n4 := 0;
  m_boChanged := False;
  if FileExists(m_sDBFileName) then begin
    m_nFileHandle := FileOpen(m_sDBFileName, fmOpenReadWrite or fmShareDenyNone);
    if m_nFileHandle > 0 then
      FileRead(m_nFileHandle, m_Header, SizeOf(TDBHeader));
  end else begin
    m_nFileHandle := FileCreate(m_sDBFileName);
    if m_nFileHandle > 0 then begin
      m_Header.nHumCount := 0;
      m_Header.n6C := 0;
      FileWrite(m_nFileHandle, m_Header, SizeOf(TDBHeader));
    end;
  end;
  if m_nFileHandle > 0 then Result := True
  else Result := False;
end;

procedure TFileHumDB.Close;
begin
  FileClose(m_nFileHandle);
  if m_boChanged and Assigned(m_OnChange) then begin
    m_OnChange(Self);
  end;
  UnLock();
end;

function TFileHumDB.OpenEx: Boolean;
var
  DBHeader: TDBHeader;
begin
  Lock();
  m_boChanged := False;
  m_nFileHandle := FileOpen(m_sDBFileName, fmOpenReadWrite or fmShareDenyNone);
  if m_nFileHandle > 0 then begin
    Result := True;
    if FileRead(m_nFileHandle, DBHeader, SizeOf(TDBHeader)) = SizeOf(TDBHeader) then
      m_Header := DBHeader;
    n4 := 0;
  end else Result := False;
end;

function TFileHumDB.Index(sName: string): Integer;
begin
  Result := m_QuickIPList.GetIndex(sName);
end;

function TFileHumDB.Get(nIndex: Integer; var IPRecord: TRecordDataInfo): Integer;
var
  nIdx: Integer;
begin
  nIdx := Integer(m_QuickIPList.Objects[nIndex]);
  if GetRecord(nIdx, IPRecord) then Result := nIdx
  else Result := -1;
end;

function TFileHumDB.Update(nIndex: Integer;
  var IPRecord: TRecordDataInfo): Boolean;
begin
  Result := False;
  if (nIndex >= 0) and (m_QuickIPList.Count > nIndex) then
    if UpdateRecord(Integer(m_QuickIPList.Objects[nIndex]), IPRecord, False) then Result := True;
end;

function TFileHumDB.Add(var IPRecord: TRecordDataInfo): Boolean;
var
  sName: string;
  DBHeader: TDBHeader;
  nIdx: Integer;
begin
  sName := IPRecord.sUserIPaddr;
  if m_QuickIPList.GetIndex(sName) >= 0 then begin
    Result := False;
  end else begin
    DBHeader := m_Header;
    if m_DeletedList.Count > 0 then begin
      nIdx := Integer(m_DeletedList.Items[0]);
      m_DeletedList.Delete(0);
    end else begin
      nIdx := m_Header.nHumCount;
      Inc(m_Header.nHumCount);
    end;
    if UpdateRecord(nIdx, IPRecord, True) then begin
      m_QuickIPList.AddRecord(sName, nIdx);
      Result := True;
    end else begin
      m_Header := DBHeader;
      Result := False;
    end;
  end;
end;

function TFileHumDB.GetRecord(nIndex: Integer;
  var IPRecord: TRecordDataInfo): Boolean;
begin
  if FileSeek(m_nFileHandle, nIndex * SizeOf(TRecordDataInfo) + SizeOf(TDBHeader), 0) <> -1 then begin
    FileRead(m_nFileHandle, IPRecord, SizeOf(TRecordDataInfo));
    FileSeek(m_nFileHandle, -SizeOf(TRecordDataInfo), 1);
    n4 := nIndex;
    Result := True;
  end else Result := False;
end;

function TFileHumDB.UpdateRecord(nIndex: Integer;
  var IPRecord: TRecordDataInfo; boNew: Boolean): Boolean;
var
  nPosion, n10: Integer;
  dt20: TDateTime;
  ReadRCD: TRecordDataInfo;
begin
  nPosion := nIndex * SizeOf(TRecordDataInfo) + SizeOf(TDBHeader);
  if FileSeek(m_nFileHandle, nPosion, 0) = nPosion then begin
    dt20 := Now();
    m_nLastIndex := nIndex;
    m_dUpdateTime := dt20;
    n10 := FileSeek(m_nFileHandle, 0, 1);
    if boNew
      and (FileRead(m_nFileHandle, ReadRCD, SizeOf(TRecordDataInfo)) = SizeOf(TRecordDataInfo))
      and not ReadRCD.boDeleted and IsIpAddr(ReadRCD.sUserIPaddr) then begin
      Result := False;
    end else begin
      IPRecord.boDeleted := False;
      IPRecord.dCreateDate := Now();
      m_Header.nLastIndex := m_nLastIndex;
      m_Header.dLastDate := m_dUpdateTime;
      m_Header.dUpdateDate := Now();
      FileSeek(m_nFileHandle, 0, 0);
      FileWrite(m_nFileHandle, m_Header, SizeOf(TDBHeader));
      FileSeek(m_nFileHandle, n10, 0);
      FileWrite(m_nFileHandle, IPRecord, SizeOf(TRecordDataInfo));
      FileSeek(m_nFileHandle, -SizeOf(TRecordDataInfo), 1);
      n4 := nIndex;
      m_boChanged := True;
      Result := True;
    end;
  end else Result := False;
end;

function TFileHumDB.Find(sChrName: string;
  List: TStrings): Integer;
var
  I: Integer;
begin
  {for I := 0 to m_QuickIPList.Count - 1 do begin
    if CompareLStr(m_QuickIDList.Strings[I], sChrName, Length(sChrName)) then begin
      List.AddObject(m_QuickIDList.Strings[I], m_QuickIDList.Objects[I]);
    end;
  end;
  Result := List.Count;}
end;

function TFileHumDB.Delete(nIndex: Integer): Boolean;
var
  I: Integer;
begin
  Result := False;
  for I := 0 to m_QuickIPList.Count - 1 do begin
    if Integer(m_QuickIPList.Objects[I]) = nIndex then begin
      if DeleteRecord(nIndex) then begin
        m_QuickIPList.Delete(I);
        Result := True;
        Break;
      end;
    end;
  end;
end;

function TFileHumDB.Delete(sName: string): Boolean;
var
  I: Integer;
  nIndex: Integer;
begin
  Result := False;
  for I := 0 to m_QuickIPList.Count - 1 do begin
    if m_QuickIPList.Strings[I] = sName then begin
      nIndex := Integer(m_QuickIPList.Objects[I]);
      if DeleteRecord(nIndex) then begin
        m_QuickIPList.Delete(I);
        Result := True;
        Break;
      end;
    end;
  end;
end;

function TFileHumDB.DeleteRecord(nIndex: Integer): Boolean;