📄 usrsoc.pas
字号:
unit UsrSoc;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics,
Controls, Forms, Dialogs, StdCtrls, ExtCtrls, JSocket, SyncObjs,IniFiles,Grobal2,DBShare;
type
// TServerInfo = record
// nGateCount :Integer;
// sSelGateIP :String; //0x2EC
// sGameGateIP1 :String; //0x2F0
// nGameGatePort1:Integer; //0x2F4
// sGameGateIP2 :String; //0x2F8
// nGameGatePort2:Integer; //0x2FC
// sGameGateIP3 :String; //0x300
// nGameGatePort3:Integer; //0x304
// sGameGateIP4 :String; //0x308
// nGameGatePort4:Integer; //0x30C
// sGameGateIP5 :String;
// nGameGatePort5:Integer;
// sGameGateIP6 :String;
// nGameGatePort6:Integer;
// sGameGateIP7 :String;
// nGameGatePort7:Integer;
// sGameGateIP8 :String;
// nGameGatePort8:Integer;
// end;
TFrmUserSoc=class(TForm)
UserSocket: TServerSocket;
Timer1: TTimer;
procedure FormCreate(Sender : TObject);
procedure FormDestroy(Sender : TObject);
procedure Timer1Timer(Sender : TObject);
procedure UserSocketClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure UserSocketClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure UserSocketClientError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
procedure UserSocketClientRead(Sender: TObject;
Socket: TCustomWinSocket);
private
dwKeepAliveTick :LongWord; //0x10
CS_GateSession:TCriticalSection; //0x2D8
n2DC:Integer;
n2E0:Integer;
n2E4:Integer;
GateList:TList; //0x2E8
CurGate:pTGateInfo; //0x51C
MapList:TStringList;
function LoadChrNameList(sFileName:string):Boolean;
function LoadClearMakeIndexList(sFileName: string):Boolean;
procedure ProcessGateMsg(var GateInfo: pTGateInfo);
procedure SendKeepAlivePacket(Socket: TCustomWinSocket);
procedure ProcessUserMsg(var UserInfo: pTUserInfo);
procedure CloseUser(sID: String; var GateInfo: pTGateInfo);
procedure OpenUser(sID, sIP: String; var GateInfo: pTGateInfo);
procedure DeCodeUserMsg(sData: String; var UserInfo: pTUserInfo);
function QueryChr(sData: String; var UserInfo: pTUserInfo): Boolean;
procedure DelChr(sData: String; var UserInfo: pTUserInfo);
procedure OutOfConnect(const UserInfo: pTUserInfo);
procedure NewChr(sData: String; var UserInfo: pTUserInfo);
function SelectChr(sData: String; var UserInfo: pTUserInfo): Boolean;
procedure SendUserSocket(Socket: TCustomWinSocket; sSessionID,
sSendMsg: String);
function GetMapIndex(sMap: String): Integer;
function GateRoutePort(sGateIP: String): Integer;
function CheckDenyChrName(sChrName:String):Boolean;
{ Private declarations }
public
function GateRouteIP(sGateIP: String;var nPort:Integer): String;
procedure LoadServerInfo();
function NewChrData(sChrName:String;nSex,nJob,nHair:Integer):Boolean;
function GetUserCount():Integer;
{ Public declarations }
end;
var
FrmUserSoc: TFrmUserSoc;
implementation
uses HumDB, HUtil32, IDSocCli, EDcode, MudUtil, DBSMain;
{$R *.DFM}
procedure TFrmUserSoc.UserSocketClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
//0x004A2A10
var
GateInfo:pTGateInfo;
sIPaddr:String;
begin
sIPaddr:=Socket.RemoteAddress;
if not CheckServerIP(sIPaddr) then begin
OutMainMessage('非法网关连接: ' + sIPaddr);
Socket.Close;
exit;
end;
if not boOpenDBBusy then begin
New(GateInfo);
GateInfo.Socket := Socket;
GateInfo.sGateaddr := sIPaddr;
GateInfo.sText := '';
GateInfo.UserList := TList.Create;
GateInfo.dwTick10 := GetTickCount();
GateInfo.nGateID := GetGateID(sIPaddr);
try
CS_GateSession.Enter;
GateList.Add(GateInfo);
finally
CS_GateSession.Leave;
end;
end else begin
Socket.Close;
end;
end;
procedure TFrmUserSoc.UserSocketClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
//0x004A2B08
var
i,ii:integer;
GateInfo:pTGateInfo;
UserInfo:pTUserInfo;
begin
try
CS_GateSession.Enter;
for i:=0 to GateList.Count -1 do begin
GateInfo:=GateList.Items[i];
if GateInfo <> nil then begin
for ii:=0 to GateInfo.UserList.Count -1 do begin
UserInfo:=GateInfo.UserList.Items[ii];
Dispose(UserInfo);
end;
GateInfo.UserList.Free;
end;
GateList.Delete(i);
break;
end;
finally
CS_GateSession.Leave;
end;
end;
procedure TFrmUserSoc.UserSocketClientError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
//0x004A2C10
begin
ErrorCode:=0;
Socket.Close;
end;
procedure TFrmUserSoc.UserSocketClientRead(Sender: TObject;
Socket: TCustomWinSocket);
var
i:integer;
sReviceMsg:String;
GateInfo:pTGateInfo;
begin
try
CS_GateSession.Enter;
for i:=0 to GateList.Count -1 do begin
GateInfo:=GateList.Items[i];
if GateInfo.Socket = Socket then begin
CurGate:=GateInfo;
sReviceMsg:=Socket.ReceiveText;
GateInfo.sText:=GateInfo.sText + sReviceMsg;
if Length(GateInfo.sText) < 81920 then begin
if Pos('$',GateInfo.sText) > 1 then begin
ProcessGateMsg(GateInfo);
end;
end else begin
GateInfo.sText:='';
end;
end;
end;
finally
CS_GateSession.Leave;
end;
end;
procedure TFrmUserSoc.FormCreate(Sender : TObject);
//0x004A2898
begin
CS_GateSession:=TCriticalSection.Create;
GateList:=TList.Create;
MapList:=TStringList.Create;
UserSocket.Port:=g_nGatePort;
UserSocket.Address:=g_sGateAddr;
UserSocket.Active:=True;
LoadServerInfo();
LoadChrNameList('DenyChrName.txt');
LoadClearMakeIndexList('ClearMakeIndex.txt');
end;
procedure TFrmUserSoc.FormDestroy(Sender : TObject);
//ox004A2954
var
i,ii:Integer;
GateInfo:pTGateInfo;
UserInfo:pTUserInfo;
begin
for i:=0 to GateList.Count -1 do begin
GateInfo:=GateList.Items[i];
if GateInfo <> nil then begin
for ii:=0 to GateInfo.UserList.Count -1 do begin
UserInfo:=GateInfo.UserList.Items[ii];
Dispose(UserInfo);
end;
GateInfo.UserList.Free;
end;
GateList.Delete(i);
break;
end;
GateList.Free;
MapList.Free;
CS_GateSession.Free;
end;
procedure TFrmUserSoc.Timer1Timer(Sender : TObject);
//0x004A4EFC
var
n8:Integer;
begin
n8:=g_nQueryChrCount + nHackerNewChrCount + nHackerDelChrCount + nHackerSelChrCount + n4ADC1C + n4ADC20 + n4ADC24 + n4ADC28;
if n4ADBB8 <> n8 then begin
n4ADBB8:=n8;
OutMainMessage('H-QyChr=' + IntToStr(g_nQueryChrCount) + ' ' +
'H-NwChr=' + IntToStr(nHackerNewChrCount) + ' ' +
'H-DlChr=' + IntToStr(nHackerDelChrCount) + ' ' +
'Dubl-Sl=' + IntToStr(nHackerSelChrCount) + ' ' +
'H-Er-P1=' + IntToStr(n4ADC1C) + ' ' +
'Dubl-P2=' + IntToStr(n4ADC20) + ' ' +
'Dubl-P3=' + IntToStr(n4ADC24) + ' ' +
'Dubl-P4=' + IntToStr(n4ADC28));
end;
end;
function TFrmUserSoc.GetUserCount():Integer;
var
i:Integer;
GateInfo:pTGateInfo;
nUserCount:Integer;
begin
nUserCount:=0;
try
CS_GateSession.Enter;
for I := 0 to GateList.Count - 1 do begin
GateInfo:=GateList.Items[i];
Inc(nUserCount,GateInfo.UserList.Count);
end;
finally
CS_GateSession.Leave;
end;
Result:=nUserCount;
end;
function TFrmUserSoc.NewChrData(sChrName:String;nSex,nJob,nHair:Integer):Boolean;
var
ChrRecord:THumDataInfo;
begin
Result:=False;
FillChar(ChrRecord,SizeOf(THumDataInfo),#0);
try
if HumDataDB.Open and (HumDataDB.Index(sChrName) = -1) then begin
ChrRecord.Header.sName:=sChrName;
ChrRecord.Data.sChrName:=sChrName;
ChrRecord.Data.btSex:=nSex;
ChrRecord.Data.btJob:=nJob;
ChrRecord.Data.btHair:=nHair;
HumDataDB.Add(ChrRecord);
Result:= True;
end;
finally
HumDataDB.Close;
end;
end;
procedure TFrmUserSoc.LoadServerInfo;
//0x004A2018
var
I: Integer;
LoadList:TStringList;
nRouteIdx,nGateIdx,nServerIndex:Integer;
sLineText,sSelGateIPaddr,sGameGateIPaddr,sGameGate,sGameGatePort,sMapName,sMapInfo,sServerIndex:String;
Conf:TIniFile;
begin
try
LoadList:=TStringList.Create;
FillChar(g_RouteInfo,SizeOf(g_RouteInfo),#0);
LoadList.LoadFromFile(sGateConfFileName);
nRouteIdx:=0;
nGateIdx:=0;
for I := 0 to LoadList.Count - 1 do begin
sLineText:=Trim(LoadList.Strings[I]);
if (sLineText <> '') and (sLineText[1] <> ';') then begin
sGameGate:=GetValidStr3(sLineText,sSelGateIPaddr,[' ',#9]);
if (sGameGate = '') or (sSelGateIPaddr = '') then Continue;
g_RouteInfo[nRouteIdx].sSelGateIP:=Trim(sSelGateIPaddr);
g_RouteInfo[nRouteIdx].nGateCount:=0;
nGateIdx:=0;
while (sGameGate <> '') do begin
sGameGate:=GetValidStr3(sGameGate,sGameGateIPaddr,[' ',#9]);
sGameGate:=GetValidStr3(sGameGate,sGameGatePort,[' ',#9]);
g_RouteInfo[nRouteIdx].sGameGateIP[nGateIdx]:=Trim(sGameGateIPaddr);
g_RouteInfo[nRouteIdx].nGameGatePort[nGateIdx]:=Str_ToInt(sGameGatePort,0);
Inc(nGateIdx);
end;
g_RouteInfo[nRouteIdx].nGateCount:=nGateIdx;
Inc(nRouteIdx);
end;
end;
Conf:=TIniFile.Create(sConfFileName);
sMapFile:=Conf.ReadString('Setup','MapFile',sMapFile);
Conf.Free;
MapList.Clear;
if FileExists(sMapFile) then begin
LoadList.Clear;
LoadList.LoadFromFile(sMapFile);
for I := 0 to LoadList.Count - 1 do begin
sLineText:=LoadList.Strings[I];
if (sLineText <> '') and (sLineText[1] = '[') then begin
sLineText:=ArrestStringEx(sLineText,'[',']',sMapName);
sMapInfo:=GetValidStr3(sMapName,sMapName,[#32,#9]);
sServerIndex:=Trim(GetValidStr3(sMapInfo,sMapInfo,[#32,#9]));
nServerIndex:=Str_ToInt(sServerIndex,0);
MapList.AddObject(sMapName,TObject(nServerIndex));
end;
end;
end;
LoadList.Free;
finally
end;
end;
function TFrmUserSoc.LoadChrNameList(sFileName: string):Boolean;
//0x0045C1A0
var
i:integer;
begin
Result:=False;
if FileExists(sFileName) then begin
DenyChrNameList.LoadFromFile(sFileName);
i:=0;
while (True) do begin
if DenyChrNameList.Count <= i then break;
if Trim(DenyChrNameList.Strings[i]) = '' then begin
DenyChrNameList.Delete(i);
Continue;
end;
Inc(i);
end;
Result:=True;
end;
end;
function TFrmUserSoc.LoadClearMakeIndexList(sFileName: string):Boolean;
//0x0045C1A0
var
i:integer;
nIndex:integer;
sLineText:String;
begin
Result:=False;
if FileExists(sFileName) then begin
g_ClearMakeIndex.LoadFromFile(sFileName);
i:=0;
while (True) do begin
if g_ClearMakeIndex.Count <= i then break;
sLineText:=g_ClearMakeIndex.Strings[I];
nIndex:=Str_ToInt(sLineText,-1);
if nIndex < 0 then begin
g_ClearMakeIndex.Delete(i);
Continue;
end;
g_ClearMakeIndex.Objects[I]:=TObject(nIndex);
Inc(i);
end;
Result:=True;
end;
end;
procedure TFrmUserSoc.ProcessGateMsg(var GateInfo:pTGateInfo);
//0x004A3350
var
s0C:String;
s10:String;
s19:Char;
i:Integer;
UserInfo:pTUserInfo;
begin
while (True) do begin
if Pos('$',GateInfo.sText) <= 0 then break;
GateInfo.sText:=ArrestStringEx(GateInfo.sText,'%','$',s10);
if s10 <> '' then begin
s19:=s10[1];
s10:=Copy(s10,2,Length(s10) -1);
case Ord(s19) of
Ord('-'): begin
SendKeepAlivePacket(GateInfo.Socket);
dwKeepAliveTick:=GetTickCount();
end;
Ord('A'): begin
s10:=GetValidStr3(s10,s0C,['/']);
for i:=0 to GateInfo.UserList.Count -1 do begin
UserInfo:=GateInfo.UserList.Items[i];
if UserInfo <> nil then begin
if UserInfo.sConnID = s0C then begin
UserInfo.s2C:=UserInfo.s2C + s10;
if Pos('!',s10) < 1 then Continue;
ProcessUserMsg(UserInfo);
break;
end;
end;
end;
end;
Ord('O'): begin
s10:=GetValidStr3(s10,s0C,['/']);
OpenUser(s0C,s10,GateInfo);
end;
Ord('X'): begin
CloseUser(s10,GateInfo);
end;
end;
end;//004A3587
end;
end;
procedure TFrmUserSoc.SendKeepAlivePacket(Socket: TCustomWinSocket);
begin
if Socket.Connected then
Socket.SendText('%++$');
end;
procedure TFrmUserSoc.ProcessUserMsg(var UserInfo:pTUserInfo);
var
s10:String;
nC:Integer;
begin
nC:=0;
while (True) do begin
if TagCount(UserInfo.s2C,'!') <= 0 then break;
UserInfo.s2C:=ArrestStringEx(UserInfo.s2C,'#','!',s10);
if s10 <> '' then begin
s10:=Copy(s10,2,Length(s10)-1);
if Length(s10) >= DEFBLOCKSIZE then begin
DeCodeUserMsg(s10,UserInfo);
end else Inc(n4ADC20);
end else begin
Inc(n4ADC1C);
if nC >= 1 then begin
UserInfo.s2C:='';
end;
Inc(nC);
end;
end;
end;
procedure TFrmUserSoc.OpenUser(sID, sIP: String;var GateInfo: pTGateInfo);
var
I :Integer;
UserInfo :pTUserInfo;
sUserIPaddr :String;
sGateIPaddr :String;
begin
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -