新建 文本文档.txt

来自「FIR引擎最新源码+注册」· 文本 代码 · 共 408 行

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;
    nIPAddr: Integer;
    dLastDate: TDateTime; //最后登陆时间
  end;
  pTIPRecordHeader = ^TIPRecordHeader;

  TRecordDataInfo = packed record //Size
    boDeleted: Boolean;
    dCreateDate: TDateTime;
    nUserQQ: Integer;
    nOwnerUserQQ: Integer;
    dStartDate: TDateTime; //开始时间
    dEndDate: TDateTime; //结束时间
    btMainVersion: Byte; //引擎版本
    nLicCount: Integer; //授权剩余次数
    nLicDays: Integer; //授权剩余天数
    nUserCount: Integer; //用户数
    nIPAddr: Integer;
    DateArray: array[0..60 - 1] of Byte;
  end;
  pTRecordDataInfo = ^TRecordDataInfo;

  TFileDB = 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_QuickList: TQuickList; //0xA4
    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(sChrName: string): Boolean; overload;
    function Delete(nIndex: Integer): Boolean; overload;
  end;
var
  HumDataDB, GMHumDataDB: TFileDB;
implementation

uses Share, HUtil32;

{ TFileDB }

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

destructor TFileDB.Destroy;
begin
  m_QuickList.Free;
  m_DeletedList.Free;
  inherited;
end;

procedure TFileDB.LoadQuickList;
var
  nIndex: Integer;
  DBHeader: TDBHeader;
  RecordHeader: TIPRecordHeader;
begin
  n4 := 0;
  m_QuickList.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 RecordHeader.nIPAddr <> 0 then begin
              m_QuickList.AddObject(MakeIntToIP(RecordHeader.nIPAddr), 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_QuickList.SortString(0, m_QuickList.Count - 1);
  m_nLastIndex := m_Header.nLastIndex;
  m_dUpdateTime := m_Header.dLastDate;
end;

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

function TFileDB.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 TFileDB.Close;
begin
  FileClose(m_nFileHandle);
  if m_boChanged and Assigned(m_OnChange) then begin
    m_OnChange(Self);
  end;
  UnLock();
end;

function TFileDB.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 TFileDB.Index(sName: string): Integer;
begin
  Result := m_QuickList.GetIndex(sName);
end;

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

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

function TFileDB.Add(var IPRecord: TRecordDataInfo): Boolean;
var
  sHumanName: string;
  DBHeader: TDBHeader;
  nIdx: Integer;
begin
  sHumanName := MakeIntToIP(IPRecord.nIPAddr);
  if m_QuickList.GetIndex(sHumanName) >= 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_QuickList.AddRecord(sHumanName, nIdx);
      Result := True;
    end else begin
      m_Header := DBHeader;
      Result := False;
    end;
  end;
end;

function TFileDB.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 TFileDB.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 (ReadRCD.nIPAddr <> 0) 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 TFileDB.Find(sChrName: string;
  List: TStrings): Integer;
var
  i: Integer;
begin
  for i := 0 to m_QuickList.Count - 1 do begin
    if CompareLStr(m_QuickList.Strings[i], sChrName, Length(sChrName)) then begin
      List.AddObject(m_QuickList.Strings[i], m_QuickList.Objects[i]);
    end;
  end;
  Result := List.Count;
end;

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

function TFileDB.DeleteRecord(nIndex: Integer): Boolean;
var
  ChrRecordHeader: TIPRecordHeader;
begin
  Result := False;
  if FileSeek(m_nFileHandle, nIndex * SizeOf(TRecordDataInfo) + SizeOf(TDBHeader), 0) = -1 then Exit;
  m_nLastIndex := nIndex;
  m_dUpdateTime := Now();
  ChrRecordHeader.boDeleted := True;
  FileWrite(m_nFileHandle, ChrRecordHeader, SizeOf(TIPRecordHeader));
  m_DeletedList.Add(Pointer(nIndex));
  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));
  m_boChanged := True;
  Result := True;
end;

procedure TFileDB.Rebuild;
var
  sTempFileName: string;
  nHandle, n10: Integer;
  DBHeader: TDBHeader;
  ChrRecord: TRecordDataInfo;
begin
  sTempFileName := 'Mir#$00.DB';
  if FileExists(sTempFileName) then
    DeleteFile(sTempFileName);
  nHandle := FileCreate(sTempFileName);
  n10 := 0;
  if nHandle < 0 then Exit;
  try
    if Open then begin
      FileSeek(m_nFileHandle, 0, 0);
      if FileRead(m_nFileHandle, DBHeader, SizeOf(TDBHeader)) = SizeOf(TDBHeader) then begin
        FileWrite(nHandle, DBHeader, SizeOf(TDBHeader));
        while (True) do begin
          if FileRead(m_nFileHandle, ChrRecord, SizeOf(TRecordDataInfo)) = SizeOf(TRecordDataInfo) then begin
            if ChrRecord.boDeleted then Continue;
            FileWrite(nHandle, ChrRecord, SizeOf(TRecordDataInfo));
            Inc(n10);
          end else Break;
        end;
        DBHeader.nHumCount := n10;
        DBHeader.dUpdateDate := Now();
        FileSeek(nHandle, 0, 0);
        FileWrite(nHandle, DBHeader, SizeOf(TDBHeader));
      end;
    end;
  finally
    Close;
  end;
  FileClose(nHandle);
  FileCopy(sTempFileName, m_sDBFileName);
  DeleteFile(sTempFileName);
end;

function TFileDB.Count: Integer;
begin
  Result := m_QuickList.Count;
end;

function TFileDB.Delete(sChrName: string): Boolean;
var
  n10: Integer;
begin
  Result := False;
  n10 := m_QuickList.GetIndex(sChrName);
  if n10 < 0 then Exit;
  if DeleteRecord(Integer(m_QuickList.Objects[n10])) then begin
    m_QuickList.Delete(n10);
    Result := True;
  end;
end;

end.