usrsoc.pas

传奇服务端代码 DBServerSQL.rar 通讯部分

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
    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(sUserID, 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('Invalid connection: ' + 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(sUserID, 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.sAccount  := sUserID;
      ChrRecord.Header.sChrName  := sChrName;
      ChrRecord.Data.sAccount := sUserID;
      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;