humdb.pas

传奇源代码的delphi版本

unit HumDB;

interface

uses
  Windows, Classes, Dialogs, SysUtils, Forms, MudUtil, Grobal2, ActiveX,
  DB, DBAccess, MSAccess, MemDS, MemData;

const
  SQLDTFORMAT = 'mm"/"dd"/"yyyy hh":"nn":"ss';

resourcestring
  sDBHeaderDesc    = 'Lom II Database file 2005/04/20';
  sDBIdxHeaderDesc = 'Lom II Index file 2005/04/20';

type
  pTDBHeader = ^TDBHeader;
  TDBHeader = record
    sDesc: string[35];       //0x00
    n24:   integer;          //0x24
    n28:   integer;          //0x28
    n2C:   integer;          //0x2C
    n30:   integer;          //0x30
    n34:   integer;          //0x34
    n38:   integer;          //0x38
    n3C:   integer;          //0x3C
    n40:   integer;          //0x40
    n44:   integer;          //0x44
    n48:   integer;          //0x48
    n4C:   integer;          //0x4C
    n50:   integer;          //0x50
    n54:   integer;          //0x54
    n58:   integer;          //0x58
    nLastIndex: integer;     //0x5C
    dLastDate: TDateTime;    //0x60
    nHumCount: integer;      //0x68
    n6C:   integer;          //0x6C
    n70:   integer;          //0x70
    dUpdateDate: TDateTime;  //0x74
  end;

  TIdxHeader = record
    sDesc: string[40];        //0x00
    n2C:   integer;           //0x2C
    n30:   integer;           //0x30
    n34:   integer;           //0x34
    n38:   integer;           //0x38
    n3C:   integer;           //0x3C
    n40:   integer;           //0x40
    n44:   integer;           //0x44
    n48:   integer;           //0x48
    n4C:   integer;           //0x4C
    n50:   integer;           //0x50
    n54:   integer;           //0x54
    n58:   integer;           //0x58
    n5C:   integer;           //0x5C
    n60:   integer;           //0x60
    nQuickCount: integer;     //0x64
    nHumCount: integer;       //0x68
    nDeleteCount: integer;    //0x6C
    nLastIndex: integer;      //0x70
    dUpdateDate: TDateTime;   //0x74
  end;

  pTIdxRecord = ^TIdxRecord;
  TIdxRecord = record
    sChrName: string[15];
    nIndex:   integer;
  end;


  TFileHumDB = class
    m_nCurIndex: integer;      //0x04
    m_nFileHandle: integer;      //0x08
    n0C: integer;      //0x0C
    m_OnChange: TNotifyEvent;

    m_boChanged:   boolean;      //0x18
    m_Header:      TDBHeader;    //0x1C
    m_QuickList:   TQuickList;   //0x98
    m_QuickIDList: TQuickIDList; //0x9C
    m_DeletedList: TList;        //0xA0 已被删除的记录号
    m_sDBFileName: string;       //0xA4
  private
    procedure LoadQuickList;
    procedure Lock;
    procedure UnLock;
    function UpdateRecord(nIndex: integer; HumRecord: THumInfo; boNew: boolean): boolean;
    function DeleteRecord(nIndex: integer): boolean;
    function GetRecord(nIndex: integer; var HumDBRecord: THumInfo): boolean;
  public
    constructor Create(sFileName: string);
    destructor Destroy; override;

    function Open(): boolean;
    function OpenEx(): boolean;
    procedure Close();
    function Index(sName: string): integer;
    function Get(nIndex: integer; var HumDBRecord: THumInfo): integer;
    function GetBy(nIndex: integer; var HumDBRecord: THumInfo): boolean;
    function FindByName(sChrName: string; ChrList: TStringList): integer;
    function FindByAccount(sAccount: string; var ChrList: TStringList): integer;
    function ChrCountOfAccount(sAccount: string): integer;
    function Add(HumRecord: THumInfo): boolean;
    function Delete(sName: string): boolean;
    function Update(nIndex: integer; var HumDBRecord: THumInfo): boolean;
    function UpdateBy(nIndex: integer; var HumDBRecord: THumInfo): boolean;
  end;

  TFileDB = class
    m_OnChange        :TNotifyEvent;       //0x10
    m_boChanged       :Boolean;           //0x18

    m_QuickList       :TQuickList;        //0xA4

    m_sDBFileName     :String;          //0xAC
    m_sIdxFileName    :String;         //0xB0

    nRecordCount      :Integer;
  private
    procedure LoadQuickList;
    function GetRecord(nIndex: integer; var HumanRCD: THumDataInfo): boolean;
    function UpdateRecord(nIndex: integer; var HumanRCD: THumDataInfo; boNew: boolean): boolean;
    function DeleteRecord(nIndex: integer): boolean;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Lock;
    procedure UnLock;
    function Open: boolean;
    procedure Close;
    function Index(sName: string): integer;
    function Get(nIndex: integer; var HumanRCD: THumDataInfo): integer;
    function GetQryChar(nIndex: integer; var QueryChrRcd: TQueryChr): integer;
    function GetUserCurMap(nIndex: integer): String;
    function Update(nIndex: integer; var HumanRCD: THumDataInfo): boolean;
    function Add(var HumanRCD: THumDataInfo): 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;

  function InitializeSQL:Boolean;

var
  ADOConnection     :TMSConnection;
  dbQry             :TMSQuery;
  g_boSQLIsReady    :Boolean = False;

  HumChrDB          :TFileHumDB;
  HumDataDB         :TFileDB;

implementation

uses
  DBShare, HUtil32;

function InitializeSQL:Boolean;
begin
  Result := False;
  if g_boSQLIsReady then exit;

  ADOConnection.Database := g_sSQLDatabase;
  ADOConnection.Server := g_sSQLHost;
  ADOConnection.UserName := g_sSQLUserName;
  ADOConnection.Password := g_sSQLPassword;

  ADOConnection.LoginPrompt := False;

  dbQry.Connection := ADOConnection;

  try
    ADOConnection.Connect;
    g_boSQLIsReady := True;
  except
    OutMainMessage('[警告] SQL连接失败! => 请详细检查!');
    Result := False;
    Exit;
  end;

  Result := True;
end;

{ TFileHumDB }

constructor TFileHumDB.Create(sFileName: string);//0x0048B73C
begin
  m_sDBFileName := sFileName;
  m_QuickList  := TQuickList.Create;
  m_QuickIDList := TQuickIDList.Create;
  m_DeletedList := TList.Create;
  n4ADAFC      := 0;
  n4ADB04      := 0;
  boHumDBReady := False;
  LoadQuickList();
end;

destructor TFileHumDB.Destroy;
begin
  m_QuickList.Free;
  m_QuickIDList.Free;
  inherited;
end;

procedure TFileHumDB.Lock();//0x0048B870
begin
  EnterCriticalSection(HumDB_CS);
end;

procedure TFileHumDB.UnLock();//0x0048B888
begin
  LeaveCriticalSection(HumDB_CS);
end;

procedure TFileHumDB.LoadQuickList();
//0x48BA64
var
  nRecordIndex: integer;
  nIndex:      integer;
  AccountList: TStringList;
  ChrNameList: TStringList;
  DBHeader:    TDBHeader;
  DBRecord:    THumInfo;
begin
  m_nCurIndex := 0;
  m_QuickList.Clear;
  m_QuickIDList.Clear;
  m_DeletedList.Clear;
  nRecordIndex := 0;
  n4ADAFC      := 0;
  n4ADB00      := 0;
  n4ADB04      := 0;
  AccountList  := TStringList.Create;
  ChrNameList  := TStringList.Create;
  try
    if Open then begin
      FileSeek(m_nFileHandle, 0, 0);
      if FileRead(m_nFileHandle, DBHeader, SizeOf(TDBHeader)) = SizeOf(TDBHeader) then
      begin
        n4ADB04 := DBHeader.nHumCount;
        for nIndex := 0 to DBHeader.nHumCount - 1 do begin
          Inc(n4ADAFC);
          if FileRead(m_nFileHandle, DBRecord, SizeOf(THumInfo)) <> SizeOf(THumInfo) then
          begin
            break;
          end;
          if not DBRecord.Header.boDeleted then begin
            m_QuickList.AddObject(DBRecord.Header.sChrName, TObject(nRecordIndex));
            AccountList.AddObject(DBRecord.sAccount, TObject(DBRecord.Header.nSelectID));
            ChrNameList.AddObject(DBRecord.sChrName, TObject(nRecordIndex));
            Inc(n4ADB00);
          end else begin //0x0048BC04
            m_DeletedList.Add(TObject(nIndex));
          end;
          Inc(nRecordIndex);
          Application.ProcessMessages;
          if Application.Terminated then begin
            Close;
            exit;
          end;
        end;
      end; //0x0048BC52
    end;
  finally
    Close();
  end;
  for nIndex := 0 to AccountList.Count - 1 do begin
    m_QuickIDList.AddRecord(AccountList.Strings[nIndex],
      ChrNameList.Strings[nIndex],
      integer(ChrNameList.Objects[nIndex]),
      integer(AccountList.Objects[nIndex]));
    if (nIndex mod 100) = 0 then Application.ProcessMessages;
  end;
  //0x0048BCF4
  AccountList.Free;
  ChrNameList.Free;
  m_QuickList.SortString(0, m_QuickList.Count - 1);
  boHumDBReady := True;
end;

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

function TFileHumDB.Open: boolean;//0x0048B928
begin
  Lock();
  m_nCurIndex := 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 //0x0048B999
    m_nFileHandle := FileCreate(m_sDBFileName);
    if m_nFileHandle > 0 then begin
      FillChar(m_Header, SizeOf(TDBHeader), #0);
      m_Header.sDesc := sDBHeaderDesc;
      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;

function TFileHumDB.OpenEx: boolean;//0x0048B8A0
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;
    m_nCurIndex := 0;
  end else
    Result := False;
end;

function TFileHumDB.Index(sName: string): integer;//0x0048C384
begin
  Result := m_QuickList.GetIndex(sName);
end;

function TFileHumDB.Get(nIndex: integer; var HumDBRecord: THumInfo): integer;//0x0048C0CC
var
  nResult: integer;
begin
  nResult := integer(m_QuickList.Objects[nIndex]);
  if GetRecord(nIndex, HumDBRecord) then Result := nResult
  else
    Result := -1;
end;

function TFileHumDB.GetRecord(nIndex: integer; var HumDBRecord: THumInfo): boolean;
  //0x0048BEEC
begin
  if FileSeek(m_nFileHandle, SizeOf(THumInfo) * nIndex + SizeOf(TDBHeader), 0) <> -1 then
  begin
    FileRead(m_nFileHandle, HumDBRecord, SizeOf(THumInfo));
    FileSeek(m_nFileHandle, -SizeOf(THumInfo) * nIndex + SizeOf(TDBHeader), 1);
    m_nCurIndex := nIndex;
    Result      := True;
  end else
    Result := False;
end;

function TFileHumDB.FindByName(sChrName: string; ChrList: TStringList): integer;
  //0x0048C3E0
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
      ChrList.AddObject(m_QuickList.Strings[I], m_QuickList.Objects[I]);
    end;
  end;
  Result := ChrList.Count;
end;

function TFileHumDB.GetBy(nIndex: integer; var HumDBRecord: THumInfo): boolean;
  //0x0048C118
begin
  if nIndex >= 0 then Result := GetRecord(nIndex, HumDBRecord)
  else