lmain.~pas

翎风世界..传奇服务端..DELPHI源代码 包括DBServer,LogDataServer,LoginGate,LoginSrv,M2Server等..内容齐全.

  Config.boRemoteClose:=False;

  SendGameCenterMsg(SG_FORMHANDLE,IntToStr(Self.Handle));
  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]:='Server Name';
  MonitorGrid.Cells[1,0]:='Count';
  MonitorGrid.Cells[2,0]:='Status';
  MonitorGrid.Cells[3,0]:='Server Name';
  MonitorGrid.Cells[4,0]:='Count';
  MonitorGrid.Cells[5,0]:='Status';
end;

//00469598
procedure TFrmMain.FormDestroy(Sender : TObject);
var
  i,ii:integer;
  GateInfo:pTGateInfo;
  UserInfo:pTUserInfo;
  Config  :pTConfig;
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;
//0046A7F4
procedure TFrmMain.ExecTimerTimer(Sender : TObject);
var
  Config  :pTConfig;
begin
  Config:=@g_Config;
  if bo470D20 and not g_boDataDBReady then exit;
  bo470D20:=True;
  try
    ProcessGate(Config);
  finally
    bo470D20:=False;
  end;
end;
//0046D178
procedure TFrmMain.Memo1DblClick(Sender : TObject);
begin
  OpenRouteConfig();

end;

//0046A9BC
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:='Login (' + IntToStr(GSocket.Socket.ActiveConnections) + ')';
  LbMasCount.Caption:=IntToStr(nOnlineCountMin) + '/' + IntToStr(nOnlineCountMax);
  if Memo1.Lines.Count > 2000 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;

//0046A674
procedure TFrmMain.StartTimerTimer(Sender : TObject);
var
  Config  :pTConfig;
begin
  Config:=@g_Config;
  StartService(Config);
  SendGameCenterMsg(SG_STARTNOW,'正在启动登录服务器...');
  StartTimer.Enabled:=False;
  Memo1.Lines.Add('1) Server initializing...');
  Application.ProcessMessages;
  AccountDB:=TFileIDDB.Create(Config.sIdDir + 'Id.DB');
  ParseList.Resume;
  Memo1.Lines.Add('2) Waiting for server connection...');
  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) Server started...');
  ExecTimer.Enabled:=True;
  SendGameCenterMsg(SG_STARTOK,'登录服务器启动完成...');
end;

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


procedure TFrmMain.MENU_CONTROL_EXITClick(Sender: TObject);
begin
  Close;
end;
procedure TFrmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
//0x0046DDB0
var
  Config  :pTConfig;
ResourceString
  sExitMsg   = 'Do you want to exit Login-Server?';
  sExitTitle = 'Confirm';
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;


//0046DB40
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.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;
//0046ECB4
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)]:='Good'
      else MonitorGrid.Cells[nCol + 2,(I div 2 + 1)]:='Bad';
    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;
//0046F060
procedure TFrmMain.SpeedButton2Click(Sender : TObject);
begin
  if Memo1.Height = nMemoHeigh then Memo1.Height:= nMemoHeigh * 2
  else Memo1.Height:=nMemoHeigh;
end;

//0046A178
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;
//0046A23C
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;

//0046AC08
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;
          'A': begin
            sData:=GetValidStr3(sMsg,sSockIndex,['/']);
            ReceiveSendUser(Config,sSockIndex,GateInfo,sData);
          end;
          'O': begin
            sData:=GetValidStr3(sMsg,sSockIndex,['/']);
            ReceiveOpenUser(Config,sSockIndex,sData,GateInfo);
          end;
          'X': begin
            sSockIndex:=sMsg;
            ReceiveCloseUser(Config,sSockIndex,GateInfo);
          end;
        end;
      end else begin //0046AD85
        if nCount >= 1 then GateInfo.sReceiveMsg:='';
        Inc(nCount);
      end;
    end;
  except
    MainOutMessage('[Exception] TFrmMain.DecodeGateData');
  end;
end;
//0046A63C
procedure SendKeepAlivePacket(Socket: TCustomWinSocket);
begin
  if Socket.Connected then Socket.SendText('%++$');
end;
//0046B058
procedure ReceiveCloseUser(Config:pTConfig;sSockIndex: String;
  GateInfo: pTGateInfo);
var
  UserInfo :pTUserInfo;
  I        :Integer;
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;
//0046AE3C
procedure ReceiveOpenUser(Config:pTConfig;sSockIndex, sIPaddr: String;
  GateInfo: pTGateInfo);
var
  UserInfo    :pTUserInfo;
  I           :Integer;
  sGateIPaddr :String;