fmain.pas

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

   if LoginSender <> nil then LoginSender.Update;
   if LoginReceiver <> nil then begin
      LoginReceiver.Update;
      while LoginReceiver.Count > 0 do begin
         if LoginReceiver.GetPacket (@Packet) = false then break;
         ConnectorList.LoginMessageProcess (@Packet);
      end;
   end;

   if PaidSender <> nil then PaidSender.Update;
   if PaidReceiver <> nil then begin
      PaidReceiver.Update;
      while PaidReceiver.Count > 0 do begin
         if PaidReceiver.GetPacket (@Packet) = false then break;
         ConnectorList.PaidMessageProcess (@Packet);
      end;
   end;

   Result := true;
end;

procedure TfrmMain.sckUserAcceptAccept(Sender: TObject;
  Socket: TCustomWinSocket);
begin
   if chkUserAccept.Checked = true then begin
      AddEvent (Socket.RemoteAddress + ' Connected');
      if ConnectorList.CreateConnect (Socket) = true then exit;
   end;
   Socket.Close;
end;

procedure TfrmMain.sckUserAcceptClientConnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
   //
end;

procedure TfrmMain.sckUserAcceptClientDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
var
	Name : String;
begin
   Name := ConnectorList.DeleteConnect (Socket);

   AddEvent (Socket.RemoteAddress + ' DisConnected ' + Name);
end;

procedure TfrmMain.sckUserAcceptClientError(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin
   AddEvent (Socket.RemoteAddress + ' Error');
   ErrorCode := 0;
end;

procedure TfrmMain.sckUserAcceptClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
var
   nRead : Integer;
   buffer : array[0..4096] of byte;
begin
   nRead := Socket.ReceiveBuf (buffer, 4096);
   if nRead > 0 then begin
      ConnectorList.AddReceiveData (Socket, @buffer, nRead);
      exit;
   end;
end;

procedure TfrmMain.sckUserAcceptClientWrite(Sender: TObject;
  Socket: TCustomWinSocket);
begin
   ConnectorList.SetWriteAllow (Socket);
end;

procedure TfrmMain.timerDisplayTimer(Sender: TObject);
var
   CurTick : Integer;
//   wbColor : TColor;
   buffer : array[0..128] of char;
   pBalanceData : PTBalanceData;
begin
   if sckGameConnect.Active = false then begin
      shpGameConnected.Brush.Color := clRed;
      sckGameConnect.Socket.Close;
      sckGameConnect.Active := true;
   end else begin
      shpGameConnected.Brush.Color := clLime;
   end;

   if sckDBConnect.Active = false then begin
      shpDBConnected.Brush.Color := clRed;
      sckDBConnect.Socket.Close;
      sckDBConnect.Active := true;
   end else begin
      shpDBConnected.Brush.Color := clLime;
   end;

   if sckLoginConnect.Active = false then begin
      shpLoginConnected.Brush.Color := clRed;
      sckLoginConnect.Socket.Close;;
      sckLoginConnect.Active := true;
   end else begin
      shpLoginConnected.Brush.Color := clLime;
   end;

   if sckPaidConnect.Active = false then begin
      shpPaidConnected.Brush.Color := clRed;
      sckPaidConnect.Socket.Close;;
      sckPaidConnect.Active := true;
   end else begin
      shpPaidConnected.Brush.Color := clLime;
   end;

   CurTick := timeGetTime;
   if CurTick >= StartTick + 1000 then begin
      ElaspedSec := ElaspedSec + 1;
      StartTick := CurTick;
   end;

   lblElaspedTime.Caption := IntToStr (ElaspedSec);
   lblConnectCount.Caption := IntToStr (ConnectorList.Count);
   lblPlayCount.Caption := IntToStr (ConnectorList.PlayingUserCount);
   lblLogCount.Caption := IntToStr (ConnectorList.LogingUserCount);
   lblConnectID.Caption := IntToStr (ConnectorList.AutoConnectID);

   if GameSender <> nil then begin
      lblGameSendBytes.Caption := IntToStr (GameSender.SendBytesPerSec);
      lblGameWBCount.Caption := IntToStr (GameSender.WouldBlockCount);
      if GameSender.WriteAllow = true then begin
         shpGameWBSign.Brush.Color := clLime;
      end else begin
         shpGameWBSign.Brush.Color := clRed;
      end;
   end;
   if GameReceiver <> nil then begin
      lblGameRecvBytes.Caption := IntToStr (GameReceiver.ReceiveBytesPerSec);
   end;
   if DBSender <> nil then begin
      lblDBSendBytes.Caption := IntToStr (DBSender.SendBytesPerSec);
      lblDBWBCount.Caption := IntToStr (DBSender.WouldBlockCount);
      if DBSender.WriteAllow = true then begin
         shpDBWBSign.Brush.Color := clLime;
      end else begin
         shpDBWBSign.Brush.Color := clRed;
      end;
   end;
   if DBReceiver <> nil then begin
      lblDBRecvBytes.Caption := IntToStr (DBReceiver.ReceiveBytesPerSec);
   end;
   if LoginSender <> nil then begin
      lblLoginSendBytes.Caption := IntToStr (LoginSender.SendBytesPerSec);
      lblLoginWBCount.Caption := IntToStr (LoginSender.WouldBlockCount);
      if LoginSender.WriteAllow = true then begin
         shpLoginWBSign.Brush.Color := clLime;
      end else begin
         shpLoginWBSign.Brush.Color := clRed;
      end;
   end;
   if LoginReceiver <> nil then begin
      lblLoginRecvBytes.Caption := IntToStr (LoginReceiver.ReceiveBytesPerSec);
   end;

   if CurTick >= BalanceSendTick + 3000 then begin
   	udpBalance.RemoteHost := BalanceConnectInfo.RemoteIP;
      udpBalance.RemotePort := BalanceConnectInfo.RemotePort;

      pBalanceData := @buffer;
      pBalanceData^.rMsg := BM_GATEINFO;
      StrPCopy (@pBalanceData^.rIpAddr, UserAcceptInfo.RemoteIP);
      pBalanceData^.rPort := UserAcceptInfo.LocalPort;
      pBalanceData^.rUserCount := ConnectorList.Count;
      udpBalance.SendBuffer (buffer, sizeof (TBalanceData));
   end;

   if ConnectorList.GateUniqueValue = -1 then begin
      if GameSender <> nil then begin
         GameSender.PutPacket (0, GM_UNIQUEVALUE, 0, nil, 0);
      end;
   end;
end;

procedure TfrmMain.sckDBConnectConnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
   DBSender := TPacketSender.Create ('DB', BufferSizeS2S, Socket);
   DBReceiver := TPacketReceiver.Create ('DB', BufferSizeS2S);

   AddLog (format ('Connected To DB Server %s', [Socket.RemoteAddress]));
end;

procedure TfrmMain.sckDBConnectDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
   if DBSender <> nil then begin
      DBSender.Free;
      DBSender := nil;
   end;
   if DBReceiver <> nil then begin
      DBReceiver.Free;
      DBReceiver := nil;
   end;

   if Socket.Connected = true then begin
      AddLog (format ('Disconnected From DB Server %s', [Socket.RemoteAddress]));
   end;
end;

procedure TfrmMain.sckDBConnectError(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin
   if (ErrorCode <> 10061) and (ErrorCode <> 10038) then begin
      AddLog (format ('Socket Error At DBServer Connection (%d)', [ErrorCode]));
   end;
   ErrorCode := 0;
end;

procedure TfrmMain.sckDBConnectRead(Sender: TObject;
  Socket: TCustomWinSocket);
var
   nRead : Integer;
   buffer : array[0..4096 - 1] of byte;
begin
   nRead := Socket.ReceiveBuf (buffer, 4096);
   if nRead > 0 then begin
      DBReceiver.PutData (@buffer, nRead);
      exit;
   end;
end;

procedure TfrmMain.sckDBConnectWrite(Sender: TObject;
  Socket: TCustomWinSocket);
begin
   if DBSender <> nil then DBSender.WriteAllow := true;
end;

procedure TfrmMain.sckLoginConnectConnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
   LoginSender := TPacketSender.Create ('Login', BufferSizeS2S, Socket);
   LoginReceiver := TPacketReceiver.Create ('Login', BufferSizeS2S);

   AddLog (format ('Connected To Login Server %s', [Socket.RemoteAddress]));
end;

procedure TfrmMain.sckLoginConnectDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
   if LoginSender <> nil then begin
      LoginSender.Free;
      LoginSender := nil;
   end;
   if LoginReceiver <> nil then begin
      LoginReceiver.Free;
      LoginReceiver := nil;
   end;
   if Socket.Connected = true then begin
      AddLog (format ('Disconnected From Login Server %s', [Socket.RemoteAddress]));
   end;
end;

procedure TfrmMain.sckLoginConnectError(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin
   if (ErrorCode <> 10061) and (ErrorCode <> 10038) then begin
      AddLog (format ('Socket Error At LoginServer Connection (%d)', [ErrorCode]));
   end;
   ErrorCode := 0;
end;

procedure TfrmMain.sckLoginConnectRead(Sender: TObject;
  Socket: TCustomWinSocket);
var
   nRead : Integer;
   buffer : array[0..4096 - 1] of byte;
begin
   nRead := Socket.ReceiveBuf (buffer, 4096);
   if nRead > 0 then begin
      LoginReceiver.PutData (@buffer, nRead);
      exit;
   end;
end;

procedure TfrmMain.sckLoginConnectWrite(Sender: TObject;
  Socket: TCustomWinSocket);
begin
   if LoginSender <> nil then LoginSender.WriteAllow := true;
end;

procedure TfrmMain.timerProcessTimer(Sender: TObject);
var
   CurTick : Integer;
begin
   CurTick := timeGetTime;

   ConnectorList.Update (CurTick);
   UpdateServer (CurTick);
end;

procedure TfrmMain.sckGameConnectConnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
   GameSender := TPacketSender.Create ('Game', BufferSizeS2S, Socket);
   GameReceiver := TPacketReceiver.Create ('Game', BufferSizeS2S);

   AddLog (format ('Connected To Game Server %s', [Socket.RemoteAddress]));
end;

procedure TfrmMain.sckGameConnectDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
   if GameSender <> nil then begin
      GameSender.Free;
      GameSender := nil;
   end;
   if GameReceiver <> nil then begin
      GameReceiver.Free;
      GameReceiver := nil;
   end;
   if Socket.Connected = true then begin
      AddLog (format ('Disconnected From Game Server %s', [Socket.RemoteAddress]));
   end;
   if ConnectorList <> nil then begin
      ConnectorList.GateUniqueValue := -1;
   end;
end;

procedure TfrmMain.sckGameConnectError(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin
   if (ErrorCode <> 10061) and (ErrorCode <> 10038) then begin
      AddLog (format ('Socket Error At GameServer Connection (%d)', [ErrorCode]));
   end;
   ErrorCode := 0;
end;

procedure TfrmMain.sckGameConnectRead(Sender: TObject;
  Socket: TCustomWinSocket);
var
   nRead : Integer;
   buffer : array[0..4096 - 1] of byte;
begin
   nRead := Socket.ReceiveBuf (buffer, 4096);
   if nRead > 0 then begin
      GameReceiver.PutData (@buffer, nRead);
      exit;
   end;
end;

procedure TfrmMain.sckGameConnectWrite(Sender: TObject;
  Socket: TCustomWinSocket);
begin
	if GameSender <> nil then GameSender.WriteAllow := true;
end;

procedure TfrmMain.timerCloseTimer(Sender: TObject);
begin
	if ConnectorList = nil then begin
   	timerClose.Enabled := false;
   	Close;
      exit;
   end;
end;

procedure TfrmMain.udpBalanceDataReceived(Sender: TComponent;
  NumberBytes: Integer; FromIP: String; Port: Integer);
begin
	//
end;

procedure TfrmMain.cmdReCalcClick(Sender: TObject);
begin
   ConnectorList.ReCalc;
end;

procedure TfrmMain.sckPaidConnectConnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
   if PaidSender <> nil then PaidSender.Free;
   if PaidReceiver <> nil then PaidReceiver.Free;

   PaidSender := TPacketSender.Create ('PaidSender', BufferSizeS2S, Socket);
   PaidReceiver := TPacketReceiver.Create ('PaidReceiver', BufferSizeS2S);

   AddLog (format ('Connected To Paid Server %s', [Socket.RemoteAddress]));
end;

procedure TfrmMain.sckPaidConnectDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
   if PaidSender <> nil then PaidSender.Free;
   if PaidReceiver <> nil then PaidReceiver.Free;
   PaidSender := nil;
   PaidReceiver := nil;

   if Socket.Connected = true then begin
      AddLog (format ('DisConnected From Paid Server %s', [Socket.RemoteAddress]));
   end;
end;

procedure TfrmMain.sckPaidConnectError(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin
   ErrorCode := 0;
end;

procedure TfrmMain.sckPaidConnectRead(Sender: TObject;
  Socket: TCustomWinSocket);
var
   nRead : Integer;
   buffer : array [0..4096 - 1] of char;
begin
   if Socket.ReceiveLength > 0 then begin
      nRead := Socket.ReceiveBuf (buffer, 4096);
      if nRead > 0 then begin
         if PaidReceiver <> nil then begin
            PaidReceiver.PutData (@buffer, nRead);
         end;
      end;
   end;
end;

procedure TfrmMain.sckPaidConnectWrite(Sender: TObject;
  Socket: TCustomWinSocket);
begin
   if PaidSender <> nil then PaidSender.WriteAllow := true;
end;

end.