usrsoc.pas

飘飘的传奇服务端院代码 能编译的 要控件 老大就让我传上去吧

unit UsrSoc;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, WinSock, Common,
  Controls, Forms, Dialogs, StdCtrls, ExtCtrls, JSocket, SyncObjs, IniFiles, Grobal2, DBShare;
type
  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
    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;
    procedure SendKickUser(Socket: TCustomWinSocket; nKickType: Integer);
    { Public declarations }
  end;

var
  FrmUserSoc: TFrmUserSoc;

implementation

uses HumDB, HUtil32, IDSocCli, EDcode, MudUtil, DBSMain;

{$R *.DFM}

procedure TFrmUserSoc.UserSocketClientConnect(Sender: TObject;
  Socket: TCustomWinSocket);
var
  GateInfo: pTGateInfo;
  sIPaddr: string;
begin
  sIPaddr := Socket.RemoteAddress;
  if not CheckServerIP(sIPaddr) then begin
    MainOutMessage('非法网关连接: ' + sIPaddr);
    Socket.Close;
    Exit;
  end;
  UserSocketClientConnected := True;
  User_sRemoteAddress := sIPaddr;
  User_nRemotePort := Socket.RemotePort;
  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);
var
  i, ii: Integer;
  GateInfo: pTGateInfo;
  UserInfo: pTUserInfo;
begin
  try
    CS_GateSession.Enter;
    {User_sRemoteAddress:='';
    User_nRemotePort:=0;
    UserSocketClientConnected:=FALSE;}
    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);
begin
  ErrorCode := 0;
  Socket.Close;
  User_sRemoteAddress := '';
  User_nRemotePort := 0;
  UserSocketClientConnected := False;
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);
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);
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);
var
  n8: Integer;
begin
  n8 := g_nQueryChrCount + nHackerNewChrCount + nHackerDelChrCount + nHackerSelChrCount + n4ADC1C + n4ADC20 + n4ADC24 + n4ADC28;
  if n4ADBB8 <> n8 then begin
    n4ADBB8 := n8;
    MainOutMessage('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;
  try
    if HumDataDB.Open and (HumDataDB.Index(sChrName) = -1) then begin
      FillChar(ChrRecord, SizeOf(THumDataInfo), #0);
      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;
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;
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;
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);
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);
    //%O308/127.0.0.1/127.0.0.1$
    //%A308/#2<<<<<BL<<<<<<<<<H?<lH>xq!$
    if s10 <> '' then begin
      s19 := s10[1];
      s10 := Copy(s10, 2, Length(s10) - 1);
      //s19:=UpperCase(s19);
      case s19 of
        '-': begin
            SendKeepAlivePacket(GateInfo.Socket);
            dwKeepAliveTick := GetTickCount();
          end;
        'D': 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;
        'N': begin
            s10 := GetValidStr3(s10, s0C, ['/']);
            OpenUser(s0C, s10, GateInfo);
          end;
        'C': begin
            CloseUser(s10, GateInfo);
          end;
      end;
    end;
  end;
end;

procedure TFrmUserSoc.SendKeepAlivePacket(Socket: TCustomWinSocket);
begin
  if Socket.Connected then
    Socket.SendText('%++$');
end;

procedure TFrmUserSoc.SendKickUser(Socket: TCustomWinSocket; nKickType: Integer);
begin
  if Socket.Connected then begin
    case nKickType of
      0: Socket.SendText('%+-$');
      1: Socket.SendText('%+T$');
      2: Socket.SendText('%+B$');
    end;
  end;
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
  sGateIPaddr := GetValidStr3(sIP, sUserIPaddr, ['/']);
  for i := 0 to GateInfo.UserList.Count - 1 do begin
    UserInfo := GateInfo.UserList.Items[i];
    if (UserInfo <> nil) and (UserInfo.sConnID = sID) then begin
      Exit;
    end;
  end;
  New(UserInfo);
  UserInfo.sAccount := '';
  UserInfo.sUserIPaddr := sUserIPaddr;
  UserInfo.sGateIPaddr := sGateIPaddr;
  UserInfo.sConnID := sID;
  UserInfo.nSessionID := 0;