svmain.pas

千年源代码,只缺少控件,可以做二次开发用,好不容易得来的

// 2001. 07. 03. Battle Server 矫累... ;;; by saset...
// 2001. 08. 04. 角氰挤俊 剁框. (公鲤霸 磊林 促款凳 -_-;)
// 2001. 08. 14. 夯挤俊 剁框.

unit SVMain;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, inifiles, ExtCtrls,
  uAnsTick, uUser, uconnect, mapunit, fieldmsg, ulevelexp, deftype,
  svClass, basicobj, aUtil32, Spin, Menus, ComCtrls,
  uLetter, AnsStringCls, ScktComp, uPackets, Common;

type
  TFrmMain = class(TForm)
    TimerProcess: TTimer;
    TimerDisplay: TTimer;
    TimerSave: TTimer;
    TimerClose: TTimer;
    MainMenu1: TMainMenu;
    Files: TMenuItem;
    Exit1: TMenuItem;
    StatusBar1: TStatusBar;
    sckGameServerAccept: TServerSocket;
    txtLog: TMemo;
    sckBattleDBConnect: TClientSocket;
    GroupBox1: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    lblBattleDBSendBytes: TLabel;
    lblBattleDBReceiveBytes: TLabel;
    lblBattleDBWBCount: TLabel;
    shpBattleDBWBSign: TShape;
    Label7: TLabel;
    Bevel1: TBevel;
    Bevel2: TBevel;
    lstGroup: TListBox;
    Label4: TLabel;
    Label5: TLabel;
    lstRoom: TListBox;
    lstUsers: TListBox;
    lblUsers: TLabel;
    States: TMenuItem;
    GSState: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure TimerProcessTimer(Sender: TObject);
    procedure TimerDisplayTimer(Sender: TObject);
    procedure TimerSaveTimer(Sender: TObject);
    procedure TimerCloseTimer(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
    procedure sckGameServerAcceptAccept(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure sckGameServerAcceptClientDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure sckGameServerAcceptClientError(Sender: TObject;
      Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
      var ErrorCode: Integer);
    procedure sckGameServerAcceptClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure sckGameServerAcceptClientWrite(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure sckBattleDBConnectConnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure sckBattleDBConnectDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure sckBattleDBConnectError(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure sckBattleDBConnectRead(Sender: TObject; Socket: TCustomWinSocket);
    procedure sckBattleDBConnectWrite(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure lstGroupDblClick(Sender: TObject);
    procedure GSStateClick(Sender: TObject);
  private

  public
    boCloseFlag : Boolean;
    ProcessCount : integer;

    procedure AddLog (aStr : String);
    procedure WriteLogInfo (aStr : String);
    procedure WriteDumpInfo (aData : PChar; aSize : Integer);
    procedure AddUser (aName : String);
    procedure DelUser (aName : String);


    procedure lstGroupUpdate (aUpdateTitle : String);
  end;

var
  FrmMain: TFrmMain;

  BSPort : Integer = 3040;
  BufferSizeS2S : Integer = 1048576;
  BufferSizeS2C : Integer = 8192;

//  BattleDBServerIpAddr : String = '192.168.0.151';
  BattleDBServerIpAddr : String = '192.168.0.109';
  BattleDBServerPort : Integer = 3039;   // 固沥.. ;;; 铝..

  BattleDBSender : TPacketSender;
  BattleDBReceiver : TPacketReceiver;

implementation

uses
   uGConnect, uGroup, BSCommon, FGameServer;

{$R *.DFM}

procedure TFrmMain.WriteLogInfo (aStr : String);
var
   Stream : TFileStream;
   tmpFileName : String;
   szBuf : array[0..1024] of Byte;
begin
   try
      StrPCopy(@szBuf, '[' + DateToStr(Date) + ' ' + TimeToStr(Time) + '] ' + aStr + #13#10);
      tmpFileName := 'BGS1000.LOG';
      if FileExists (tmpFileName) then
         Stream := TFileStream.Create (tmpFileName, fmOpenReadWrite)
      else
         Stream := TFileStream.Create (tmpFileName, fmCreate);

      Stream.Seek(0, soFromEnd);
      Stream.WriteBuffer (szBuf, StrLen(@szBuf));
      Stream.Destroy;
   except
   end;
end;

procedure TFrmMain.WriteDumpInfo (aData : PChar; aSize : Integer);
var
   Stream : TFileStream;
   tmpFileName : String;
   iCount : Integer;
begin
   try
      iCount := 0;
      while true do begin
         tmpFileName := 'DUMP' + IntToStr (iCount) + '.BIN';
         if not FileExists (tmpFileName) then break;
         iCount := iCount + 1;
      end;
      
      Stream := TFileStream.Create (tmpFileName, fmCreate);
      Stream.Seek(0, soFromEnd);
      Stream.WriteBuffer (aData^, aSize);
      Stream.Destroy;
   except
   end;
end;

procedure TFrmMain.AddUser (aName : String);
begin
   lstUsers.Items.Add (aName);
   lblUsers.Caption := format ('Users (%d)', [lstUsers.Items.Count]);
end;

procedure TFrmMain.DelUser (aName : String);
var
   Index : Integer;
begin
   Index := lstUsers.Items.IndexOf (aName);
   if (Index >= 0) and (Index < lstUsers.Items.Count) then begin
      lstUsers.Items.Delete (Index);
      lblUsers.Caption := format ('Users (%d)', [lstUsers.Items.Count]);
   end;
end;

procedure TFrmMain.FormCreate(Sender: TObject);
var
   Ini : TIniFile;
begin
   ShareRoom := TBattleRoom.Create (nil, '', 0);

   WriteLogInfo ('Battle Server Started');

   Randomize;

   boCloseFlag := FALSE;

   LoadGameIni ('.\game.ini');

   Ini := TIniFile.Create ('.\bs1000.ini');
   BSPort := Ini.ReadInteger ('SERVER', 'Port', 3040);
   BufferSizeS2S := INI.ReadInteger ('SERVER', 'BUFFERSIZES2S', 1048576);
   BufferSizeS2C := INI.ReadInteger ('SERVER', 'BUFFERSIZES2C', 8192);

   BattleDBServerIpAddr := Ini.ReadString ('BattleDB_SERVER', 'IPADDRESS', '192.168.0.109');
   BattleDBServerPort := Ini.ReadInteger ('BattleDB_SERVER', 'PORT', 3039);

   ini.Free;

   BattleGroupList := TBattleGroupList.Create;

   // ManagerList := TManagerList.Create;

   GameServerConnectorList := TGameServerConnectorList.Create;

   ConnectorList := TConnectorList.Create;
   UserList := TUserList.Create (100);
   MirrorList := TMirrorList.Create;
   SpecialAreaList := TSpecialAreaList.Create;

   GradeStrList := TStringList.Create;
   GradeStrList.LoadFromFile (GRADE_FILENAME);

   sckGameServerAccept.Port := BSPort;
   sckGameServerAccept.Active := true;

   sckBattleDBConnect.Port := BattleDBServerPort;
   sckBattleDBConnect.Address := BattleDBServerIpAddr;
   sckBattleDBConnect.Active := true;

   TimerProcess.Interval := 10;
   TimerProcess.Enabled := TRUE;
end;

procedure TFrmMain.FormDestroy(Sender: TObject);
begin
   GradeStrList.Clear;
   GradeStrList.Free;

   ShareRoom.free;

   TimerProcess.Enabled := false;
   TimerSave.Enabled := false;
   TimerDisplay.Enabled := false;

   MirrorList.Free;
   SpecialAreaList.Free;
   UserList.free;
   ConnectorList.free;
   GameServerConnectorList.Free;
   // ManagerList.Free;

   BattleGroupList.Free;

   WriteLogInfo ('Battle Server Exit');

   if sckGameServerAccept.Active = true then begin
      sckGameServerAccept.Socket.Close;
   end;

   if sckBattleDBConnect.Active = true then begin
      sckBattleDBConnect.Socket.Close;
   end;
end;

procedure TFrmMain.TimerSaveTimer(Sender: TObject);
begin
   {
   if TimerClose.Enabled = true then exit;

   str := TimeToStr (Time);
   if OldDate <> DateToStr (Date) then begin
      OldDate := DateToStr (Date);

      GameCurrentDate := Round ( Date - StrToDate (GameStartDateStr));

      NameStringListForDeleteMagic.Clear;
   end;

   if Pos ('坷傈', str) > 0 then GrobalLightDark := gld_dark
   else GrobalLightDark := gld_light;

   if NoticeStringList.Count > 0 then begin
      if CurNoticePosition >= NoticeStringList.Count then CurNoticePosition := 0;
      UserList.SendNoticeMessage ( NoticeStringList[CurNoticePosition], SAY_COLOR_NOTICE);
      inc (CurNoticePosition);
   end;

   n := GetCPUStartHour;
   if n <> IniHour then begin
      IniHour := n;
      ServerIni.WriteInteger ('DATABASE', 'HOUR', n);

      GuildList.SaveToFile ('.\Guild\CreateGuild.SDB');
   end;

   usd.rmsg := 1;
   SetWordString (usd.rWordString, IntToStr (UserList.Count));
   n := sizeof(TStringData) - sizeof(TWordString) + sizeofwordstring (usd.rwordstring);
   FrmSockets.UdpMoniterAddData (n, @usd);
   }
end;

procedure TFrmMain.TimerCloseTimer(Sender: TObject);
begin
   if (UserList.Count = 0) and (ConnectorList.Count = 0) and (ConnectorList.GetSaveListCount = 0) then begin
      Close;
   end else begin
      ConnectorList.CloseAllConnect;
   end;
end;

procedure TFrmMain.Exit1Click(Sender: TObject);
begin
   boCloseFlag := true;

   TimerClose.Interval := 1000;
   TimerClose.Enabled := TRUE;
end;

procedure TFrmMain.TimerDisplayTimer(Sender: TObject);
var
   GameServerConnector : TGameServerConnector;
begin
   if sckBattleDBConnect.Active = false then begin
      sckBattleDBConnect.Socket.Close;
      sckBattleDBConnect.Active := true;
   end;