📄 main.pas
字号:
unit Main;
interface
uses
svn, Windows, Messages, SysUtils, StrUtils, Variants, Classes, Controls, Forms,
Dialogs, JSocket, ExtCtrls, StdCtrls, Grobal2, IniFiles, Menus, GateShare,
ComCtrls, EDCode, CheckLst, CnClasses, CnTrayIcon;
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;
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;
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;
N2: TMenuItem;
PageControl1: TPageControl;
TabSheet1: TTabSheet;
MemoLog: TMemo;
TabSheet2: TTabSheet;
Panel: TPanel;
GroupBox1: TGroupBox;
LabelReviceMsgSize: TLabel;
LabelSendBlockSize: TLabel;
LabelLogonMsgSize: TLabel;
LabelPlayMsgSize: TLabel;
LabelDeCodeMsgSize: TLabel;
LabelProcessMsgSize: TLabel;
LabelBufferOfM2Size: TLabel;
LabelSelfCheck: TLabel;
GroupBoxProcessTime: TGroupBox;
LabelSendTime: TLabel;
LabelReceTime: TLabel;
LabelLoop: TLabel;
LabelReviceLimitTime: TLabel;
LabelSendLimitTime: TLabel;
LabelLoopTime: TLabel;
LbLack: TLabel;
Label1: TLabel;
CnTrayIcon1: TCnTrayIcon;
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);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure CnTrayIcon1DblClick(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;
PosFile: String;
implementation
uses 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);
//checklistbox1.AddItem('process' + inttostr(GetTickCount - dwProcessReviceMsgLimiTick),sender);
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
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -