uconnector.pas

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

               CurArmSeek := 2200;
               CurLegSeek := 2200;
               CurHealth := 2200;
               CurSatiety := 2200;
               CurPoisoning := 2200;
               CurEnergy := 600;
               CurInPower := 1100;
               CurOutPower := 1100;
               CurMagic := 600;
               CurLife := 2200;

               {
               BasicMagicArr : array [0..10 - 1] of TBasicMagicData;
               WearItemArr : array [0..8 - 1] of TItemData;
               HaveItemArr : array [0..30 - 1] of TItemData;
               HaveMagicArr : array [0..20 - 1] of TMagicData;
               }
            end;
            if DBSender <> nil then begin
               DBSender.PutPacket (ConnectID, DB_INSERT, 0, @DBRecord, SizeOf (DBRecord));
            end;
         end;
      CM_DELETECHAR:
         begin
            if (FGameStatus <> gs_none) or (FGameStatus = gs_deletechar) then exit;

            Case PaidType of
               pt_none : begin
                  SendStatusMessage (MESSAGE_SELCHAR, '蜡历沥焊甫 掘绊 乐嚼聪促. 泪矫 扁促妨 林技夸');
                  exit;
               end;
               pt_invalidate : begin
                  SendStatusMessage (MESSAGE_SELCHAR, '公丰 荤侩磊绰 瘤匡 荐 绝嚼聪促.');
                  exit;
               end;
            end;

            FGameStatus := gs_deletechar;

            pcDeleteChar := @aComData^.Data;
            pcDeleteChar^.rChar [NAME_SIZE - 1] := 0;

            uStr := StrPas (@pcDeleteChar^.rChar);
            uStr := GetTokenStr (uStr, UseChar, ':');
            uStr := GetTokenStr (uStr, UseLand, ':');
            UseChar := Trim (UseChar);
            UseLand := Trim (UseLand);
            if UseChar = '' then begin
               FGameStatus := gs_none;
               SendStatusMessage (MESSAGE_SELCHAR, '昏力且 某腐磐甫 急琶秦 林技夸');
               exit;
            end;
            if UseLand <> ServerName then begin
               FGameStatus := gs_none;
               SendStatusMessage (MESSAGE_SELCHAR, '急琶等 辑滚狼 某腐磐啊 酒凑聪促');
               exit;
            end;

            FillChar (DBRecord, SizeOf (TDBRecord), 0);
            StrPCopy (@DBRecord.PrimaryKey, UseChar);

            if DBSender <> nil then begin
               DBSender.PutPacket (ConnectID, DB_SELECT, 0, @DBRecord, SizeOf (DBRecord.PrimaryKey));
            end;
         end;
      CM_SELECTCHAR:
         begin
            if (FGameStatus <> gs_none) or (FGameStatus = gs_selectchar) then exit;
            if frmMain.sckDBConnect.Socket.Connected = false then begin
               SendStatusMessage (MESSAGE_SELCHAR, '了价钦聪促. 泪矫饶 促矫 楷搬秦 林技夸');
               exit;
            end;

            Case PaidType of
               pt_none : begin
                  SendStatusMessage (MESSAGE_SELCHAR, '蜡历沥焊甫 掘绊 乐嚼聪促. 泪矫 扁促妨 林技夸');
                  exit;
               end;
               pt_invalidate : begin
                  SendStatusMessage (MESSAGE_SELCHAR, '公丰 荤侩磊绰 立加且 荐 绝嚼聪促.');
                  exit;
               end;
            end;

            FGameStatus := gs_selectchar;

            pcSelectChar := @aComData.Data;
            pcSelectChar^.rChar [NAME_SIZE - 1] := 0;

            uStr := StrPas (@pcSelectChar^.rChar);
            uStr := GetTokenStr (uStr, UseChar, ':');
            uStr := GetTokenStr (uStr, UseLand, ':');

            UseChar := Trim (UseChar);
            UseLand := Trim (UseLand);

            if (UseChar = '') or (UseLand = '') then begin
               FGameStatus := gs_none;
               UseChar := '';
               UseLand := '';
               exit;
            end;
            if UseLand <> ServerName then begin
               FGameStatus := gs_none;
               UseChar := '';
               UseLand := '';
               SendStatusMessage (MESSAGE_SELCHAR, '泅犁 急琶等 辑滚狼 某腐磐啊 酒凑聪促');
               exit;
            end;

            FillChar (DBRecord, SizeOf (TDBRecord), 0);
            StrPCopy (@DBRecord.PrimaryKey, UseChar);

            SendStatusMessage (MESSAGE_SELCHAR, format ('某腐磐[%s]甫 急琶沁嚼聪促.', [UseChar]));
            if DBSender <> nil then begin
               DBSender.PutPacket (ConnectID, DB_SELECT, 0, @DBRecord, SizeOf (DBRecord.PrimaryKey));
            end;
         end;
   end;

   FLastMessage := msg^;
   RequestTime := timeGetTime;
end;

// TConnectorList
constructor TConnectorList.Create;
begin
   UniqueID := 0;
   UniqueValue := -1;

   FPlayingUserCount := 0;
   FLogingUserCount := 0;

   SocketKey := TIntegerKeyClass.Create;
   ConnectIDKey := TIntegerKeyClass.Create;

   DataList := TList.Create;
   DeleteList := TList.Create;

   CurProcessPos := 0;
   ProcessCount := 40;
end;

destructor TConnectorList.Destroy;
begin
   Clear;
   SocketKey.Free;
   ConnectIDKey.Free;
   DataList.Free;
   DeleteList.Free;

   inherited Destroy;
end;

procedure TConnectorList.Clear;
var
   i : Integer;
   Connector : TConnector;
   pd : PTConnectData;
begin
   FPlayingUserCount := 0;
   FLogingUserCount := 0;

   SocketKey.Clear;
   ConnectIDKey.Clear;
   
   for i := 0 to DataList.Count - 1 do begin
      Connector := DataList.Items [i];
      Connector.Free;
   end;
   DataList.Clear;

   for i := 0 to DeleteList.Count - 1 do begin
      pd := DeleteList.Items [i];
      Dispose (pd);
   end;
   DeleteList.Clear;
end;

function TConnectorList.GetCount : Integer;
begin
   Result := DataList.Count;
end;


function TConnectorList.CreateConnect (aSocket : TCustomWinSocket) : Boolean;
var
   Connector : TConnector;
begin
   Result := false;

   if UniqueValue = -1 then exit;
   
   Connector := TConnector.Create (aSocket, UniqueID + UniqueValue);

   SocketKey.Insert (Connector.SocketInt, Connector);
   ConnectIDKey.Insert (Connector.ConnectID, Connector);
   DataList.Add (Connector);

   Inc (UniqueID, 10);
   Inc (FLogingUserCount);

   Result := true;
end;

function TConnectorList.DeleteConnect (aSocket :  TCustomWinSocket) : String;
var
   pd : PTConnectData;
   Connector : TConnector;
begin
   Result := '';

   Connector := SocketKey.Select (Integer(aSocket));
   if Connector <> nil then begin
      Result := Connector.PlayCharName;
   end;

   New (pd);
   pd^.SocketInt := Integer (aSocket);

   DeleteList.Add (pd);
end;

procedure TConnectorList.AddReceiveData (aSocket : TCustomWinSocket; aData : PChar; aCount : Integer);
var
   Connector : TConnector;
begin
   Connector := SocketKey.Select (Integer(aSocket));
   if Connector <> nil then begin
      Connector.AddReceiveData (aData, aCount);
      exit;
   end;
end;

procedure TConnectorList.GameMessageProcess (aPacket : PTPacketData);
var
	i : Integer;
   Connector : TConnector;
   pDBRecord : PTDBRecord;
begin
   if aPacket^.RequestMsg = GM_SENDALL then begin
   	// Reverse4Bit (PTComData (@aPacket^.Data));
      for i := 0 to DataList.Count - 1 do begin
      	Connector := DataList.Items [i];
         Connector.GameMessageProcess (aPacket);
      end;
      exit;
   end;
   if aPacket^.RequestMsg = GM_UNIQUEVALUE then begin
      UniqueValue := aPacket^.RequestID;
      frmMain.Caption := format ('Gate Server [%d]', [UniqueValue]);
      exit;
   end;
   if aPacket^.RequestMsg = GM_CONNECT then begin
      Inc (FPlayingUserCount);
      Dec (FLogingUserCount);
   end;

   Connector := ConnectIDKey.Select (aPacket^.RequestID);
   if Connector <> nil then begin
      Connector.GameMessageProcess (aPacket);
      exit;
   end;

   if aPacket^.RequestMsg = GM_SENDUSERDATA then begin
      pDBRecord := @aPacket^.Data;
      if DBSender <> nil then begin
         DBSender.PutPacket (0, DB_UPDATE, 0, @aPacket^.Data, SizeOf (TDBRecord));
      end;
      frmMain.AddLog (format ('closing user data (%s)', [StrPas (@pDBRecord^.PrimaryKey)]));
   end else begin
      if GameSender <> nil then begin
         GameSender.PutPacket (aPacket^.RequestID, GM_DISCONNECT, 0, nil, 0);
      end;
      // frmMain.AddLog ('TConnectorList.GameMessageProcess failed');
   end;
end;

procedure TConnectorList.DBMessageProcess (aPacket : PTPacketData);
var
   Connector : TConnector;
   RecordData : TDBRecord;
begin
   if aPacket^.RequestMsg <> DB_UPDATE then begin
      Connector := ConnectIDKey.Select (aPacket^.RequestID);
      if Connector <> nil then begin
         Connector.DBMessageProcess (aPacket);
      end;
      // frmMain.AddLog ('TConnectorList.DBMessageProcess failed');
   end else begin
      Case aPacket^.RequestMsg of
         DB_UPDATE :
            begin
               if aPacket^.ResultCode = DB_OK then begin
                  Move (aPacket^.Data, RecordData.PrimaryKey, SizeOf (RecordData.PrimaryKey));
                  frmMain.AddLog (format ('user data saved [%s]', [StrPas (@RecordData.PrimaryKey)]));
               end else begin
                  Move (aPacket^.Data, RecordData.PrimaryKey, SizeOf (RecordData.PrimaryKey));
                  frmMain.AddLog (format ('user data save failed [%s]', [StrPas (@RecordData.PrimaryKey)]));
               end;
            end;
      end;
   end;
end;

procedure TConnectorList.LoginMessageProcess (aPacket : PTPacketData);
var
   Connector : TConnector;
begin
   Connector := ConnectIDKey.Select (aPacket^.RequestID);
   if Connector <> nil then begin
      Connector.LoginMessageProcess (aPacket);
   end;
   // frmMain.AddLog ('TConnectorList.LoginMessageProcess failed');
end;

procedure TConnectorList.PaidMessageProcess (aPacket : PTPacketData);
var
   Connector : TConnector;
begin
   Connector := ConnectIDKey.Select (aPacket^.RequestID);
   if Connector <> nil then begin
      Connector.PaidMessageProcess (aPacket);
   end;
   // frmMain.AddLog ('TConnectorList.PaidMessageProcess failed');
end;

function TConnectorList.Update (CurTick : Integer) : Boolean;
var
   i, nIndex : Integer;
   Connector : TConnector;
   pd : PTConnectData;
   StartPos : Word;
begin
   if DeleteList.Count > 0 then begin
      for i := 0 to DeleteList.Count - 1 do begin
         pd := DeleteList.Items [i];
         Connector := SocketKey.Select (pd^.SocketInt);
         if Connector <> nil then begin
            if Connector.GameStatus = gs_playing then begin
               Dec (FPlayingUserCount);
            end else begin
               Dec (FLogingUserCount);
            end;
            SocketKey.Delete (Connector.SocketInt);
            ConnectIDKey.Delete (Connector.ConnectID);

            Connector.Free;
            nIndex := DataList.IndexOf (Connector);
            if nIndex <> -1 then DataList.Delete (nIndex);
         end;
         Dispose (pd);
      end;
      DeleteList.Clear;
   end;

   if DataList.Count > 0 then begin
   	ProcessCount := DataList.Count * 4 div 100;
      if ProcessCount < 40 then ProcessCount := 40;
      StartPos := CurProcessPos;
      for i := 0 to ProcessCount - 1 do begin
         if CurProcessPos >= DataList.Count then CurProcessPos := 0;
         Connector := DataList.Items [CurProcessPos];
         Connector.Update (CurTick);
         Inc (CurProcessPos);
         if CurProcessPos >= DataList.Count then CurProcessPos := 0;
         if CurProcessPos = StartPos then break;
      end;
   end;

   Result := true;
end;

procedure TConnectorList.SetWriteAllow (aSocket : TCustomWinSocket);
var
   Connector : TConnector;
begin
   Connector := SocketKey.Select (Integer (aSocket));
   if Connector <> nil then begin
      Connector.SetWriteAllow;
      exit;
   end;
   // frmMain.AddLog ('TConnectorList.SetWriteAllow failed');
end;

procedure TConnectorList.ReCalc;
var
   i : Integer;
   Connector : TConnector;
begin
   FLogingUserCount := 0;
   FPlayingUserCount := 0;
   for i := 0 to DataList.Count - 1 do begin
      Connector := DataList.Items [i];
      if Connector.FGameStatus = gs_playing then begin
         Inc (FPlayingUserCount);
      end else begin
         Inc (FLogingUserCount);
      end;
   end;
end;

end.