📄 main.pas
字号:
unit Main;
interface
uses
Windows, Messages, SysUtils, StrUtils, Variants, Classes, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, Grobal2, IniFiles, Menus, GateShare,
ComCtrls, D7ScktComp, jpeg;
type
TFrmMain = class(TForm)
MemoLog: TMemo;
Panel: TPanel;
LbLack: TLabel;
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;
StatusBar: TStatusBar;
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;
GroupBox1: TGroupBox;
LabelReviceMsgSize: TLabel;
LabelSendBlockSize: TLabel;
LabelLogonMsgSize: TLabel;
LabelPlayMsgSize: TLabel;
LabelDeCodeMsgSize: TLabel;
LabelProcessMsgSize: TLabel;
LabelBufferOfM2Size: TLabel;
GroupBoxProcessTime: TGroupBox;
LabelSendTime: TLabel;
LabelReceTime: TLabel;
LabelLoop: TLabel;
LabelReviceLimitTime: TLabel;
LabelSendLimitTime: TLabel;
LabelLoopTime: TLabel;
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;
LabelSelfCheck: TLabel;
Image1: TImage;
Panel1: TPanel;
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 MENU_VIEW_LOGMSGClick(Sender: TObject);
procedure ShowLogMsg(boFlag: Boolean);
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);
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 CheckDefMsg(DefMsg: pTDefaultMessage; SessionInfo: pTSessionInfo):
Boolean;
procedure CloseAllUser(); dynamic;
{ Private declarations }
public
procedure CloseConnect(sIPaddr: string);
{ Public declarations }
end;
var
FrmMain : TFrmMain;
implementation
uses EDcode, HUtil32, GeneralConfig, MessageFilterConfig, IPaddrFilter,
PrefConfig;
{$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;
begin
ShowMainLogMsg();
if not boDecodeMsgLock then
begin
try
if (GetTickCount - dwRefConsoleMsgTick) >= 1000 then
begin
dwRefConsoleMsgTick := GetTickCount();
if not boShowBite then
begin
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';
{
Label5.Caption:=IntToStr(nReviceMsgSize div 1024) + 'KB/' +
IntToStr(nBufferOfM2Size div 1024) + 'KB';
Label7.Caption:=IntToStr(nProcessMsgSize div 1024) + 'KB/' +
IntToStr(nHumLogonMsgSize div 1024) + 'KB/' +
IntToStr(nHumPlayMsgSize div 1024) + 'KB - ' +
IntToStr(nDeCodeMsgSize div 1024) + 'KB/' +
IntToStr(nSendBlockSize div 1024) + 'KB';
}
end
else
begin //004554D4
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);
{
Label5.Caption:=IntToStr(nReviceMsgSize) + 'B/' +
IntToStr(nBufferOfM2Size) + 'B';
Label7.Caption:=IntToStr(nProcessMsgSize) + 'B/' +
IntToStr(nHumLogonMsgSize) + 'B/' +
IntToStr(nHumPlayMsgSize) + 'B - ' +
IntToStr(nDeCodeMsgSize) + 'B/' +
IntToStr(nSendBlockSize) + 'B';
}
end; //004555BF
if ServerSocket.Socket.ActiveConnections >= 3 then
begin
if nReviceMsgSize = 0 then
begin
//004555E4
//ShowWarning Windows
//00455602
end
else
begin
//ShowWarning Windows
end;
end; //0x00455617
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;
//004558C1
//每二秒向游戏服务器发送一个检查信号
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; //0045596F
boDecodeMsgLock := False;
except
on E: Exception do
begin
AddMainLogMsg('[Exception] DecodeTimer', 1);
boDecodeMsgLock := False;
end;
end;
//004559AA
dwLoopProcessTime := GetTickCount - dwLoopCheckTick;
dwLoopCheckTick := GetTickCount();
if dwLoopTime < dwLoopProcessTime then
begin
dwLoopTime := dwLoopProcessTime;
end;
if (GetTickCount - dwRefConsolMsgTick) > 1000 then
begin
dwRefConsolMsgTick := GetTickCount();
LabelLoopTime.Caption := IntToStr(dwLoopTime);
LabelReviceLimitTime.Caption := '接收处理限制: ' +
IntToStr(dwProcessReviceMsgTimeLimit);
LabelSendLimitTime.Caption := '发送处理限制: ' +
IntToStr(dwProcessSendMsgTimeLimit);
LabelReceTime.Caption := '接收: ' + IntToStr(dwProcessClientMsgTime);
LabelSendTime.Caption := '发送: ' + IntToStr(dwProcessServerMsgTime);
{
Label2.Caption:='Loop < ' + IntToStr(dwLoopTime);
Label3.Caption:='Rece < ' + IntToStr(dwProcessServerMsgTime);
Label4.Caption:='Send < ' + IntToStr(dwProcessClientMsgTime) + ' Lim ' + IntToStr(dwProcessReviceMsgTimeLimit) + '/' + IntToStr(dwProcessSendMsgTimeLimit);
}
end;
end; //00455B0D
end;
procedure TFrmMain.ProcessUserPacket(UserData: pTSendUserData);
//00455E80
var
sMsg, sData, sDefMsg, sDataMsg, sDataText, sHumName: string;
Buffer : PChar;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -