main.pas
来自「飘飘的传奇服务端院代码 能编译的 要控件 老大就让我传上去吧」· PAS 代码 · 共 1,748 行 · 第 1/4 页
PAS
1,748 行
unit Main;
interface
uses
Windows, Messages, SysUtils, StrUtils, Variants, Classes, Controls, Forms,
Dialogs, JSocket, ExtCtrls, StdCtrls, WinSock, Grobal2, IniFiles, Menus, GateShare,
ComCtrls, RzPanel;
type
TFrmMain = class(TForm)
ServerSocket: TServerSocket;
SendTimer: TTimer;
ClientSocket: TClientSocket;
Timer: TTimer;
DecodeTimer: TTimer;
MainMenu: TMainMenu;
MENU_CONTROL: TMenuItem;
MENU_CONTROL_START: TMenuItem;
MENU_CONTROL_STOP: TMenuItem;
MENU_CONTROL_EXIT: TMenuItem;
MENU_VIEW: TMenuItem;
MENU_VIEW_LOGMSG: TMenuItem;
StartTimer: TTimer;
MENU_CONTROL_CLEAELOG: TMenuItem;
MENU_CONTROL_RECONNECT: TMenuItem;
MENU_OPTION: TMenuItem;
MENU_OPTION_GENERAL: TMenuItem;
MENU_OPTION_FILTERMSG: TMenuItem;
MENU_OPTION_IPFILTER: TMenuItem;
MENU_OPTION_PERFORM: TMenuItem;
PopupMenu: TPopupMenu;
POPMENU_PORT: TMenuItem;
POPMENU_START: TMenuItem;
POPMENU_CONNSTOP: TMenuItem;
POPMENU_RECONN: TMenuItem;
POPMENU_EXIT: TMenuItem;
POPMENU_CONNSTAT: TMenuItem;
POPMENU_CONNCOUNT: TMenuItem;
POPMENU_CHECKTICK: TMenuItem;
N1: TMenuItem;
POPMENU_OPEN: TMenuItem;
MENU_CONTROL_RELOADCONFIG: TMenuItem;
H1: TMenuItem;
I1: TMenuItem;
MemoLog: TMemo;
RzPanel1: TRzPanel;
LabelUserInfo: TLabel;
LabelRefConsoleMsg: TLabel;
LabelCheckServerTime: TLabel;
LabelMsg: TLabel;
LabelProcessMsg: TLabel;
CheckBoxShowData: TCheckBox;
procedure DecodeTimerTimer(Sender: TObject);
procedure ClientSocketError(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
procedure MENU_CONTROL_EXITClick(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure MENU_CONTROL_STARTClick(Sender: TObject);
procedure MENU_CONTROL_STOPClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure StartTimerTimer(Sender: TObject);
procedure TimerTimer(Sender: TObject);
procedure ServerSocketClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocketClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocketClientError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
procedure ServerSocketClientRead(Sender: TObject;
Socket: TCustomWinSocket);
procedure MemoLogChange(Sender: TObject);
procedure SendTimerTimer(Sender: TObject);
procedure ClientSocketConnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClientSocketDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClientSocketRead(Sender: TObject; Socket: TCustomWinSocket);
procedure MENU_CONTROL_CLEAELOGClick(Sender: TObject);
procedure MENU_CONTROL_RECONNECTClick(Sender: TObject);
procedure MENU_OPTION_GENERALClick(Sender: TObject);
procedure MENU_OPTION_FILTERMSGClick(Sender: TObject);
procedure MENU_OPTION_IPFILTERClick(Sender: TObject);
procedure MENU_OPTION_PERFORMClick(Sender: TObject);
procedure MENU_CONTROL_RELOADCONFIGClick(Sender: TObject);
procedure I1Click(Sender: TObject);
procedure MENU_VIEW_LOGMSGClick(Sender: TObject);
private
dwShowMainLogTick: LongWord;
boShowLocked: Boolean;
TempLogList: TStringList;
dwCheckClientTick: LongWord;
dwProcessPacketTick: LongWord;
boServerReady: Boolean;
dwLoopCheckTick: LongWord;
dwLoopTime: LongWord;
dwProcessServerMsgTime: LongWord;
dwProcessClientMsgTime: LongWord;
dwReConnectServerTime: LongWord;
dwRefConsolMsgTick: LongWord;
nBufferOfM2Size: Integer;
dwRefConsoleMsgTick: LongWord;
nReviceMsgSize: Integer;
nDeCodeMsgSize: Integer;
nSendBlockSize: Integer;
nProcessMsgSize: Integer;
nHumLogonMsgSize: Integer;
nHumPlayMsgSize: Integer;
procedure SendServerMsg(nIdent: Integer; wSocketIndex: Word; nSocket, nUserListIndex: Integer; nLen: Integer; Data: PChar);
procedure SendSocket(SendBuffer: PChar; nLen: Integer);
procedure ShowMainLogMsg();
procedure LoadConfig();
procedure StartService();
procedure StopService();
procedure RestSessionArray();
procedure ProcReceiveBuffer(tBuffer: PChar; nMsgLen: Integer);
procedure ProcessUserPacket(UserData: pTSendUserData);
procedure ProcessPacket(UserData: pTSendUserData);
procedure ProcessMakeSocketStr(nSocket, nSocketIndex: Integer; Buffer: PChar; nMsgLen: Integer);
procedure FilterSayMsg(var sMsg: string);
function IsBlockIP(sIPaddr: string): Boolean;
function IsConnLimited(sIPaddr: string): Boolean;
function AddAttackIP(sIPaddr: string): Boolean;
function CheckDefMsg(DefMsg: pTDefaultMessage; SessionInfo: pTSessionInfo): Boolean;
procedure CloseAllUser(); dynamic;
{ Private declarations }
public
procedure CloseConnect(sIPaddr: string);
function AddBlockIP(sIPaddr: string): Integer;
function AddTempBlockIP(sIPaddr: string): Integer;
function GetConnectCountOfIP(sIPaddr: string): Integer;
function GetAttackIPCount(sIPaddr: string): Integer;
{ Public declarations }
end;
var
FrmMain: TFrmMain;
implementation
uses EDcode, HUtil32, GeneralConfig, MessageFilterConfig, IPaddrFilter,
PrefConfig, OnLineHum;
{$R *.dfm}
procedure TFrmMain.SendSocket(SendBuffer: PChar; nLen: Integer);
begin
if ClientSocket.Socket.Connected then
ClientSocket.Socket.SendBuf(SendBuffer^, nLen);
end;
procedure TFrmMain.SendServerMsg(nIdent: Integer; wSocketIndex: Word; nSocket, nUserListIndex: Integer; nLen: Integer; Data: PChar);
var
GateMsg: TMsgHeader;
SendBuffer: PChar;
nBuffLen: Integer;
begin
//SendBuffer:=nil;
GateMsg.dwCode := RUNGATECODE;
GateMsg.nSocket := nSocket;
GateMsg.wGSocketIdx := wSocketIndex;
GateMsg.wIdent := nIdent;
GateMsg.wUserListIndex := nUserListIndex;
GateMsg.nLength := nLen;
nBuffLen := nLen + SizeOf(TMsgHeader);
GetMem(SendBuffer, nBuffLen);
Move(GateMsg, SendBuffer^, SizeOf(TMsgHeader));
if Data <> nil then begin
Move(Data^, SendBuffer[SizeOf(TMsgHeader)], nLen);
end; //0045505E
SendSocket(SendBuffer, nBuffLen);
FreeMem(SendBuffer);
end;
procedure TFrmMain.DecodeTimerTimer(Sender: TObject);
var
dwLoopProcessTime, dwProcessReviceMsgLimiTick: LongWord;
UserData: pTSendUserData;
i: Integer;
tUserData: TSendUserData;
UserSession: pTSessionInfo;
const
sMsg = '%d/%d/%d/%d/%d/%d/%d';
begin
ShowMainLogMsg();
if not boDecodeMsgLock then begin
try
if (GetTickCount - dwRefConsoleMsgTick) >= 1000 then begin
dwRefConsoleMsgTick := GetTickCount();
//if not boShowBite then begin
LabelRefConsoleMsg.Caption := Format(sMsg,
[nReviceMsgSize div 1024,
nBufferOfM2Size div 1024,
nProcessMsgSize div 1024,
nHumLogonMsgSize div 1024,
nHumPlayMsgSize div 1024,
nDeCodeMsgSize div 1024,
nSendBlockSize div 1024]);
{LabelReviceMsgSize.Caption := '接收: ' + IntToStr(nReviceMsgSize div 1024) + ' KB';
LabelBufferOfM2Size.Caption := '服务器通讯: ' + IntToStr(nBufferOfM2Size div 1024) + ' KB';
LabelProcessMsgSize.Caption := '编码: ' + IntToStr(nProcessMsgSize div 1024) + ' KB';
LabelLogonMsgSize.Caption := '登录: ' + IntToStr(nHumLogonMsgSize div 1024) + ' KB';
LabelPlayMsgSize.Caption := '普通: ' + IntToStr(nHumPlayMsgSize div 1024) + ' KB';
LabelDeCodeMsgSize.Caption := '解码: ' + IntToStr(nDeCodeMsgSize div 1024) + ' KB';
LabelSendBlockSize.Caption := '发送: ' + IntToStr(nSendBlockSize div 1024) + ' KB';}
{end else begin
LabelReviceMsgSize.Caption := '接收: ' + IntToStr(nReviceMsgSize) + ' B';
LabelBufferOfM2Size.Caption := '服务器通讯: ' + IntToStr(nBufferOfM2Size) + ' B';
LabelSelfCheck.Caption := '通讯自检: ' + IntToStr(dwCheckServerTimeMin) + '/' + IntToStr(dwCheckServerTimeMax);
LabelProcessMsgSize.Caption := '编码: ' + IntToStr(nProcessMsgSize) + ' B';
LabelLogonMsgSize.Caption := '登录: ' + IntToStr(nHumLogonMsgSize) + ' B';
LabelPlayMsgSize.Caption := '普通: ' + IntToStr(nHumPlayMsgSize) + ' B';
LabelDeCodeMsgSize.Caption := '解码: ' + IntToStr(nDeCodeMsgSize) + ' B';
LabelSendBlockSize.Caption := '发送: ' + IntToStr(nSendBlockSize) + ' B';
if dwCheckServerTimeMax > 1 then Dec(dwCheckServerTimeMax);
end; }
if ServerSocket.Socket.ActiveConnections >= 3 then begin
if nReviceMsgSize = 0 then begin
end else begin
end;
end;
nBufferOfM2Size := 0;
nReviceMsgSize := 0;
nDeCodeMsgSize := 0;
nSendBlockSize := 0;
nProcessMsgSize := 0;
nHumLogonMsgSize := 0;
nHumPlayMsgSize := 0;
end; //00455664
try
dwProcessReviceMsgLimiTick := GetTickCount();
while (True) do begin
if ReviceMsgList.Count <= 0 then break;
UserData := ReviceMsgList.Items[0];
ReviceMsgList.Delete(0);
ProcessUserPacket(UserData);
Dispose(UserData);
if (GetTickCount - dwProcessReviceMsgLimiTick) > dwProcessReviceMsgTimeLimit then break;
end;
except
on E: Exception do begin
AddMainLogMsg('[Exception] DecodeTimerTImer->ProcessUserPacket', 1);
end;
end;
try //004556F6
dwProcessReviceMsgLimiTick := GetTickCount();
while (True) do begin
if SendMsgList.Count <= 0 then break;
UserData := SendMsgList.Items[0];
SendMsgList.Delete(0);
ProcessPacket(UserData);
Dispose(UserData);
if (GetTickCount - dwProcessReviceMsgLimiTick) > dwProcessSendMsgTimeLimit then break;
end;
except
on E: Exception do begin
AddMainLogMsg('[Exception] DecodeTimerTImer->ProcessPacket', 1);
end;
end;
try //00455788
dwProcessReviceMsgLimiTick := GetTickCount();
if (GetTickCount - dwProcessPacketTick) > 300 then begin
dwProcessPacketTick := GetTickCount();
if ReviceMsgList.Count > 0 then begin
if dwProcessReviceMsgTimeLimit < 300 then Inc(dwProcessReviceMsgTimeLimit);
end else begin
if dwProcessReviceMsgTimeLimit > 30 then Dec(dwProcessReviceMsgTimeLimit);
end;
if SendMsgList.Count > 0 then begin
if dwProcessSendMsgTimeLimit < 300 then Inc(dwProcessSendMsgTimeLimit);
end else begin
if dwProcessSendMsgTimeLimit > 30 then Dec(dwProcessSendMsgTimeLimit);
end;
//00455826
for i := 0 to GATEMAXSESSION - 1 do begin
UserSession := @SessionArray[i];
if (UserSession.Socket <> nil) and (UserSession.sSendData <> '') then begin
tUserData.nSocketIdx := i;
tUserData.nSocketHandle := UserSession.nSckHandle;
tUserData.sMsg := '';
ProcessPacket(@tUserData);
if (GetTickCount - dwProcessReviceMsgLimiTick) > 20 then break;
end;
end;
end; //00455894
except
on E: Exception do begin
AddMainLogMsg('[Exception] DecodeTimerTImer->ProcessPacket 2', 1);
end;
end;
//每二秒向游戏服务器发送一个检查信号
if (GetTickCount - dwCheckClientTick) > 2000 then begin
dwCheckClientTick := GetTickCount();
if boGateReady then begin
SendServerMsg(GM_CHECKCLIENT, 0, 0, 0, 0, nil);
end;
if (GetTickCount - dwCheckServerTick) > dwCheckServerTimeOutTime then begin
// if (GetTickCount - dwCheckServerTick) > 60 * 1000 then begin
boCheckServerFail := True;
ClientSocket.Close;
end;
if dwLoopTime > 30 then Dec(dwLoopTime, 20);
if dwProcessServerMsgTime > 1 then Dec(dwProcessServerMsgTime);
if dwProcessClientMsgTime > 1 then Dec(dwProcessClientMsgTime);
end;
boDecodeMsgLock := False;
except
on E: Exception do begin
AddMainLogMsg('[Exception] DecodeTimer', 1);
boDecodeMsgLock := False;
end;
end;
dwLoopProcessTime := GetTickCount - dwLoopCheckTick;
dwLoopCheckTick := GetTickCount();
if dwLoopTime < dwLoopProcessTime then begin
dwLoopTime := dwLoopProcessTime;
end;
if (GetTickCount - dwRefConsolMsgTick) > 1000 then begin
dwRefConsolMsgTick := GetTickCount();
LabelProcessMsg.Caption := Format('%d/%d/%d/%d',
[dwLoopTime,
dwProcessClientMsgTime,
dwProcessServerMsgTime,
dwProcessReviceMsgTimeLimit,
dwProcessSendMsgTimeLimit]);
{LabelLoopTime.Caption := IntToStr(dwLoopTime);
LabelReviceLimitTime.Caption := '接收处理限制: ' + IntToStr(dwProcessReviceMsgTimeLimit);
LabelSendLimitTime.Caption := '发送处理限制: ' + IntToStr(dwProcessSendMsgTimeLimit);
LabelReceTime.Caption := '接收: ' + IntToStr(dwProcessClientMsgTime);
LabelSendTime.Caption := '发送: ' + IntToStr(dwProcessServerMsgTime);}
end;
end;
end;
procedure TFrmMain.ProcessUserPacket(UserData: pTSendUserData);
var
sMsg, sData, sDefMsg, sDataMsg, sDataText, sHumName: string;
Buffer: PChar;
nOPacketIdx, nPacketIdx, nDataLen, n14: Integer;
DefMsg: TDefaultMessage;
begin
try
n14 := 0;
Inc(nProcessMsgSize, Length(UserData.sMsg));
if (UserData.nSocketIdx >= 0) and (UserData.nSocketIdx < GATEMAXSESSION) then begin
if (UserData.nSocketHandle = SessionArray[UserData.nSocketIdx].nSckHandle) and
(SessionArray[UserData.nSocketIdx].nPacketErrCount < 10) then begin
if Length(SessionArray[UserData.nSocketIdx].sSocData) > MSGMAXLENGTH then begin
SessionArray[UserData.nSocketIdx].sSocData := '';
SessionArray[UserData.nSocketIdx].nPacketErrCount := 99;
UserData.sMsg := '';
end; //00455F7A
sMsg := SessionArray[UserData.nSocketIdx].sSocData + UserData.sMsg;
while (True) do begin //00455FA0
sData := '';
sMsg := ArrestStringEx(sMsg, '#', '!', sData);
if Length(sData) > 2 then begin
nPacketIdx := Str_ToInt(sData[1], 99); //将数据名第一位的序号取出
if SessionArray[UserData.nSocketIdx].nPacketIdx = nPacketIdx then begin
//如果序号重复则增加错误计数
Inc(SessionArray[UserData.nSocketIdx].nPacketErrCount);
end else begin
nOPacketIdx := SessionArray[UserData.nSocketIdx].nPacketIdx;
SessionArray[UserData.nSocketIdx].nPacketIdx := nPacketIdx;
sData := Copy(sData, 2, Length(sData) - 1);
nDataLen := Length(sData);
if (nDataLen >= DEFBLOCKSIZE) then begin
if SessionArray[UserData.nSocketIdx].boStartLogon then begin
//第一个人物登录数据包
Inc(nHumLogonMsgSize, Length(sData));
SessionArray[UserData.nSocketIdx].boStartLogon := False;
sData := '#' + IntToStr(nPacketIdx) + sData + '!';
GetMem(Buffer, Length(sData) + 1);
Move(sData[1], Buffer^, Length(sData) + 1);
SendServerMsg(GM_DATA,
UserData.nSocketIdx,
SessionArray[UserData.nSocketIdx].Socket.SocketHandle,
SessionArray[UserData.nSocketIdx].nUserListIndex,
Length(sData) + 1,
Buffer);
FreeMem(Buffer);
end else begin //0045615F
//普通数据包
Inc(nHumPlayMsgSize, Length(sData));
if nDataLen = DEFBLOCKSIZE then begin
sDefMsg := sData;
sDataMsg := '';
end else begin //0045618B
sDefMsg := Copy(sData, 1, DEFBLOCKSIZE);
sDataMsg := Copy(sData, DEFBLOCKSIZE + 1, Length(sData) - DEFBLOCKSIZE);
end; //004561BF
DefMsg := DecodeMessage(sDefMsg);
//检查数据
{
if not CheckDefMsg(@DefMsg,@SessionArray[UserData.nSocketIdx]) then begin
//SessionArray[UserData.nSocketIdx].nPacketIdx:=nOPacketIdx;
//sMsg:='#' + IntToStr(nPacketIdx) + sData + '!' + sMsg;
Continue;
end;
}
if sDataMsg <> '' then begin
if DefMsg.Ident = CM_SAY then begin
//控制发言间隔时间
//if (GetTickCount - SessionArray[UserData.nSocketIdx].dwSayMsgTick) < dwSayMsgTime then Continue;
//SessionArray[UserData.nSocketIdx].dwSayMsgTick:=GetTickCount();
sDataText := DecodeString(sDataMsg);
if sDataText <> '' then begin
if sDataText[1] = '/' then begin
sDataText := GetValidStr3(sDataText, sHumName, [' ']);
//限制最长可发字符长度
//if length(sDataText) > nSayMsgMaxLen then
// sDataText:=Copy(sDataText,1,nSayMsgMaxLen);
FilterSayMsg(sDataText);
sDataText := sHumName + ' ' + sDataText;
end else begin //0045623A
if sDataText[1] <> '@' then begin
//限制最长可发字符长度
//if length(sDataText) > nSayMsgMaxLen then
// sDataText:=Copy(sDataText,1,nSayMsgMaxLen);
FilterSayMsg(sDataText);
end;
end;
end; //0045624A
sDataMsg := EncodeString(sDataText);
end; //00456255
GetMem(Buffer, Length(sDataMsg) + SizeOf(TDefaultMessage) + 1);
Move(DefMsg, Buffer^, SizeOf(TDefaultMessage));
Move(sDataMsg[1], Buffer[SizeOf(TDefaultMessage)], Length(sDataMsg) + 1);
SendServerMsg(GM_DATA,
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?