⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 lmain.pas

📁 重庆飞尔的登陆服务器管理系统(LoginServer)源代码
💻 PAS
📖 第 1 页 / 共 5 页
字号:
          end;
        end;
      end;
    end;
  finally
    AccountDB.Close;
  end;
  if nCode = 1 then begin
    DefMsg := MakeDefaultMsg(SM_GETBACKPASSWD_SUCCESS, 0, 0, 0, 0);
    SendGateMsg(UserInfo.Socket, UserInfo.sSockIndex, EncodeMessage(DefMsg) + EncodeString(sPassword));
  end else begin
    DefMsg := MakeDefaultMsg(SM_GETBACKPASSWD_FAIL, nCode, 0, 0, 0);
    SendGateMsg(UserInfo.Socket, UserInfo.sSockIndex, EncodeMessage(DefMsg));
  end;
end;

procedure SendGateMsg(Socket: TCustomWinSocket; sSockIndex,
  sMsg: string);
var
  sSendMsg: string;
begin
  if (Socket <> nil) and Socket.Connected then begin
    sSendMsg := '%' + sSockIndex + '/#' + sMsg + '!$';
    Socket.SendText(sSendMsg);
  end;
end;

function IsLogin(Config: pTConfig; nSessionID: Integer): Boolean;
var
  ConnInfo: pTConnInfo;
  I: Integer;
begin
  Result := False;
  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
        Result := True;
        Break;
      end;
    end;
  finally
    Config.SessionList.UnLock;
  end;
end;

function IsLogin(Config: pTConfig; sLoginID: string): Boolean;
var
  ConnInfo: pTConnInfo;
  I: Integer;
begin
  Result := False;
  Config.SessionList.Lock;
  try
    for I := 0 to Config.SessionList.Count - 1 do begin
      ConnInfo := Config.SessionList.Items[I];
      if (ConnInfo.sAccount = sLoginID) then begin
        Result := True;
        Break;
      end;
    end;
  finally
    Config.SessionList.UnLock;
  end;
end;

procedure SessionKick(Config: pTConfig; sLoginID: string);
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.sAccount = sLoginID) and not ConnInfo.boKicked then begin
        FrmMasSoc.SendServerMsg(SS_CLOSESESSION, ConnInfo.sServerName, ConnInfo.sAccount + '/' + IntToStr(ConnInfo.nSessionID));
        ConnInfo.dwKickTick := GetTickCount();
        ConnInfo.boKicked := True;
      end;
    end;
  finally
    Config.SessionList.UnLock;
  end;
end;

procedure SessionAdd(Config: pTConfig; sAccount, sIPaddr: string;
  nSessionID: Integer; boPayCost, bo11: Boolean);
var
  ConnInfo: pTConnInfo;
begin
  New(ConnInfo);
  ConnInfo.sAccount := sAccount;
  ConnInfo.sIPaddr := sIPaddr;
  ConnInfo.nSessionID := nSessionID;
  ConnInfo.boPayCost := boPayCost;
  ConnInfo.bo11 := bo11;
  ConnInfo.dwKickTick := GetTickCount();
  ConnInfo.dwStartTick := GetTickCount();
  ConnInfo.boKicked := False;
  Config.SessionList.Lock;
  try
    Config.SessionList.Add(ConnInfo);
  finally
    Config.SessionList.UnLock;
  end;
end;

procedure SendGateKickMsg(Socket: TCustomWinSocket;
  sSockIndex: string);
var
  sSendMsg: string;
begin
  if (Socket <> nil) and Socket.Connected then begin
    sSendMsg := '%+-' + sSockIndex + '$';
    Socket.SendText(sSendMsg);
  end;
end;

procedure SendGateAddBlockList(Socket: TCustomWinSocket;
  sSockIndex: string);
var
  sSendMsg: string;
begin
  if (Socket <> nil) and Socket.Connected then begin
    sSendMsg := '%+B' + sSockIndex + '$';
    Socket.SendText(sSendMsg);
  end;
end;

procedure SendGateAddTempBlockList(Socket: TCustomWinSocket;
  sSockIndex: string);
var
  sSendMsg: string;
begin
  if (Socket <> nil) and Socket.Connected then begin
    sSendMsg := '%+T' + sSockIndex + '$';
    Socket.SendText(sSendMsg);
  end;
end;

procedure SessionUpdate(Config: pTConfig; nSessionID: Integer; sServerName: string; boPayCost: Boolean);
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
        ConnInfo.sServerName := sServerName;
        ConnInfo.bo11 := boPayCost;
        Break;
      end;
    end;
  finally
    Config.SessionList.UnLock;
  end;
end;

procedure GenServerNameList(Config: pTConfig);
var
  I, II: Integer;
  boD: Boolean;
begin
  try
    Config.ServerNameList.Clear;
    for I := 0 to Config.nRouteCount - 1 do begin
      boD := True;
      for II := 0 to Config.ServerNameList.Count - 1 do begin
        if Config.ServerNameList.Strings[II] = Config.GateRoute[I].sServerName then boD := False;
      end;
      if boD then Config.ServerNameList.Add(Config.GateRoute[I].sServerName);
    end;
  except
    MainOutMessage('TFrmMain.GenServerNameList');
  end;
end;

procedure SessionClearNoPayMent(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 not ConnInfo.boKicked and not Config.boTestServer and not ConnInfo.bo11 then begin
        if (GetTickCount - ConnInfo.dwStartTick) > 60 * 60 * 1000 then begin
          ConnInfo.dwStartTick := GetTickCount();
          if not IsPayMent(Config, ConnInfo.sIPaddr, ConnInfo.sAccount) then begin
            FrmMasSoc.SendServerMsg(SS_KICKUSER, ConnInfo.sServerName, ConnInfo.sAccount + '/' + IntToStr(ConnInfo.nSessionID));
            Dispose(ConnInfo);
            Config.SessionList.Delete(I);
          end;
        end;
      end;
    end;
  finally
    Config.SessionList.UnLock;
  end;
end;

procedure LoadIPaddrCostList(Config: pTConfig; QuickList: TQuickList);
begin
  try
    CS_DB.Enter;
    Config.IPaddrCostList.Clear;
    Config.IPaddrCostList.AddStrings(QuickList);
  finally
    CS_DB.Leave;
  end;
end;

procedure LoadAccountCostList(Config: pTConfig; QuickList: TQuickList);
begin
  try
    CS_DB.Enter;
    Config.AccountCostList.Clear;
    Config.AccountCostList.AddStrings(QuickList);
  finally
    CS_DB.Leave;
  end;
end;

procedure TFrmMain.Panel2DblClick(Sender: TObject);
begin
  MainOutMessage(GetServerListInfo);
end;

procedure TFrmMain.MyMessage(var MsgData: TWmCopyData);
var
  sData: string;
  wIdent: Word;
  Config: pTConfig;
begin
  Config := @g_Config;
  wIdent := HiWord(MsgData.From);
  sData := StrPas(MsgData.CopyDataStruct^.lpData);
  case wIdent of
    GS_QUIT: begin
        Config.boRemoteClose := True;
        Close();
      end;
    GS_USERACCOUNT: begin //控制台查找账号
        GameCenterGetUserAccount(sData);
      end;
    GS_CHANGEACCOUNTINFO: GameCenterChangeAccountInfo(sData); //控制台修改账号
    3: ;
  end;
end;

procedure TFrmMain.GameCenterGetUserAccount(sData: string);
var
  DBRecord: TAccountDBRecord;
  nIndex: Integer;
  nCode: Integer;
  DefMsg: TDefaultMessage;
begin
  try
    nCode := -1;
    if AccountDB.Open then begin
      nIndex := AccountDB.Index(sData);
      if (nIndex >= 0) and (AccountDB.Get(nIndex, DBRecord) >= 0) then begin
        nCode := 1;
      end;
    end;
  finally
    AccountDB.Close;
  end;
  if nCode > 0 then begin
    DefMsg := MakeDefaultMsg(0, nCode, 0, 0, 0);
    SendGameCenterMsg(SG_USERACCOUNT, EncodeMessage(DefMsg) + EncodeBuffer(@DBRecord, SizeOf(DBRecord)));
  end else begin
    DefMsg := MakeDefaultMsg(SG_USERACCOUNTNOTFOUND, nCode, 0, 0, 0);
    SendGameCenterMsg(SG_USERACCOUNT, EncodeMessage(DefMsg));
  end;
end;

procedure TFrmMain.GameCenterChangeAccountInfo(sData: string);
var
  NewRecord, DBRecord: TAccountDBRecord;
  DefMsg: TDefaultMessage;
  sDefMsg: string;
  nCode, nIndex: Integer;
begin
  if Length(sData) < DEFBLOCKSIZE then Exit;
  sDefMsg := Copy(sData, 1, DEFBLOCKSIZE);
  sData := Copy(sData, DEFBLOCKSIZE + 1, Length(sData) - DEFBLOCKSIZE);
  DefMsg := DecodeMessage(sDefMsg);
  DecodeBuffer(sData, @NewRecord, SizeOf(NewRecord));
  nCode := -1;
  try
    if AccountDB.Open then begin
      nIndex := AccountDB.Index(NewRecord.UserEntry.sAccount);
      if (nIndex >= 0) and (AccountDB.Get(nIndex, DBRecord) >= 0) then begin
        if DBRecord.UserEntry.sAccount = NewRecord.UserEntry.sAccount then begin
          DBRecord.nErrorCount := 0;
          DBRecord.dwActionTick := 0;
          DBRecord.UserEntry := NewRecord.UserEntry;
          DBRecord.UserEntryAdd := NewRecord.UserEntryAdd;
          AccountDB.Update(nIndex, DBRecord);
          nCode := 1;
        end else begin
          nCode := 2;
        end;
      end;
    end;
  finally
    AccountDB.Close;
  end;
  DefMsg := MakeDefaultMsg(0, nCode, 0, 0, 0);
  SendGameCenterMsg(SG_USERACCOUNTCHANGESTATUS, EncodeMessage(DefMsg));
end;

procedure SaveContLogMsg(Config: pTConfig; sLogMsg: string);
var
  Year, Month, Day, Hour, Min, Sec, MSec: Word;
  sLogDir, sLogFileName: string;
  LogFile: TextFile;
begin
  if sLogMsg = '' then Exit;
  DecodeDate(Date, Year, Month, Day);
  DecodeTime(Time, Hour, Min, Sec, MSec);
  if not DirectoryExists(Config.sCountLogDir) then begin
    CreateDir(Config.sCountLogDir);
  end;
  sLogDir := Config.sCountLogDir + IntToStr(Year) + '-' + IntToStr2(Month);
  if not DirectoryExists(sLogDir) then begin
    CreateDirectory(PChar(sLogDir), nil);
  end;
  sLogFileName := sLogDir + '\' + IntToStr(Year) + '-' + IntToStr2(Month) + '-' + IntToStr2(Day) + '.txt';
  AssignFile(LogFile, sLogFileName);
  if not FileExists(sLogFileName) then begin
    Rewrite(LogFile);
  end else begin
    Append(LogFile);
  end;
  sLogMsg := sLogMsg + #9 + TimeToStr(Time);
  Writeln(LogFile, sLogMsg);
  CloseFile(LogFile);
end;

procedure WriteLogMsg(Config: pTConfig; sType: string; var UserEntry: TUserEntry;
  var UserAddEntry: TUserEntryAdd);
var
  Year, Month, Day: Word;
  sLogDir, sLogFileName: string;
  LogFile: TextFile;
  sLogFormat, sLogMsg: string;
begin
  DecodeDate(Date, Year, Month, Day);
  if not DirectoryExists(Config.sChrLogDir) then begin
    CreateDir(Config.sChrLogDir);
  end;
  sLogDir := Config.sChrLogDir + IntToStr(Year) + '-' + IntToStr2(Month);
  if not DirectoryExists(sLogDir) then begin
    CreateDirectory(PChar(sLogDir), nil);
  end;
  sLogFileName := sLogDir + '\Id_' + IntToStr2(Day) + '.log';
  AssignFile(LogFile, sLogFileName);
  if not FileExists(sLogFileName) then begin
    Rewrite(LogFile);
  end else begin
    Append(LogFile);
  end;
  sLogFormat := '*%s*'#9'%s'#9'"%s"'#9'%s'#9'%s'#9'%s'#9'%s'#9'%s'#9'%s'#9'%s'#9'%s'#9'%s'#9'[%s]';
  sLogMsg := Format(sLogFormat, [sType,
    UserEntry.sAccount,
      UserEntry.sPassword,
      UserEntry.sUserName,
      UserEntry.sSSNo,
      UserEntry.sQuiz,
      UserEntry.sAnswer,
      UserEntry.sEMail,
      UserAddEntry.sQuiz2,
      UserAddEntry.sAnswer2,
      UserAddEntry.sBirthDay,
      UserAddEntry.sMobilePhone,
      TimeToStr(Now)]);

  //sLogMsg:= UserAddEntry.sQuiz2 + UserAddEntry.sAnswer2 + UserAddEntry.sBirthDay + UserAddEntry.sMobilePhone + '[' + TimeToStr(Now) + ']';

  Writeln(LogFile, sLogMsg);
  CloseFile(LogFile);
end;

procedure StartService(Config: pTConfig);
begin
  InitializeConfig(Config);
  LoadConfig(Config);

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -