⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 usrsoc.pas

📁 原版翎风(LF)引擎(M2)源码(Delphi)
💻 PAS
📖 第 1 页 / 共 2 页
字号:
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 + -