lmain.pas

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

  GenServerNameList(Config);
end;

procedure TFrmMain.FormCreate(Sender: TObject);
var
  nX, nY: Integer;
  Config: pTConfig;
begin
  Config := @g_Config;
  g_dwGameCenterHandle := Str_ToInt(ParamStr(1), 0);
  nX := Str_ToInt(ParamStr(2), -1);
  nY := Str_ToInt(ParamStr(3), -1);
  if (nX >= 0) or (nY >= 0) then begin
    Left := nX;
    Top := nY;
  end;
  Config.boRemoteClose := False;
  SendGameCenterMsg(SG_FORMHANDLE, IntToStr(Self.Handle));

  Config := @g_Config;
  StartService(Config);

  AccountDB := nil;
  //  g_MainMsgList:=TStringList.Create;
  CS_DB := TCriticalSection.Create;
  StringList_0 := TStringList.Create;
  nSessionIdx := 1;
  n47328C := 1;
  nMemoHeigh := Memo1.Height;

  Config.GateList := TList.Create;
  Config.SessionList := TGList.Create;
  Config.ServerNameList := TStringList.Create;
  SList_0344 := TStringList.Create;
  Config.AccountCostList := TQuickList.Create;
  Config.IPaddrCostList := TQuickList.Create;
  ParseList := TThreadParseList.Create(True);

  LoadAddrTable(Config);
  MonitorGrid.Cells[0, 0] := '服务器名';
  MonitorGrid.Cells[1, 0] := '用户数';
  MonitorGrid.Cells[2, 0] := '状态';
  MonitorGrid.Cells[3, 0] := '服务器名';
  MonitorGrid.Cells[4, 0] := '用户数';
  MonitorGrid.Cells[5, 0] := '状态';
end;

procedure TFrmMain.FormDestroy(Sender: TObject);
var
  I, II: Integer;
  GateInfo: pTGateInfo;
  UserInfo: pTUserInfo;
  Config: pTConfig;
  IPList: TList;
begin
  Config := @g_Config;
  StopService(Config);
  if AccountDB <> nil then AccountDB.Free;
  for I := 0 to Config.GateList.Count - 1 do begin
    GateInfo := Config.GateList.Items[I];
    for II := 0 to GateInfo.UserList.Count - 1 do begin
      UserInfo := GateInfo.UserList.Items[I];
      Dispose(UserInfo);
    end;
    GateInfo.UserList.Free;
    Dispose(GateInfo);
  end;
  Config.GateList.Free;
  Config.SessionList.Free;
  Config.ServerNameList.Free;

  SList_0344.Free;
  StringList_0.Free;
  CS_DB.Free;
end;

procedure TFrmMain.ExecTimerTimer(Sender: TObject);
var
  Config: pTConfig;
  ConnInfo: pTConnInfo;
begin
  Config := @g_Config;
  if bo470D20 and not g_boDataDBReady then Exit;
  bo470D20 := True;
  try
    ProcessGate(Config);
    {if (Config.SessionList<>nil) and (Config.SessionList.Count>0) then begin
      ConnInfo:=pTConnInfo(Config.SessionList.Items[0]);
      Memo1.Lines.Add(ConnInfo.sAccount);
    end;}
  finally
    bo470D20 := False;
  end;
end;

procedure TFrmMain.Memo1DblClick(Sender: TObject);
begin
  OpenRouteConfig();
end;

procedure TFrmMain.Timer1Timer(Sender: TObject);
var
  I: Integer;
var
  Config: pTConfig;
begin
  Config := @g_Config;
  Label1.Caption := IntToStr(Config.dwProcessGateTime);
  CkLogin.Checked := GSocket.Socket.Connected;
  CkLogin.Caption := '连接 (' + IntToStr(GSocket.Socket.ActiveConnections) + ')';
  LbMasCount.Caption := IntToStr(nOnlineCountMin) + '/' + IntToStr(nOnlineCountMax);
  if Memo1.Lines.Count > 200 then Memo1.Clear;
  EnterCriticalSection(g_OutMessageCS);
  try
    for I := 0 to g_MainMsgList.Count - 1 do begin
      Memo1.Lines.Add(g_MainMsgList.Strings[I]);
    end;
    g_MainMsgList.Clear;
  finally
    LeaveCriticalSection(g_OutMessageCS);
  end;
  I := 0;
  while (True) do begin
    if StringList_0.Count <= I then Break;
    if GetTickCount - LongWord(StringList_0.Objects[I]) > 60000 then begin
      StringList_0.Delete(I);
      Continue;
    end;
    Inc(I);
  end;
  SessionClearKick(Config);
  SessionClearNoPayMent(Config);
end;

procedure TFrmMain.StartTimerTimer(Sender: TObject);
var
  Config: pTConfig;
begin
  StartTimer.Enabled := False;
  Config := @g_Config;
  SendGameCenterMsg(SG_STARTNOW, '正在启动登录服务器...');
  Memo1.Lines.Add('1) 正在启动服务器...');
  Application.ProcessMessages;
  AccountDB := TFileIDDB.Create(Config.sIdDir + 'Id.DB');
  ParseList.Resume;
  Memo1.Lines.Add('2) 正在等待服务器连接...');
  while (True) do begin
    Application.ProcessMessages;
    if Application.Terminated then Exit;
    if FrmMasSoc.CheckReadyServers then Break;
    Sleep(1);
  end;
  GSocket.Active := False;
  GSocket.Address := Config.sGateAddr;
  GSocket.Port := Config.nGatePort;
  GSocket.Active := True;
  Memo1.Lines.Add('3) 服务器启动完成...');
  ExecTimer.Enabled := True;
  SendGameCenterMsg(SG_STARTOK, '登录服务器启动完成...');
  if Config.boMinimize then Application.Minimize;
end;

procedure TFrmMain.SpeedButton1Click(Sender: TObject);
begin
  FrmFindUserId.Top := Top;
  FrmFindUserId.Left := Left;
  FrmFindUserId.Show;
end;

procedure TFrmMain.MENU_CONTROL_EXITClick(Sender: TObject);
begin
  Close;
end;

procedure TFrmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
var
  Config: pTConfig;
resourcestring
  sExitMsg = '是否确认停止登录服务器 ?';
  sExitTitle = '确认信息';
begin
  Config := @g_Config;
  if Config.boRemoteClose then Exit;
  if MessageBox(Handle, PChar(sExitMsg), PChar(sExitTitle), MB_YESNO + MB_ICONQUESTION) = mrYes then
    CanClose := True
  else CanClose := False;
end;

procedure TFrmMain.BtnViewClick(Sender: TObject);
var
  Config: pTConfig;
begin
  Config := @g_Config;
  try
    CS_DB.Enter;
    FrmAccountView.ListBox1.Items := Config.AccountCostList;
    FrmAccountView.ListBox2.Items := Config.IPaddrCostList;
  finally
    CS_DB.Leave;
  end;
  FrmAccountView.Top := Top;
  FrmAccountView.Left := Left;
  FrmAccountView.ShowModal;
end;

procedure TFrmMain.CountLogTimerTimer(Sender: TObject);
var
  sLogMsg: string;
  Config: pTConfig;
resourcestring
  sFormatMsg = '%d/%d';
begin
  Config := @g_Config;
  sLogMsg := Format(sFormatMsg, [nOnlineCountMin, nOnlineCountMax]);
  SaveContLogMsg(Config, sLogMsg);
  nOnlineCountMax := 0;
end;

procedure TFrmMain.BtnShowServerUsersClick(Sender: TObject);
var
  I: Integer;
begin
  for I := 0 to nUserLimit - 1 do begin
    MainOutMessage(UserLimit[I].sServerName + ' ' + IntToStr(UserLimit[I].nLimitCountMin) + '/' + IntToStr(UserLimit[I].nLimitCountMax));
  end;
end;

procedure TFrmMain.MonitorTimerTimer(Sender: TObject);
var
  I: Integer;
  nCol: Integer;
  sServerName: string;
  ServerList: TList;
  MsgServer: pTMsgServerInfo;
begin
  try
    ServerList := FrmMasSoc.m_ServerList;
    if (ServerList.Count div 2) < 2 then begin
      MonitorGrid.RowCount := 2;
      MonitorGrid.Cells[0, 1] := '';
      MonitorGrid.Cells[1, 1] := '';
      MonitorGrid.Cells[2, 1] := '';
      MonitorGrid.Cells[3, 1] := '';
      MonitorGrid.Cells[4, 1] := '';
      MonitorGrid.Cells[5, 1] := '';
    end else begin
      MonitorGrid.RowCount := ((ServerList.Count div 2) + 1) + (ServerList.Count mod 2);
    end; //0046ED54
    for I := 0 to ServerList.Count - 1 do begin
      nCol := (I mod 2) * 3;
      MsgServer := ServerList.Items[I];
      sServerName := MsgServer.sServerName;
      if sServerName <> '' then begin
        if MsgServer.nServerIndex = 99 then
          MonitorGrid.Cells[nCol, (I div 2 + 1)] := sServerName + ' [DB]'
        else MonitorGrid.Cells[nCol, (I div 2 + 1)] := sServerName + ' ' + IntToStr(MsgServer.nServerIndex);
        MonitorGrid.Cells[nCol + 1, (I div 2 + 1)] := IntToStr(MsgServer.nOnlineCount);
        if (GetTickCount - MsgServer.dwKeepAliveTick) < 30000 then
          MonitorGrid.Cells[nCol + 2, (I div 2 + 1)] := '正常'
        else MonitorGrid.Cells[nCol + 2, (I div 2 + 1)] := '超时';
      end else begin //0046EEF2
        MonitorGrid.Cells[nCol, (I div 2 + 1)] := '-';
        MonitorGrid.Cells[nCol + 1, (I div 2 + 1)] := '-';
        MonitorGrid.Cells[nCol + 2, (I div 2 + 1)] := '-';
      end;
    end;
  except
    MainOutMessage('TFrmMain.MonitorTimerTimer');
  end;
end;

procedure TFrmMain.SpeedButton2Click(Sender: TObject);
begin
  if Memo1.Height = nMemoHeigh then Memo1.Height := nMemoHeigh * 3
  else Memo1.Height := nMemoHeigh;
end;

function IsPayMent(Config: pTConfig; sIPaddr, sAccount: string): Boolean;
begin
  Result := False;
  try
    CS_DB.Enter;
    if (Config.AccountCostList.GetIndex(sAccount) >= 0) or (Config.IPaddrCostList.GetIndex(sIPaddr) >= 0) then
      Result := True;
  finally
    CS_DB.Leave;
  end;
end;

procedure CloseUser(Config: pTConfig; sAccount: string; nSessionID: Integer);
var
  ConnInfo: pTConnInfo;
  I: Integer;
begin
  Config.SessionList.Lock;
  try
    for I := Config.SessionList.Count - 1 downto 0 do begin
      ConnInfo := Config.SessionList.Items[I];
      if (ConnInfo.sAccount = sAccount) or (ConnInfo.nSessionID = nSessionID) then begin
        FrmMasSoc.SendServerMsg(SS_CLOSESESSION, ConnInfo.sServerName, ConnInfo.sAccount + '/' + IntToStr(ConnInfo.nSessionID));
        Dispose(ConnInfo);
        Config.SessionList.Delete(I);
      end;
    end;
  finally
    Config.SessionList.UnLock;
  end;
end;

procedure ProcessGate(Config: pTConfig);
var
  I: Integer;
  II: Integer;
  GateInfo: pTGateInfo;
  UserInfo: pTUserInfo;
begin
  EnterCriticalSection(Config.GateCriticalSection);
  try
    Config.dwProcessGateTick := GetTickCount();
    I := 0;
    while (True) do begin
      if Config.GateList.Count <= I then Break;
      GateInfo := Config.GateList.Items[I];
      if GateInfo.sReceiveMsg <> '' then begin
        DecodeGateData(Config, GateInfo);
        Config.sGateIPaddr := GateInfo.sIPaddr;
        II := 0;
        while (True) do begin
          if GateInfo.UserList.Count <= II then Break;
          UserInfo := GateInfo.UserList.Items[II];
          if UserInfo.sReceiveMsg <> '' then DecodeUserData(Config, UserInfo);
          Inc(II);
        end;
      end;
      Inc(I);
    end;
    if Config.dwProcessGateTime < Config.dwProcessGateTick then
      Config.dwProcessGateTime := GetTickCount - Config.dwProcessGateTick;
    if Config.dwProcessGateTime > 100 then Dec(Config.dwProcessGateTime, 100);
  finally
    LeaveCriticalSection(Config.GateCriticalSection);
  end;
end;

procedure DecodeGateData(Config: pTConfig; GateInfo: pTGateInfo);
var
  nCount: Integer;
  sMsg: string;
  sSockIndex: string;
  sData: string;
  Code: Char;
begin
  try
    nCount := 0;
    while (True) do begin
      if TagCount(GateInfo.sReceiveMsg, '$') <= 0 then Break;
      GateInfo.sReceiveMsg := ArrestStringEx(GateInfo.sReceiveMsg, '%', '$', sMsg);
      if sMsg <> '' then begin
        Code := sMsg[1];
        sMsg := Copy(sMsg, 2, Length(sMsg) - 1);
        case Code of
          '-': begin
              SendKeepAlivePacket(GateInfo.Socket);
              GateInfo.dwKeepAliveTick := GetTickCount();
            end;
          'D': begin
              sData := GetValidStr3(sMsg, sSockIndex, ['/']);
              ReceiveSendUser(Config, sSockIndex, GateInfo, sData);
            end;
          'N': begin
              sData := GetValidStr3(sMsg, sSockIndex, ['/']);
              ReceiveOpenUser(Config, sSockIndex, sData, GateInfo);
            end;
          'C': begin
              sSockIndex := sMsg;
              ReceiveCloseUser(Config, sSockIndex, GateInfo);
            end;
        end;
      end else begin
        if nCount >= 1 then GateInfo.sReceiveMsg := '';
        Inc(nCount);
      end;
    end;
  except
    MainOutMessage('[Exception] TFrmMain.DecodeGateData');
  end;
end;

procedure SendKeepAlivePacket(Socket: TCustomWinSocket);
begin
  if Socket.Connected then Socket.SendText('%++$');
end;

procedure ReceiveCloseUser(Config: pTConfig; sSockIndex: string;
  GateInfo: pTGateInfo);
var