fgate.pas

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

         end;
      end;
   end;
   // Gate 1-3
   if GateConnectorList.Count > 2 then begin
      GateConnector := GateConnectorList.Items [2];
      with GateConnector do begin
         lblSendByte3.Caption := IntToStr (SendBytesPerSec) + 'K';
         lblRecvByte3.Caption := IntToStr (ReceiveBytesPerSec) + 'K';
         lblWBCount3.Caption := IntToStr (WBCount);

         if WriteAllow = true then begin
            shpWBSign3.Brush.Color := clLime;
         end else begin
            shpWBSign3.Brush.Color := clRed;
         end;
      end;
   end;
   // Gate 1-4
   if GateConnectorList.Count > 3 then begin
      GateConnector := GateConnectorList.Items [3];
      with GateConnector do begin
         lblSendByte4.Caption := IntToStr (SendBytesPerSec) + 'K';
         lblRecvByte4.Caption := IntToStr (ReceiveBytesPerSec) + 'K';
         lblWBCount4.Caption := IntToStr (WBCount);

         if WriteAllow = true then begin
            shpWBSign4.Brush.Color := clLime;
         end else begin
            shpWBSign4.Brush.Color := clRed;
         end;
      end;
   end;
   // DB Connection
   if (DBSender <> nil) and (DBReceiver <> nil) then begin
      lblDBSendBytes.Caption := IntToStr (DBSender.SendBytesPerSec) + 'K';
      lblDBReceiveBytes.Caption := IntToStr (DBReceiver.ReceiveBytesPerSec) + 'K';
      lblDBWBCount.Caption := IntToStr (DBSender.WouldBlockCount);

      if DBSender.WriteAllow = true then begin
         shpDBWBSign.Brush.Color := clLime;
      end else begin
         shpDBWBSign.Brush.Color := clRed;
      end;
   end;

   lblSaveListCount.Caption := IntToStr (ConnectorList.GetSaveListCount);

   lblConnectListCount.Caption := IntToStr (ConnectorList.Count);
   lblNameKeyCount.Caption := IntToStr (ConnectorList.NameKeyCount);
   lblUniqueKeyCount.Caption := IntToStr (ConnectorList.UniqueKeyCount);
end;

procedure TfrmGate.sckDBConnectConnect(Sender: TObject;
  Socket: TCustomWinSocket);
var
   buffer : array [0..20 - 1] of char;
begin
   if DBSender <> nil then begin
      DBSender.Free;
      DBSender := nil;
   end;
   if DBReceiver <> nil then begin
      DBReceiver.Free;
      DBReceiver := nil;
   end;
   DBSender := TPacketSender.Create ('DB_SENDER', BufferSizeS2S, Socket);
   DBReceiver := TPacketReceiver.Create ('DB_RECEIVER', BufferSizeS2C);

   FillChar (buffer, SizeOf (buffer), 0);
   StrPCopy (@buffer, 'GAMESERVER');
   DBSender.PutPacket (0, DB_CONNECTTYPE, 0, @buffer, SizeOf (buffer));
end;

procedure TfrmGate.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;
end;

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

procedure TfrmGate.sckDBConnectRead(Sender: TObject;
  Socket: TCustomWinSocket);
var
   nTotalSize, nReadSize, nRead : Integer;
   buffer : array [0..8192 - 1] of Byte;
begin
   nTotalSize := Socket.ReceiveLength;
   while nTotalSize > 0 do begin
      nReadSize := nTotalSize;
      if nReadSize > 8192 then nReadSize := 8192;
      nRead := Socket.ReceiveBuf (buffer, nReadSize);
      if nRead < 0 then break;
      if DBReceiver <> nil then DBReceiver.PutData (@buffer, nRead);
      nTotalSize := nTotalSize - nRead;
   end;
end;

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

function TfrmGate.AddSendDBServerData (aMsg : Byte; aData : PChar; aCount : Integer) : Boolean;
begin
   Result := false;
   if (aCount >= 0) and (aCount < SizeOf (TPacketData)) then begin
      if DBSender <> nil then begin
         Result := DBSender.PutPacket (0, aMsg, 0, aData, aCount);
      end;
   end;
end;

procedure TfrmGate.DBMessageProcess (aPacket : PTPacketData);
var
   i, j, n : Integer;
   ItemLogData : TItemLogRecord;
   Str, rdstr, ColumnStr : String;
   Name, Password, ItemName, ItemColor, ItemCount : String;
   No : Integer;
   buffer : array [0..2048 - 1] of char;
begin
   Case aPacket^.RequestMsg of
      DB_UPDATE :
         begin
            if aPacket^.ResultCode = DB_OK then begin
               AddLog (format ('User Data Saved %s', [StrPas (@aPacket^.Data)]));
            end else begin
               AddLog (format ('User Data Save Failed %s', [StrPas (@aPacket^.Data)]));
            end;
         end;
      DB_ITEMSELECT :
         begin
            Name := StrPas (@aPacket^.Data);

            n := ItemLog.GetRoomCount (Name);
            if n <= 0 then begin
               StrPCopy (@buffer, format ('%s丛俊霸 且寸等 焊包傍埃捞 绝嚼聪促', [Name]));
               DBSender.PutPacket (aPacket^.RequestID, DB_ITEMSELECT, 1, @buffer, SizeOf (buffer));
               exit;
            end;
            if n > 4 then n := 4;

            Str := '';
            for i := 0 to n - 1 do begin
               if ItemLog.GetLogRecord (Name, i, ItemLogData) = true then begin
                  Str := Str + 'UserData,' + Name + ',' + IntToStr (i) + ',' + StrPas (@ItemLogData.Header.LockPassword);
                  for j := 0 to 10 - 1 do begin
                     ItemName := StrPas (@ItemLogData.ItemData[j].Name);
                     ItemColor := IntToStr (ItemLogData.ItemData[j].Color);
                     ItemCount := IntToStr (ItemLogData.ItemData[j].Count);
                     Str := Str + ',' + ItemName + ':' + ItemColor + ':' + ItemCount;
                  end;
                  Str := Str + #13;
               end else begin
                  StrPCopy (@buffer, '焊包芒 坷幅肺 秒家登菌嚼聪促');
                  DBSender.PutPacket (aPacket^.RequestID, DB_ITEMSELECT, 1, @buffer, SizeOf (buffer));
                  exit;
               end;
            end;
            StrPCopy (@buffer, Str);
            DBSender.PutPacket (aPacket^.RequestID, DB_ITEMSELECT, 0, @buffer, SizeOf (buffer));
         end;
      DB_ITEMUPDATE :
         begin
            Str := StrPas (@aPacket^.Data);

            Str := GetValidStr3 (Str, Name, ',');
            Str := GetValidStr3 (Str, rdstr, ',');
            No := _StrToInt (rdstr);
            Str := GetValidStr3 (Str, Password, ',');

            if ItemLog.GetLogRecord (Name, No, ItemLogData) = false then begin
               StrPCopy (@buffer, '焊包芒 坷幅肺 秒家登菌嚼聪促');
               DBSender.PutPacket (aPacket^.RequestID, DB_ITEMUPDATE, 1, @buffer, SizeOf (buffer));
               exit;
            end;

            StrPCopy (@ItemLogData.Header.LockPassword, Password);
            for i := 0 to 10 - 1 do begin
               Str := GetValidStr3 (Str, ColumnStr, ',');
               ColumnStr := GetValidStr3 (ColumnStr, rdstr, ':');
               StrPCopy (@ItemLogData.ItemData[i].Name, rdstr);
               ColumnStr := GetValidStr3 (ColumnStr, rdstr, ':');
               ItemLogData.ItemData[i].Color := _StrToInt (rdstr);
               ColumnStr := GetValidStr3 (ColumnStr, rdstr, ':');
               ItemLogData.ItemData[i].Count := _StrToInt (rdstr);
            end;

            ItemLog.SetLogRecord (Name, No, ItemLogData);

            StrPCopy (@buffer, '沥惑利栏肺 贸府登菌嚼聪促');
            DBSender.PutPacket (aPacket^.RequestID, DB_ITEMUPDATE, 0, @buffer, SizeOf (buffer));
         end;
   end;
end;

function TfrmGate.AddSendBattleData (aID : Integer; aMsg : Byte; aRetCode : Byte; aData : PChar; aCount : Integer) : Boolean;
begin
   if BattleSender <> nil then begin
      Result := BattleSender.PutPacket (aID, aMsg, aRetCode, aData, aCount);
   end;
end;

procedure TfrmGate.BattleMessageProcess (aPacket : PTPacketData);
begin
   Case aPacket^.RequestMsg of
      BG_USERCLOSE :
         begin
            ConnectorList.ReStartChar (aPacket^.RequestID);
         end;
      BG_GAMEDATA :
         begin
            ConnectorList.AddSendData (aPacket);
         end;
   end;
end;

procedure TfrmGate.timerProcessTimer(Sender: TObject);
var
   Packet : TPacketData;
begin
   if DBSender <> nil then DBSender.Update;
   if DBReceiver <> nil then begin
      DBReceiver.Update;
      while DBReceiver.Count > 0 do begin
         if DBReceiver.GetPacket (@Packet) = false then break;
         DBMessageProcess (@Packet);
      end;
   end;

   if BattleSender <> nil then BattleSender.Update;
   if BattleReceiver <> nil then begin
      BattleReceiver.Update;
      while BattleReceiver.Count > 0 do begin
         if BattleReceiver.GetPacket (@Packet) = false then break;
         BattleMessageProcess (@Packet);
      end;
   end;
end;

procedure TfrmGate.sckBattleConnectConnect(Sender: TObject;
  Socket: TCustomWinSocket);
var
   buffer : array [0..20 - 1] of char;
begin
   if BattleSender <> nil then begin
      BattleSender.Free;
      BattleSender := nil;
   end;
   if BattleReceiver <> nil then begin
      BattleReceiver.Free;
      BattleReceiver := nil;
   end;
   BattleSender := TPacketSender.Create ('Battle_SENDER', BufferSizeS2S, Socket);
   BattleReceiver := TPacketReceiver.Create ('Battle_RECEIVER', BufferSizeS2C);

   GateList.SetBSGateActive (true);
end;

procedure TfrmGate.sckBattleConnectDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
   if BattleSender <> nil then begin
      BattleSender.Free;
      BattleSender := nil;
   end;
   if BattleReceiver <> nil then begin
      BattleReceiver.Free;
      BattleReceiver := nil;
   end;

   GateList.SetBSGateActive (false);
end;

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

procedure TfrmGate.sckBattleConnectRead(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
      if BattleReceiver <> nil then BattleReceiver.PutData (@buffer, nRead);
   end;
end;

procedure TfrmGate.sckBattleConnectWrite(Sender: TObject;
  Socket: TCustomWinSocket);
begin
   if BattleSender <> nil then BattleSender.WriteAllow := true;
end;

end.