⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 ubattledb.pas

📁 千年源代码,只缺少控件,可以做二次开发用,好不容易得来的
💻 PAS
📖 第 1 页 / 共 2 页
字号:
unit uBattleDB;

interface

uses
  Windows, SysUtils, Classes, UserSDB, AUtil32, Math, uKeyClass, Common,
  BSCommon, uBDKeyClass, uUserData;

type
   TBattleGroup = record
      Index : Integer;
      Title : String [64];
      StartAge : Integer;
      EndAge : Integer;
      PointKey : TUserDataKeyClass;
   end;
   PTBattleGroup = ^TBattleGroup;

   TBattleDB = class
   private
      DataList : TList;
      GroupList : TList;

      NameKey : TStringKeyClass;
      // PointKey : TUserDataKeyClass;

      function CalPoint (difference : integer; Age : Word; Point : integer; WinFlag : Byte) : integer;
      procedure InsertUserData (aUserData : TUserData; boFlag : Boolean);
      function GetBattleGroupKey (aAge : Integer) : TUserDataKeyClass;
   public
      Constructor Create;
      Destructor Destroy; override;

      procedure Clear;

      procedure AddGroup (aTitle : String; aStart : Integer; aEnd : Integer);
      procedure LoadFromFile (aFileName : String);
      procedure SaveToSDB (aFileName : String);

      function GetRankData (aCharInfo : PTGetRankData; aRankData : PTSendRankData) : Boolean;
      function GetRankPart (aAge, aStart, aEnd : Integer; aRankPart : PTSendRankPart) : Boolean;
      function UpdateRank (aBattleData : PTBattleResultData) : Boolean;

      procedure DisplayCurrentScore;
      procedure Test;
  end;

var
   BattleDB : TBattleDB = nil;

implementation

uses
   FMain, uServerList, uBattleTable;

Constructor TBattleDB.Create;
begin
   GroupList := TList.Create;
   NameKey := TStringKeyClass.Create;
   // PointKey := TUserDataKeyClass.Create;
   DataList := TList.Create;
end;

Destructor TBattleDB.Destroy;
var
   i : Integer;
   pd : PTBattleGroup;
begin
   SaveToSDB (BattleDBFile);

   Clear;
   NameKey.Free;
   // PointKey.Free;
   DataList.Free;

   for i := 0 to GroupList.Count - 1 do begin
      pd := GroupList.Items [i];
      pd^.PointKey.Free;
      Dispose (pd);
   end;
   GroupList.Free;

   inherited Destroy;
end;

procedure TBattleDB.InsertUserData (aUserData : TUserData; boFlag : Boolean);
var
   i : Integer;
   pd : PTBattleGroup;
begin
   for i := 0 to GroupList.Count - 1 do begin
      pd := GroupList.Items [i];
      if (aUserData.Age >= pd^.StartAge) and (aUserData.Age <= pd^.EndAge) then begin
         pd^.PointKey.Insert (aUserData);
         if boFlag = true then pd^.PointKey.SetGrade;
         exit;
      end;
   end;
end;

procedure TBattleDB.Clear;
var
   i : Integer;
   UserData : TUserData;
   pd : PTBattleGroup;
begin
   for i := 0 to GroupList.Count - 1 do begin
      pd := GroupList.Items [i];
      pd^.PointKey.Clear;
   end;
   for i := 0 to DataList.Count - 1 do begin
      UserData := DataList.Items [i];
      UserData.Free;
   end;

   DataList.Clear;
   // PointKey.Clear;
   NameKey.Clear;
end;

procedure TBattleDB.DisplayCurrentScore;
var
   i, j : Integer;
   UserData : TUserData;
   Str : String;
   PointKey : TUserDataKeyClass;
   pd : PTBattleGroup;
begin
   for i := 0 to GroupList.Count - 1 do begin
      pd := GroupList.Items [i];
      PointKey := pd^.PointKey;

      frmMain.ClearResult (pd^.StartAge);

      for j := 0 to PointKey.Count - 1 do begin
         UserData := PointKey.Select (j);
         if UserData <> nil then begin
            Str := format ('%d %s %d %d', [UserData.Grade, UserData.Name, UserData.Point, UserData.Age]);
            frmMain.AddResult (UserData.Age, Str);
         end;
      end;
   end;
end;

procedure TBattleDB.AddGroup (aTitle : String; aStart : Integer; aEnd : Integer);
var
   pd : PTBattleGroup;
begin
   New (pd);
   pd^.Index := GroupList.Count;
   pd^.Title := aTitle;
   pd^.StartAge := aStart;
   pd^.EndAge := aEnd;
   pd^.PointKey := TUserDataKeyClass.Create;

   GroupList.Add (pd);
end;

procedure TBattleDB.LoadFromFile (aFileName : String);
var
   i : Integer;
   iName, KeyName : String;
   DB : TUserStringDB;
   UserData : TUserData;
   pd : PTBattleGroup;
   Str : string;
begin
   if not FileExists (aFileName) then exit;

   DB := TUserStringDB.Create;
   DB.LoadFromFile (aFileName);
   for i := 0 to DB.Count - 1 do begin
      iName := DB.GetIndexName (i);
      if iName = '' then continue;

      UserData := TUserData.Create;
      UserData.LoadFromSDB (i, DB);

      NameKey.Insert (UserData.Name, UserData);

      InsertUserData (UserData, false);

      DataList.Add (UserData);
   end;
   DB.Free;

   for i := 0 to GroupList.Count - 1 do begin
      pd := GroupList.Items [i];
      pd^.PointKey.SetGrade;
   end;

   DisplayCurrentScore;
end;

procedure TBattleDB.SaveToSDB (aFileName : String);
var
   i : Integer;
   Stream : TFileStream;
   UserData : TUserData;
   Str, iName : String;
   buffer : array [0..4096 - 1] of Char;
   sex : string;
begin
   if FileExists (aFileName) then DeleteFile (aFileName);

   Stream := TFileStream.Create (aFileName, fmCreate);

   Str := 'Name,ServerName,CharName,Age,Sex,MainMagic,Win,Lose,DisConnected,Point,Grade,ServerGrade,MagicGrade,ServerPoint,LastFighterName,FightingCount';
   StrPCopy (@buffer, Str + #13#10);
   Stream.WriteBuffer (buffer, StrLen (@buffer));

   for i := 0 to DataList.Count - 1 do begin
      UserData := DataList.Items [i];
      Str := IntToStr (i + 1) + ',' + UserData.GetDataStr;
      StrPCopy (@buffer, Str + #13#10);
      Stream.WriteBuffer (buffer, StrLen (@buffer));
   end;
   Stream.Free;
end;

function TBattleDB.GetRankData (aCharInfo : PTGetRankData; aRankData : PTSendRankData) : Boolean;
var
   iName : String;
   UserData : TUserData;
begin
   Result := false;

   FillChar (aRankData^, SizeOf (TSendRankData), 0);

   if aCharInfo^.rName = '' then exit;

   iName := aCharInfo^.rServerName + ':' + aCharInfo^.rName;
   UserData := NameKey.Select (iName);
   if UserData = nil then begin
      UserData := TUserData.Create;
      UserData.Name := iName;
      UserData.CharName := aCharInfo^.rName;
      UserData.ServerName := aCharInfo^.rServerName;
      UserData.Age := aCharInfo^.rAge;
      UserData.Sex := aCharInfo^.rSex;
      UserData.Point := 1000;

      NameKey.Insert (iName, UserData);

      InsertUserData (UserData, true);

      DataList.Add (UserData);
   end;

   aRankData^.rCharName := UserData.CharName;
   aRankData^.rServerName := UserData.ServerName;
   aRankData^.rWin := UserData.Win;
   aRankData^.rLose := UserData.Lose;
   aRankData^.rDisConnected := UserData.DisConnected;
   aRankData^.rPoints := UserData.Point;
   aRankData^.rGrade := UserData.Grade;

   Result := true;
end;

function TBattleDB.GetBattleGroupKey (aAge : Integer) : TUserDataKeyClass;
var
   i : Integer;
   pd : PTBattleGroup;
begin
   Result := nil;

   for i := 0 to GroupList.Count - 1 do begin
      pd := GroupList.Items [i];
      if (aAge >= pd^.StartAge) and (aAge <= pd^.EndAge) then begin
         Result := pd^.PointKey;
         exit;
      end;
   end;
end;

function TBattleDB.GetRankPart (aAge, aStart, aEnd : Integer; aRankPart : PTSendRankPart) : Boolean;
var
   i : Integer;
   UserData : TUserData;

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -