📄 lmain.pas
字号:
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 + -