📄 idsrvclient.pas
字号:
unit IdSrvClient;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, IniFiles, JSocket, WinSock, Grobal2, SDK, M2Share, MudUtil;
type
TFrmIDSoc = class(TForm)
IDSocket: TClientSocket;
Timer1: TTimer;
procedure Timer1Timer(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure IDSocketError(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
procedure IDSocketRead(Sender: TObject; Socket: TCustomWinSocket);
procedure IDSocketConnect(Sender: TObject; Socket: TCustomWinSocket);
procedure IDSocketDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
private
TList_2DC: TList;
IDSrvAddr: string; //0x2E0
IDSrvPort: Integer; //0x2E4
// sIDSckStr :String; //0x2E8
// boConnected:Boolean;
dwClearEmptySessionTick: LongWord;
procedure GetPasswdSuccess(sData: string);
procedure GetCancelAdmission(sData: string);
procedure GetCancelAdmissionA(sData: string);
procedure SetTotalHumanCount(sData: string);
procedure GetServerLoad(sData: string);
procedure DelSession(nSessionID: Integer);
procedure NewSession(sAccount, sIPaddr: string; nSessionID, nPayMent, nPayMode: Integer);
procedure ClearSession();
procedure ClearEmptySession();
procedure SendSocket(sSENDMSG: string);
{ Private declarations }
public
m_SessionList: TGList; //0x2D8
procedure Initialize();
procedure Run();
procedure SendOnlineHumCountMsg(nCount: Integer);
procedure SendHumanLogOutMsg(sUserID: string; nID: Integer);
function GetAdmission(sAccount, sIPaddr: string; nSessionID: Integer; var nPayMode: Integer; var nPayMent: Integer): pTSessInfo;
function GetSessionCount(): Integer;
procedure GetSessionList(List: TList);
procedure SendLogonCostMsg(sAccount: string; nTime: Integer);
procedure Close();
{ Public declarations }
end;
procedure IDSocketThread(ThreadInfo: pTThreadInfo); stdcall;
var
FrmIDSoc: TFrmIDSoc;
implementation
uses HUtil32;
{$R *.dfm}
{ TFrmIDSoc }
procedure TFrmIDSoc.FormCreate(Sender: TObject);
var
Conf: TIniFile;
begin
IDSocket.Host := '';
if FileExists(sConfigFileName) then
begin
Conf := TIniFile.Create(sConfigFileName);
if Conf <> nil then
begin
IDSrvAddr := Conf.ReadString('Server', 'IDSAddr', '127.0.0.1');
IDSrvPort := Conf.ReadInteger('Server', 'IDSPort', 5600);
end;
Conf.Free;
end else
ShowMessage('File not found... <' + sConfigFileName + '>');
m_SessionList := TGList.Create;
TList_2DC := TList.Create;
g_Config.boIDSocketConnected := False;
// sub_48D290();
end;
procedure TFrmIDSoc.FormDestroy(Sender: TObject);
begin
ClearSession();
m_SessionList.Free;
TList_2DC.Free;
end;
procedure TFrmIDSoc.Timer1Timer(Sender: TObject);
begin
if not IDSocket.Active then
begin
IDSocket.Active := True;
end;
end;
procedure TFrmIDSoc.IDSocketError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
begin
ErrorCode := 0;
Socket.Close;
end;
procedure TFrmIDSoc.IDSocketRead(Sender: TObject;
Socket: TCustomWinSocket);
begin
EnterCriticalSection(g_Config.UserIDSection);
try
g_Config.sIDSocketRecvText := g_Config.sIDSocketRecvText + Socket.ReceiveText;
finally
LeaveCriticalSection(g_Config.UserIDSection);
end;
end;
procedure TFrmIDSoc.Initialize; //0048D3F8
begin
IDSocket.Active := False;
IDSocket.Address := IDSrvAddr;
IDSocket.Port := IDSrvPort;
IDSocket.Active := True;
Timer1.Enabled := True;
end;
{$IF IDSOCKETMODE = TIMERENGINE}
procedure TFrmIDSoc.SendSocket(sSENDMSG: string);
begin
if IDSocket.Socket.Connected then
begin
IDSocket.Socket.SendText(sSENDMSG);
end;
end;
{$ELSE}
procedure TFrmIDSoc.SendSocket(sSENDMSG: string);
var
boSendData: Boolean;
Config: pTM2Config;
ThreadInfo: pTThreadInfo;
timeout: TTimeVal;
writefds: TFDSet;
nRet: Integer;
s: TSocket;
begin
Config := @g_Config;
ThreadInfo := @g_Config.DBSOcketThread;
s := Config.IDSocket;
boSendData := False;
while True do
begin
if not boSendData then Sleep(1)
else Sleep(0);
boSendData := False;
ThreadInfo.dwRunTick := GetTickCount();
ThreadInfo.boActived := True;
ThreadInfo.nRunFlag := 128;
ThreadInfo.nRunFlag := 129;
timeout.tv_sec := 0;
timeout.tv_usec := 20;
writefds.fd_count := 1;
writefds.fd_array[0] := s;
nRet := select(0, nil, @writefds, nil, @timeout);
if nRet = SOCKET_ERROR then
begin
nRet := WSAGetLastError();
Config.nIDSocketWSAErrCode := nRet - WSABASEERR;
Inc(Config.nIDSocketErrorCount);
if nRet = WSAEWOULDBLOCK then
begin
Continue;
end;
if Config.IDSocket = INVALID_SOCKET then Break;
Config.IDSocket := INVALID_SOCKET;
Sleep(100);
Config.boIDSocketConnected := False;
Break;
end;
if nRet <= 0 then
begin
Continue;
end;
boSendData := True;
nRet := send(s, sSENDMSG[1], Length(sSENDMSG), 0);
if nRet = SOCKET_ERROR then
begin
Inc(Config.nIDSocketErrorCount);
Config.nIDSocketWSAErrCode := WSAGetLastError - WSABASEERR;
Continue;
end;
Inc(Config.nDBSocketSendLen, nRet);
Break;
end;
end;
{$IFEND}
procedure TFrmIDSoc.SendHumanLogOutMsg(sUserID: string; nID: Integer); //0048D448
var
i: Integer;
SessInfo: pTSessInfo;
resourcestring
sFormatMsg = '(%d/%s/%d)';
begin
m_SessionList.Lock;
try
for i := 0 to m_SessionList.Count - 1 do
begin
SessInfo := m_SessionList.Items[i];
if (SessInfo.nSessionID = nID) and (SessInfo.sAccount = sUserID) then
begin
//SessInfo.dwCloseTick:=GetTickCount();
//SessInfo.boClosed:=True;
Break;
end;
end;
finally
m_SessionList.UnLock;
end;
SendSocket(Format(sFormatMsg, [SS_SOFTOUTSESSION, sUserID, nID]));
end;
procedure TFrmIDSoc.SendLogonCostMsg(sAccount: string; nTime: Integer); //0048D53C
resourcestring
sFormatMsg = '(%d/%s/%d)';
begin
SendSocket(Format(sFormatMsg, [SS_LOGINCOST, sAccount, nTime]));
end;
procedure TFrmIDSoc.SendOnlineHumCountMsg(nCount: Integer);
resourcestring
sFormatMsg = '(%d/%s/%d/%d)';
begin
SendSocket(Format(sFormatMsg, [SS_SERVERINFO, g_Config.sServerName, nServerIndex, nCount]));
end;
procedure TFrmIDSoc.Run; //0048D724
var
sSocketText: string;
sData: string;
sBody: string;
sCode: string;
nLen: Integer;
Config: pTM2Config;
resourcestring
sExceptionMsg = '[Exception] TFrmIdSoc::DecodeSocStr';
begin
Config := @g_Config;
EnterCriticalSection(Config.UserIDSection);
try
if Pos(')', Config.sIDSocketRecvText) <= 0 then Exit;
sSocketText := Config.sIDSocketRecvText;
Config.sIDSocketRecvText := '';
finally
LeaveCriticalSection(Config.UserIDSection);
end;
try
while (True) do
begin
sSocketText := ArrestStringEx(sSocketText, '(', ')', sData);
if sData = '' then Break;
sBody := GetValidStr3(sData, sCode, ['/']);
case Str_ToInt(sCode, 0) of
SS_OPENSESSION {100}: GetPasswdSuccess(sBody);
SS_CLOSESESSION {101}: GetCancelAdmission(sBody);
SS_KEEPALIVE {104}: SetTotalHumanCount(sBody);
UNKNOWMSG: ;
SS_KICKUSER {111}: GetCancelAdmissionA(sBody);
SS_SERVERLOAD {113}: GetServerLoad(sBody);
end;
if Pos(')', sSocketText) <= 0 then Break;
end;
EnterCriticalSection(Config.UserIDSection);
try
Config.sIDSocketRecvText := sSocketText + Config.sIDSocketRecvText;
finally
LeaveCriticalSection(Config.UserIDSection);
end;
except
MainOutMessage(sExceptionMsg);
end;
if GetTickCount - dwClearEmptySessionTick > 10000 then
begin
dwClearEmptySessionTick := GetTickCount();
//ClearEmptySession();
end;
{$IF (DEBUG = 0) and (SoftVersion <> VERDEMO)}
if IsDebuggerPresent then
Application.Terminate;
{$IFEND}
end;
procedure TFrmIDSoc.GetPasswdSuccess(sData: string); //0048D9B4
var
sAccount: string;
sSessionID: string;
sPayCost: string;
sIPaddr: string;
sPayMode: string;
resourcestring
sExceptionMsg = '[Exception] TFrmIdSoc::GetPasswdSuccess';
begin
try
sData := GetValidStr3(sData, sAccount, ['/']);
sData := GetValidStr3(sData, sSessionID, ['/']);
sData := GetValidStr3(sData, sPayCost, ['/']); //boPayCost
sData := GetValidStr3(sData, sPayMode, ['/']); //nPayMode
sData := GetValidStr3(sData, sIPaddr, ['/']); //sIPaddr
NewSession(sAccount, sIPaddr, Str_ToInt(sSessionID, 0), Str_ToInt(sPayCost, 0), Str_ToInt(sPayMode, 0));
except
MainOutMessage(sExceptionMsg);
end;
end;
procedure TFrmIDSoc.GetCancelAdmission(sData: string); //0048DB60
var
SC, sSessionID: string;
resourcestring
sExceptionMsg = '[Exception] TFrmIdSoc::GetCancelAdmission';
begin
try
sSessionID := GetValidStr3(sData, SC, ['/']);
DelSession(Str_ToInt(sSessionID, 0));
except
on E: Exception do
begin
MainOutMessage(sExceptionMsg);
MainOutMessage(E.Message);
end;
end;
end;
procedure TFrmIDSoc.NewSession(sAccount, sIPaddr: string; nSessionID, nPayMent, nPayMode: Integer); //0048DC44
var
SessInfo: pTSessInfo;
begin
New(SessInfo);
SessInfo.sAccount := sAccount;
SessInfo.sIPaddr := sIPaddr;
SessInfo.nSessionID := nSessionID;
SessInfo.nPayMent := nPayMent;
SessInfo.nPayMode := nPayMode;
SessInfo.nSessionStatus := 0;
SessInfo.dwStartTick := GetTickCount();
SessInfo.dwActiveTick := GetTickCount();
SessInfo.nRefCount := 1;
m_SessionList.Lock;
try
m_SessionList.Add(SessInfo);
finally
m_SessionList.UnLock;
end;
end;
procedure TFrmIDSoc.DelSession(nSessionID: Integer); //0048DD5C
var
i: Integer;
sAccount: string;
SessInfo: pTSessInfo;
resourcestring
sExceptionMsg = '[Exception] FrmIdSoc::DelSession %d';
begin
try
sAccount := '';
m_SessionList.Lock;
try
for i := 0 to m_SessionList.Count - 1 do
begin
SessInfo := m_SessionList.Items[i];
if SessInfo.nSessionID = nSessionID then
begin
sAccount := SessInfo.sAccount;
m_SessionList.Delete(i);
Dispose(SessInfo);
Break;
end;
end;
finally
m_SessionList.UnLock;
end;
if sAccount <> '' then
begin
RunSocket.KickUser(sAccount, nSessionID);
end;
except
on E: Exception do
begin
MainOutMessage(Format(sExceptionMsg, [0]));
MainOutMessage(E.Message);
end;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -