lmain.pas

重庆飞尔的登陆服务器管理系统(LoginServer)源代码

  UserInfo: pTUserInfo;
  IPaddr: pTSockaddr;
  I, II: Integer;
  nIPaddr: Integer;
  IPList: TList;
resourcestring
  sCloseMsg = 'Close: %s';
begin
  for I := 0 to GateInfo.UserList.Count - 1 do begin
    UserInfo := GateInfo.UserList.Items[I];
    if UserInfo.sSockIndex = sSockIndex then begin
      if Config.boShowDetailMsg then
        MainOutMessage(Format(sCloseMsg, [UserInfo.sUserIPaddr]));
      if not UserInfo.boSelServer then SessionDel(Config, UserInfo.nSessionID);
      Dispose(UserInfo);
      GateInfo.UserList.Delete(I);
      Break;
    end;
  end;
end;

procedure ReceiveOpenUser(Config: pTConfig; sSockIndex, sIPaddr: string;
  GateInfo: pTGateInfo);
var
  UserInfo: pTUserInfo;
  I: Integer;
  sGateIPaddr: string;
  sUserIPaddr: string;
resourcestring
  sOpenMsg = 'Open: %s/%s';
begin
  sGateIPaddr := GetValidStr3(sIPaddr, sUserIPaddr, ['/']);
  try
    for I := 0 to GateInfo.UserList.Count - 1 do begin
      UserInfo := GateInfo.UserList.Items[I];
      if UserInfo.sSockIndex = sSockIndex then begin
        UserInfo.sUserIPaddr := sUserIPaddr;
        UserInfo.sGateIPaddr := sGateIPaddr;
        UserInfo.sAccount := '';
        UserInfo.nSessionID := 0;
        UserInfo.sReceiveMsg := '';
        UserInfo.dwTime5C := GetTickCount();
        UserInfo.dwClientTick := GetTickCount();
        Exit;
      end;
    end;
    New(UserInfo);
    UserInfo.sAccount := '';
    UserInfo.sUserIPaddr := sUserIPaddr;
    UserInfo.sGateIPaddr := sGateIPaddr;
    UserInfo.sSockIndex := sSockIndex;
    UserInfo.nVersionDate := 0;
    UserInfo.boCertificationOK := False;
    UserInfo.nSessionID := 0;
    UserInfo.bo51 := False;
    UserInfo.Socket := GateInfo.Socket;
    UserInfo.sReceiveMsg := '';
    UserInfo.dwTime5C := GetTickCount();
    UserInfo.dwClientTick := GetTickCount();
    UserInfo.bo60 := False;
    UserInfo.nRandomCode := Random(9999);
    UserInfo.boRandomCode := False;
    UserInfo.Gate := GateInfo;
    GateInfo.UserList.Add(UserInfo);
    if Config.boShowDetailMsg then
      MainOutMessage(Format(sOpenMsg, [sUserIPaddr, sGateIPaddr]));
  except
    MainOutMessage('TFrmMain.ReceiveOpenUser');
  end;
end;

procedure ReceiveSendUser(Config: pTConfig; sSockIndex: string;
  GateInfo: pTGateInfo; sData: string);
var
  UserInfo: pTUserInfo;
  I: Integer;
begin
  try
    for I := 0 to GateInfo.UserList.Count - 1 do begin
      UserInfo := GateInfo.UserList.Items[I];
      if UserInfo.sSockIndex = sSockIndex then begin
        if Length(UserInfo.sReceiveMsg) < 4069 then begin
          UserInfo.sReceiveMsg := UserInfo.sReceiveMsg + sData;
        end;
        Break;
      end;
    end;
  except
    MainOutMessage('TFrmMain.ReceiveSendUser');
  end;
end;

procedure SessionClearKick(Config: pTConfig);
var
  I: Integer;
  ConnInfo: pTConnInfo;
begin
  Config.SessionList.Lock;
  try
    for I := Config.SessionList.Count - 1 downto 0 do begin
      ConnInfo := Config.SessionList.Items[I];
      if ConnInfo.boKicked and ((GetTickCount - ConnInfo.dwKickTick) > 5 * 1000) then begin
        Dispose(ConnInfo);
        Config.SessionList.Delete(I);
      end;
    end;
  finally
    Config.SessionList.UnLock;
  end;
end;

procedure DecodeUserData(Config: pTConfig; UserInfo: pTUserInfo);
var
  sMsg: string;
  nCount: Integer;
begin
  nCount := 0;
  try
    //if UserInfo = nil then nErrCode:=1;
    while (True) do begin
      if TagCount(UserInfo.sReceiveMsg, '!') <= 0 then Break;
      UserInfo.sReceiveMsg := ArrestStringEx(UserInfo.sReceiveMsg, '#', '!', sMsg);
      if sMsg <> '' then begin
        if Length(sMsg) >= DEFBLOCKSIZE + 1 then begin
          sMsg := Copy(sMsg, 2, Length(sMsg) - 1);
          ProcessUserMsg(Config, UserInfo, sMsg);
        end;
      end else begin
        if nCount >= 1 then UserInfo.sReceiveMsg := '';
        Inc(nCount);
      end;
      if UserInfo.sReceiveMsg = '' then Break;
    end;
  except
    MainOutMessage('[Exception] TFrmMain.DecodeUserData ');
  end;
end;

procedure SessionDel(Config: pTConfig; nSessionID: Integer);
var
  ConnInfo: pTConnInfo;
  I: Integer;
begin
  Config.SessionList.Lock;
  try
    for I := 0 to Config.SessionList.Count - 1 do begin
      ConnInfo := Config.SessionList.Items[I];
      if ConnInfo.nSessionID = nSessionID then begin
        Dispose(ConnInfo);
        Config.SessionList.Delete(I);
        Break;
      end;
    end;
  finally
    Config.SessionList.UnLock;
  end;
end;

procedure SendRandomCode(UserInfo: pTUserInfo);
var
  DefMsg: TDefaultMessage;
  sRandomCode: string;
begin
  UserInfo.nRandomCode := Random(9999 - 1000) + 1000;
  DefMsg := MakeDefaultMsg(SM_RANDOMCODE, 0, 0, 0, 0);
  Encode(IntToStr(UserInfo.nRandomCode), sRandomCode);
  SendGateMsg(UserInfo.Socket, UserInfo.sSockIndex, EncodeMessage(DefMsg) + EncodeString(sRandomCode));
end;

procedure ProcessUserMsg(Config: pTConfig; UserInfo: pTUserInfo; sMsg: string);
var
  sDefMsg: string;
  sData: string;
  DefMsg: TDefaultMessage;
begin
  try
    sDefMsg := Copy(sMsg, 1, DEFBLOCKSIZE);
    sData := Copy(sMsg, DEFBLOCKSIZE + 1, Length(sMsg) - DEFBLOCKSIZE);
    DefMsg := DecodeMessage(sDefMsg);
    //AddLogMsg('Code: ' + IntToStr(DefMsg.Ident) + ' Msg: ' + sData,0);
    case DefMsg.Ident of
      CM_RANDOMCODE: begin
          SendRandomCode(UserInfo);
        end;

      CM_SELECTSERVER: begin
          if not UserInfo.boSelServer then begin
            AccountSelectServer(Config, UserInfo, sData);
          end;
        end;
      CM_PROTOCOL: begin
          AccountCheckProtocol(UserInfo, DefMsg.Recog);
        end;
      CM_IDPASSWORD: begin
          if UserInfo.sAccount = '' then begin
            AccountLogin(Config, UserInfo, sData);
          end else begin
            KickUser(Config, UserInfo, 0);
          end;
        end;
      CM_ADDNEWUSER: begin
          if Config.boEnableMakingID then begin
            if (GetTickCount - UserInfo.dwClientTick) > 5000 then begin
              UserInfo.dwClientTick := GetTickCount();
              AccountCreate(Config, @DefMsg, UserInfo, sData);
            end else begin
              if FrmMain.CheckBoxAttack.Checked then begin
                KickUser(Config, UserInfo, 2);
              end;
              MainOutMessage('[超速操作] 创建帐号 ' + '/' + UserInfo.sUserIPaddr);
            end;
          end;
        end;
      CM_CHANGEPASSWORD: begin
          if UserInfo.sAccount = '' then begin
            if (GetTickCount - UserInfo.dwClientTick) > 5000 then begin
              UserInfo.dwClientTick := GetTickCount();
              AccountChangePassword(Config, UserInfo, sData);
            end else begin
              if FrmMain.CheckBoxAttack.Checked then begin
                KickUser(Config, UserInfo, 1);
              end;
              MainOutMessage('[超速操作] 修改密码 ' + '/' + UserInfo.sUserIPaddr);
            end;
          end else UserInfo.sAccount := '';
        end;
      CM_UPDATEUSER: begin
          if (GetTickCount - UserInfo.dwClientTick) > 5000 then begin
            UserInfo.dwClientTick := GetTickCount();
            AccountUpdateUserInfo(Config, UserInfo, sData);
          end else begin
            if FrmMain.CheckBoxAttack.Checked then begin
              KickUser(Config, UserInfo, 1);
            end;
            MainOutMessage('[超速操作] 更新帐号 ' + '/' + UserInfo.sUserIPaddr);
          end;
        end;
      CM_GETBACKPASSWORD: begin
          if Config.boEnableGetbackPassword then begin
            if (GetTickCount - UserInfo.dwClientTick) > 5000 then begin
              UserInfo.dwClientTick := GetTickCount();
              AccountGetBackPassword(UserInfo, sData);
            end else begin
              if FrmMain.CheckBoxAttack.Checked then begin
                KickUser(Config, UserInfo, 1);
              end;
              MainOutMessage('[超速操作] 找回密码 ' + '/' + UserInfo.sUserIPaddr);
            end;
          end;
        end;
    end;
  except
    MainOutMessage('[Exception] TFrmMain.ProcessUserMsg ' + 'wIdent: ' + IntToStr(DefMsg.Ident) + ' sData: ' + sData);
  end;
end;

procedure AccountCreate(Config: pTConfig; Msg: pTDefaultMessage; UserInfo: pTUserInfo; sData: string);
var
  UserEntry: TUserEntry;
  UserAddEntry: TUserEntryAdd;
  DBRecord: TAccountDBRecord;
  nLen: Integer;
  sUserEntryMsg: string;
  sUserAddEntryMsg: string;
  nErrCode: Integer;
  DefMsg: TDefaultMessage;
  bo21: Boolean;
  n10: Integer;
resourcestring
  sAddNewuserFail = '[新建帐号失败] %s/%s';
  sLogFlag = 'new';
begin
  try
    nErrCode := 1;
    if Config.boRandomCode and (UserInfo.nRandomCode <> Msg.Recog) then begin
      DefMsg := MakeDefaultMsg(SM_NEWID_FAIL, nErrCode, 0, 0, 0);
    end else begin
      nErrCode := -1;
      FillChar(UserEntry, SizeOf(TUserEntry), #0);
      FillChar(UserAddEntry, SizeOf(TUserEntryAdd), #0);
      nLen := GetCodeMsgSize(SizeOf(TUserEntry) * 4 / 3);
      bo21 := False;
      sUserEntryMsg := Copy(sData, 1, nLen);
      sUserAddEntryMsg := Copy(sData, nLen + 1, Length(sData) - nLen);
      if (sUserEntryMsg <> '') and (sUserAddEntryMsg <> '') then begin
        DecodeBuffer(sUserEntryMsg, @UserEntry, SizeOf(TUserEntry));
        DecodeBuffer(sUserAddEntryMsg, @UserAddEntry, SizeOf(TUserEntryAdd));
        if CheckAccountName(UserEntry.sAccount) then bo21 := True;
        if bo21 then begin
          try
            if AccountDB.Open then begin
              n10 := AccountDB.Index(UserEntry.sAccount);
              if n10 < 0 then begin
                FillChar(DBRecord, SizeOf(TAccountDBRecord), #0);
                DBRecord.UserEntry := UserEntry;
                DBRecord.UserEntryAdd := UserAddEntry;
                if UserEntry.sAccount <> '' then begin
                  if AccountDB.Add(DBRecord) then begin
                    nErrCode := 1;
                  end;
                end;
              end else nErrCode := 0;
            end;
          finally
            AccountDB.Close;
          end;
        end else begin
          MainOutMessage(Format(sAddNewuserFail, [UserEntry.sAccount, UserAddEntry.sQuiz2]));
        end;
      end;
      if nErrCode = 1 then begin
        WriteLogMsg(Config, sLogFlag, UserEntry, UserAddEntry);
        DefMsg := MakeDefaultMsg(SM_NEWID_SUCCESS, 0, 0, 0, 0);
      end else begin
        DefMsg := MakeDefaultMsg(SM_NEWID_FAIL, nErrCode, 0, 0, 0);
      end;
    end;
    SendGateMsg(UserInfo.Socket, UserInfo.sSockIndex, EncodeMessage(DefMsg));
  except
    MainOutMessage('TFrmMain.AddNewUser');
  end;
end;

procedure AccountChangePassword(Config: pTConfig; UserInfo: pTUserInfo; sData: string);
var
  sMsg: string;
  sLoginID: string;
  sOldPassword: string;
  sNewPassword: string;
  DefMsg: TDefaultMessage;
  nCode: Integer;
  n10: Integer;
  DBRecord: TAccountDBRecord;
resourcestring
  sChgMsg = 'chg';
begin
  try
    sMsg := DecodeString(sData);
    sMsg := GetValidStr3(sMsg, sLoginID, [#9]);
    sNewPassword := GetValidStr3(sMsg, sOldPassword, [#9]);
    nCode := 0;
    try
      if AccountDB.Open and (Length(sNewPassword) >= 3) then begin
        n10 := AccountDB.Index(sLoginID);
        if (n10 >= 0) and (AccountDB.Get(n10, DBRecord) >= 0) then begin
          //if (DBRecord.nErrorCount >= 5) or ((GetTickCount - DBRecord.dwActionTick) > 180000) then begin
          if (DBRecord.nErrorCount < 5) or ((GetTickCount - DBRecord.dwActionTick) > 180000) then begin
            if DBRecord.UserEntry.sPassword = sOldPassword then begin
              DBRecord.nErrorCount := 0;
              DBRecord.UserEntry.sPassword := sNewPassword;
              nCode := 1;
            end else begin
              Inc(DBRecord.nErrorCount);
              DBRecord.dwActionTick := GetTickCount();
              nCode := -1;
            end;
            AccountDB.Update(n10, DBRecord);
          end else begin
            nCode := -2;
            if GetTickCount < DBRecord.dwActionTick then begin
              DBRecord.dwActionTick := GetTickCount();
              AccountDB.Update(n10, DBRecord);
            end;
          end;
        end;
      end;
    finally
      AccountDB.Close;
    end;
    if nCode = 1 then begin
      DefMsg := MakeDefaultMsg(SM_CHGPASSWD_SUCCESS, 0, 0, 0, 0);
      WriteLogMsg(Config, sChgMsg, DBRecord.UserEntry, DBRecord.UserEntryAdd);
    end else begin
      DefMsg := MakeDefaultMsg(SM_CHGPASSWD_FAIL, nCode, 0, 0, 0);
    end;
    SendGateMsg(UserInfo.Socket, UserInfo.sSockIndex, EncodeMessage(DefMsg));
  except
    MainOutMessage('TFrmMain.ChangePassword');
  end;
end;

procedure AccountCheckProtocol(UserInfo: pTUserInfo; nDate: Integer);
var
  DefMsg: TDefaultMessage;
begin
  //MainOutMessage(IntToStr(nVersionDate));
  if nDate < nVersionDate then begin
    DefMsg := MakeDefaultMsg(SM_CERTIFICATION_FAIL, 0, 0, 0, 0);
  end else begin
    DefMsg := MakeDefaultMsg(SM_CERTIFICATION_SUCCESS, 0, 0, 0, 0);
    UserInfo.nVersionDate := nDate;
    UserInfo.boCertificationOK := True;
  end;
  SendGateMsg(UserInfo.Socket, UserInfo.sSockIndex, EncodeMessage(DefMsg));
end;