svmain.pas

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

   // 芒炼GS
   GameServerConnector := GameServerConnectorList.Items [0];
   if GameServerConnector <> nil then begin
      with GameServerConnector do begin
         frmGSState.lblCreateSendB.Caption := IntToStr (SendBytesPerSec) + 'K';
         frmGSState.lblCreateReceiveB.Caption := IntToStr (ReceiveBytesPerSec) + 'K';

         if WriteAllow = true then begin
            frmGSState.shpCreateWBSign.Brush.Color := clLime;
         end else begin
            frmGSState.shpCreateWBSign.Brush.Color := clRed;
         end;
      end;
   end;

   // 何劝GS
   GameServerConnector := GameServerConnectorList.Items [1];
   if GameServerConnector <> nil then begin
      with GameServerConnector do begin
         frmGSState.lblRevivalSendB.Caption := IntToStr (SendBytesPerSec) + 'K';
         frmGSState.lblRevivalReceiveB.Caption := IntToStr (ReceiveBytesPerSec) + 'K';

         if WriteAllow = true then begin
            frmGSState.shpRevivalWBSign.Brush.Color := clLime;
         end else begin
            frmGSState.shpRevivalWBSign.Brush.Color := clRed;
         end;
      end;
   end;

   // 积疙GS
   GameServerConnector := GameServerConnectorList.Items [2];
   if GameServerConnector <> nil then begin
      with GameServerConnector do begin
         frmGSState.lblLifeSendB.Caption := IntToStr (SendBytesPerSec) + 'K';
         frmGSState.lblLifeReceiveB.Caption := IntToStr (ReceiveBytesPerSec) + 'K';

         if WriteAllow = true then begin
            frmGSState.shpLifeWBSign.Brush.Color := clLime;
         end else begin
            frmGSState.shpLifeWBSign.Brush.Color := clRed;
         end;
      end;
   end;

   // 脚拳GS
   GameServerConnector := GameServerConnectorList.Items [3];
   if GameServerConnector <> nil then begin
      with GameServerConnector do begin
         frmGSState.lblMythSendB.Caption := IntToStr (SendBytesPerSec) + 'K';
         frmGSState.lblMythReceiveB.Caption := IntToStr (ReceiveBytesPerSec) + 'K';

         if WriteAllow = true then begin
            frmGSState.shpMythWBSign.Brush.Color := clLime;
         end else begin
            frmGSState.shpMythWBSign.Brush.Color := clRed;
         end;
      end;
   end;

   // 窍疵GS
   GameServerConnector := GameServerConnectorList.Items [4];
   if GameServerConnector <> nil then begin
      with GameServerConnector do begin
         frmGSState.lblSkySendB.Caption := IntToStr (SendBytesPerSec) + 'K';
         frmGSState.lblSkyReceiveB.Caption := IntToStr (ReceiveBytesPerSec) + 'K';

         if WriteAllow = true then begin
            frmGSState.shpSkyWBSign.Brush.Color := clLime;
         end else begin
            frmGSState.shpSkyWBSign.Brush.Color := clRed;
         end;
      end;
   end;

   // 玫窍GS
   GameServerConnector := GameServerConnectorList.Items [5];
   if GameServerConnector <> nil then begin
      with GameServerConnector do begin
         frmGSState.lblWorldSendB.Caption := IntToStr (SendBytesPerSec) + 'K';
         frmGSState.lblWorldReceiveB.Caption := IntToStr (ReceiveBytesPerSec) + 'K';

         if WriteAllow = true then begin
            frmGSState.shpWorldWBSign.Brush.Color := clLime;
         end else begin
            frmGSState.shpWorldWBSign.Brush.Color := clRed;
         end;
      end;
   end;
   
{
   // 角氰GS
   GameServerConnector := GameServerConnectorList.Items [6];
   with GameServerConnector do begin
      frmGSState.lblExSendB.Caption := IntToStr (SendBytesPerSec) + 'K';
      frmGSState.lblExReceiveB.Caption := IntToStr (ReceiveBytesPerSec) + 'K';

      if WriteAllow = true then begin
         frmGSState.shpExWBSign.Brush.Color := clLime;
      end else begin
         frmGSState.shpExWBSign.Brush.Color := clRed;
      end;
   end;

   // 32锅GS
   GameServerConnector := GameServerConnectorList.Items [0];
   with GameServerConnector do begin
      frmGSState.lblTestSendB.Caption := IntToStr (SendBytesPerSec) + 'K';
      frmGSState.lblTestReceiveB.Caption := IntToStr (ReceiveBytesPerSec) + 'K';

      if WriteAllow = true then begin
         frmGSState.shpTestWBSign.Brush.Color := clLime;
      end else begin
         frmGSState.shpTestWBSign.Brush.Color := clRed;
      end;
   end;
}

   // DB
   if (BattleDBSender <> nil) and (BattleDBReceiver <> nil) then begin
      lblBattleDBSendBytes.Caption := IntToStr (BattleDBSender.SendBytesPerSec) + 'K';
      lblBattleDBReceiveBytes.Caption := IntToStr (BattleDBReceiver.ReceiveBytesPerSec) + 'K';
      lblBattleDBWBCount.Caption := IntToStr (BattleDBSender.WouldBlockCount);

      if BattleDBSender.WriteAllow = true then begin
         shpBattleDBWBSign.Brush.Color := clLime;
      end else begin
         shpBattleDBWBSign.Brush.Color := clRed;
      end;
   end else begin
      shpBattleDBWBSign.Brush.Color := clRed;
   end;
end;

procedure TFrmMain.TimerProcessTimer(Sender: TObject);
var
   CurTick : integer;
   Packet : TPacketData;
begin
   CurTick := mmAnsTick;

   GameServerConnectorList.Update (CurTick);

   ConnectorList.Update (CurTick);
   UserList.Update (CurTick);

   if boCloseFlag = false then begin
      BattleGroupList.Update (CurTick);
   end;

   inc (ProcessCount);

   if BattleDBSender <> nil then BattleDBSender.Update;
   if BattleDBReceiver <> nil then begin
      BattleDBReceiver.Update;
      while BattleDBReceiver.Count > 0 do begin
         if BattleDBReceiver.GetPacket (@Packet) = false then break;
         ConnectorList.BattleDBMessageProcess (@Packet);
      end;
   end;
end;

procedure TFrmMain.sckGameServerAcceptAccept(Sender: TObject;
  Socket: TCustomWinSocket);
begin
   if GameServerConnectorList.CreateConnect (Socket) = false then begin
      Socket.Close;
      exit;
   end;
   AddLog (format ('Server BattleServer Accepted %s', [Socket.RemoteAddress]));
end;

procedure TFrmMain.sckGameServerAcceptClientDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
   if Socket.Connected = true then begin
      GameServerConnectorList.DeleteConnect (Socket);
      AddLog (format ('Server BattleServer Disconnected %s', [Socket.RemoteAddress]));
   end;
end;

procedure TFrmMain.sckGameServerAcceptClientError(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin
   AddLog (format ('Server Accept Socket Error (%d, %s)', [ErrorCode, Socket.RemoteAddress]));
   ErrorCode := 0;
end;

procedure TFrmMain.sckGameServerAcceptClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
var
   nRead : Integer;
   buffer : array[0..8192 - 1] of byte;
begin
   nRead := Socket.ReceiveBuf (buffer, 8192);
   if nRead > 0 then begin
      GameServerConnectorList.AddReceiveData (Socket, @buffer, nRead);
   end;
end;

procedure TFrmMain.sckGameServerAcceptClientWrite(Sender: TObject;
  Socket: TCustomWinSocket);
begin
   GameServerConnectorList.SetWriteAllow (Socket);
end;

procedure TfrmMain.AddLog (aStr : String);
begin
   if txtLog.Lines.Count >= 30 then begin
      txtLog.Lines.Delete (0);
   end;
   txtLog.Lines.Add (aStr);
end;

procedure TFrmMain.sckBattleDBConnectConnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
   if BattleDBSender <> nil then begin
      BattleDBSender.Free;
      BattleDBSender := nil;
   end;
   if BattleDBReceiver <> nil then begin
      BattleDBReceiver.Free;
      BattleDBReceiver := nil;
   end;

   BattleDBSender := TPacketSender.Create ('BattleDB_SENDER', BufferSizeS2S, Socket);
   BattleDBReceiver := TPacketReceiver.Create ('BattleDB_RECEIVER', BufferSizeS2C);

   AddLog (format ('BattleDBConnect Accepted %s', [Socket.RemoteAddress]));   
end;

procedure TFrmMain.sckBattleDBConnectDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
   if BattleDBSender <> nil then begin
      BattleDBSender.Free;
      BattleDBSender := nil;
   end;
   if BattleDBReceiver <> nil then begin
      BattleDBReceiver.Free;
      BattleDBReceiver := nil;
   end;
end;

procedure TFrmMain.sckBattleDBConnectError(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin
   if (ErrorCode <> 10061) and (ErrorCode <> 10038) then begin
      AddLog (format ('BattleDBConnect Socket Error (%d)', [ErrorCode]));
   end;

   ErrorCode := 0;
end;

procedure TFrmMain.sckBattleDBConnectRead(Sender: TObject;
  Socket: TCustomWinSocket);
var
   buffer : array [0..8192 - 1] of char;
   nTotal, nRead : Integer;
begin
   nTotal := Socket.ReceiveLength;

   while nTotal > 0 do begin
      nRead := Socket.ReceiveBuf (buffer, 8192);
      if nRead < 0 then break;
      if BattleDBReceiver <> nil then BattleDBReceiver.PutData (@buffer, nRead);
      nTotal := nTotal - nRead;
   end;
end;

procedure TFrmMain.sckBattleDBConnectWrite(Sender: TObject;
  Socket: TCustomWinSocket);
begin
   if BattleDBSender <> nil then BattleDBSender.WriteAllow := true;
end;

procedure TFrmMain.lstGroupDblClick(Sender: TObject);
var
   Title, str, dest : String;
begin
   str := lstGroup.Items [lstGroup.ItemIndex];
   dest := GetValidStr3 (str, Title, ':');

   lstRoom.Clear;
   BattleGroupList.ShowRoomTitleList (Title);
end;

procedure TFrmMain.lstGroupUpdate (aUpdateTitle : String);
var
   UpdateTitle, Title, str, dest : String;
   i : Integer;
begin
   dest := GetValidStr3 (aUpdateTitle, UpdateTitle, ':');

   for i := 0 to lstGroup.Items.Count - 1 do begin
      str := lstGroup.Items [i];
      dest := GetValidStr3 (str, Title, ':');

      if Title = UpdateTitle then begin
         lstGroup.Items [i] := aUpdatetitle;
         exit;
      end;
   end;
end;

procedure TFrmMain.GSStateClick(Sender: TObject);
begin
   frmGSState.Show;
end;

end.