dbsmain.pas

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

unit DBSMain;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics,
  Controls, Forms, Dialogs, StdCtrls, ExtCtrls, JSocket, Buttons, IniFiles,
  Menus, Grobal2;

type
  pTServerInfo = ^TServerInfo;
  TServerInfo = record
    nSckHandle: integer;           //0x00
    sStr:   string;                //0x04
    bo08:   boolean;               //0x08
    Socket: TCustomWinSocket;      //0x0C
  end;

  pTHumSession = ^THumSession;
  THumSession = record
    sChrName: string;
    nIndex:   integer;
    Socket:   TCustomWinSocket; //0x20
    bo24:     boolean;
    bo2C:     boolean;
    dwTick30: longword;
  end;

  TFrmDBSrv = class(TForm)
    ServerSocket: TServerSocket;
    Timer1: TTimer;
    AniTimer: TTimer;
    StartTimer: TTimer;
    Timer2: TTimer;
    MemoLog: TMemo;
    Panel1: TPanel;
    Label1: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    LbAutoClean: TLabel;
    Panel2: TPanel;
    BtnUserDBTool: TSpeedButton;
    LbTransCount: TLabel;
    Label2: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    LbUserCount: TLabel;
    BtnReloadAddr: TButton;
    BtnEditAddrs: TButton;
    Label8: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    Label11: TLabel;
    CkViewHackMsg: TCheckBox;
    MainMenu: TMainMenu;
    MENU_CONTROL: TMenuItem;
    V1:    TMenuItem;
    MENU_OPTION: TMenuItem;
    MENU_MANAGE: TMenuItem;
    MENU_OPTION_GENERAL: TMenuItem;
    MENU_OPTION_GAMEGATE: TMenuItem;
    MENU_CONTROL_START: TMenuItem;
    MENU_CONTROL_STOP: TMenuItem;
    N1:    TMenuItem;
    G1:    TMenuItem;
    MENU_MANAGE_DATA: TMenuItem;
    MENU_MANAGE_TOOL: TMenuItem;
    MENU_TEST: TMenuItem;
    MENU_TEST_SELGATE: TMenuItem;
    Exit1: TMenuItem;
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: boolean);
    procedure AniTimerTimer(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure StartTimerTimer(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
    procedure BtnUserDBToolClick(Sender: TObject);
    procedure BtnReloadAddrClick(Sender: TObject);
    procedure BtnEditAddrsClick(Sender: TObject);
    procedure CkViewHackMsgClick(Sender: TObject);
    procedure WriteLogMsg(sMsg: string);
    procedure OutMainMessageA(sMsg: string);
    procedure ServerSocketClientConnect(Sender: TObject; Socket: TCustomWinSocket);
    procedure ServerSocketClientDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocketClientError(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: integer);
    procedure ServerSocketClientRead(Sender: TObject; Socket: TCustomWinSocket);
    procedure MENU_MANAGE_DATAClick(Sender: TObject);
    procedure MENU_MANAGE_TOOLClick(Sender: TObject);
    procedure V1Click(Sender: TObject);
    procedure MENU_TEST_SELGATEClick(Sender: TObject);
    procedure MENU_CONTROL_STARTClick(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
  private
    n334:     integer;
    m_DefMsg: TDefaultMessage;
    n344:     integer;
    n348:     integer;
    s34C:     string;

    ServerList:      TList; //0x354
    HumSessionList:  TList; //0x358
    m_boRemoteClose: boolean;
    procedure MainOutMessage(sMsg: string);
    procedure ProcessServerPacket(ServerInfo: pTServerInfo);
    procedure ProcessServerMsg(sMsg: string; nLen: integer;
      Socket: TCustomWinSocket);
    procedure SendSocket(Socket: TCustomWinSocket; sMsg: string);
    procedure LoadHumanRcd(sMsg: string; Socket: TCustomWinSocket);
    procedure SaveHumanRcd(nRecog: integer; sMsg: string; Socket: TCustomWinSocket);
    procedure SaveHumanRcdEx(sMsg: string; nRecog: integer;
      Socket: TCustomWinSocket);
    procedure ClearSocket(Socket: TCustomWinSocket);

    { Private declarations }
  public
    function CopyHumData(sSrcChrName, sDestChrName, sUserID: string): boolean;
    procedure DelHum(sChrName: string);
    { Public declarations }
  end;

var
  FrmDBSrv: TFrmDBSrv;

implementation

uses HumDB, DBShare, FIDHum, UsrSoc, AddrEdit, HUtil32, EDcode,
  IDSocCli, DBTools, TestSelGate, RouteManage;

{$R *.DFM}

procedure TFrmDBSrv.ServerSocketClientConnect(Sender: TObject;
  Socket: TCustomWinSocket);
var
  ServerInfo: pTServerInfo;
  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(ServerInfo);
    ServerInfo.bo08   := True;
    ServerInfo.nSckHandle := Socket.SocketHandle;
    ServerInfo.sStr   := '';
    ServerInfo.Socket := Socket;
    ServerList.Add(ServerInfo);
  end else begin
    Socket.Close;
  end;
end;

procedure TFrmDBSrv.ServerSocketClientDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
var
  i: integer;
  ServerInfo: pTServerInfo;
begin
  for i := 0 to ServerList.Count - 1 do begin
    ServerInfo := ServerList.Items[i];
    if ServerInfo.nSckHandle = Socket.SocketHandle then begin
      Dispose(ServerInfo);
      ServerList.Delete(i);
      ClearSocket(Socket);
      break;
    end;
  end;
end;

procedure TFrmDBSrv.ServerSocketClientError(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: integer);
begin
  ErrorCode := 0;
  Socket.Close;
end;

procedure TFrmDBSrv.ServerSocketClientRead(Sender: TObject; Socket: TCustomWinSocket);
var
  i:   integer;
  ServerInfo: pTServerInfo;
  s10: string;
begin
  g_CheckCode.dwThread0 := 1001000;
  for i := 0 to ServerList.Count - 1 do begin
    g_CheckCode.dwThread0 := 1001001;
    ServerInfo := ServerList.Items[i];
    g_CheckCode.dwThread0 := 1001002;
    if ServerInfo.nSckHandle = Socket.SocketHandle then begin
      g_CheckCode.dwThread0 := 1001003;
      s10 := Socket.ReceiveText;
      Inc(n4ADBF4);
      if s10 <> '' then begin
        g_CheckCode.dwThread0 := 1001004;
        ServerInfo.sStr := ServerInfo.sStr + s10;
        g_CheckCode.dwThread0 := 1001005;
        if Pos('!', s10) > 0 then begin
          g_CheckCode.dwThread0 := 1001006;
          ProcessServerPacket(ServerInfo);
          g_CheckCode.dwThread0 := 1001007;
          Inc(n4ADBF8);
          Inc(n348);
          Break;
        end else begin//004A7DC7
          if Length(ServerInfo.sStr) > 81920 then begin
            ServerInfo.sStr := '';
            Inc(n4ADC2C);
          end;
        end;
      end;
      Break;
    end;
  end;
  g_CheckCode.dwThread0 := 1001008;
end;

procedure TFrmDBSrv.ProcessServerPacket(ServerInfo: pTServerInfo);
var
  bo25:     boolean;
  sC, s1C, s20, s24: string;
  n14, n18: integer;
  wE, w10:  word;
begin
  g_CheckCode.dwThread0 := 1001100;
  if boOpenDBBusy then exit;
  try
    bo25 := False;
    s1C  := ServerInfo.sStr;
    ServerInfo.sStr := '';
    s20  := '';
    g_CheckCode.dwThread0 := 1001101;
    s1C  := ArrestStringEx(s1C, '#', '!', s20);
    g_CheckCode.dwThread0 := 1001102;
    if s20 <> '' then begin
      g_CheckCode.dwThread0 := 1001103;
      s20 := GetValidStr3(s20, s24, ['/']);
      n14 := length(s20);
      if (n14 >= DEFBLOCKSIZE) and (s24 <> '') then begin
        wE   := Str_ToInt(s24, 0) xor 170;
        w10  := n14;
        n18  := MakeLong(wE, w10);
        sC   := EncodeBuffer(@n18, SizeOf(integer));
        s34C := s24;
        if CompareBackLStr(s20, sC, Length(sC)) then begin
          g_CheckCode.dwThread0 := 1001104;
          ProcessServerMsg(s20, n14, ServerInfo.Socket);
          g_CheckCode.dwThread0 := 1001105;
          bo25 := True;
        end;
      end; //0x004A7F7B
    end; //0x004A7F7B
    if s1C <> '' then begin
      Inc(n4ADC00);
      Label4.Caption := 'Error ' + IntToStr(n4ADC00);
    end; //0x004A7FB5
    if not bo25 then begin
      m_DefMsg := MakeDefaultMsg(DBR_FAIL, 0, 0, 0, 0);
      {
      DefMsg:=MakeDefaultMsg(DBR_FAIL,0,0,0,0);
      n338:=DefMsg.Recog;
      n33C:=DefMsg.Ident;
      n340:=DefMsg.Tag;
      }
      SendSocket(ServerInfo.Socket, EncodeMessage(m_DefMsg));
      Inc(n4ADC00);
      Label4.Caption := 'Error ' + IntToStr(n4ADC00);
    end; //0x004A8048
  finally
  end;
  g_CheckCode.dwThread0 := 1001106;
end;

procedure TFrmDBSrv.SendSocket(Socket: TCustomWinSocket; sMsg: string);//0x004A8764
var
  n10: integer;
  s18: string;
begin
  Inc(n4ADBFC);
  n10 := MakeLong(Str_ToInt(s34C, 0) xor 170, Length(sMsg) + 6);
  s18 := EncodeBuffer(@n10, SizeOf(integer));
  Socket.SendText('#' + s34C + '/' + sMsg + s18 + '!');
end;

procedure TFrmDBSrv.ProcessServerMsg(sMsg: string; nLen: integer;
  Socket: TCustomWinSocket);
//0x004A9278
var
  sDefMsg, sData: string;
  DefMsg: TDefaultMessage;
begin
  if nLen = DEFBLOCKSIZE then begin
    sDefMsg := sMsg;
    sData   := '';
  end else begin
    sDefMsg := Copy(sMsg, 1, DEFBLOCKSIZE);
    sData   := Copy(sMsg, DEFBLOCKSIZE + 1, Length(sMsg) - DEFBLOCKSIZE - 6);
  end; //0x004A9304
  DefMsg := DecodeMessage(sDefMsg);
  case DefMsg.Ident of
    DB_LOADHUMANRCD: begin
      LoadHumanRcd(sData, Socket);
    end;
    DB_SAVEHUMANRCD: begin
      SaveHumanRcd(DefMsg.Recog, sData, Socket);
    end;
    DB_SAVEHUMANRCDEX: begin
      SaveHumanRcdEx(sData, DefMsg.Recog, Socket);
    end;
    else begin
      m_DefMsg := MakeDefaultMsg(DBR_FAIL, 0, 0, 0, 0);
      SendSocket(Socket, EncodeMessage(m_DefMsg));
      Inc(n4ADC04);
    end;
  end;
  g_CheckCode.dwThread0 := 1001216;
end;

procedure TFrmDBSrv.LoadHumanRcd(sMsg: string; Socket: TCustomWinSocket);
var
  sHumName:   string;
  sAccount:   string;
  sIPaddr:    string;
  nIndex:     integer;
  nSessionID: integer;
  nCheckCode: integer;
  HumanRCD:   THumDataInfo;
  LoadHuman:  TLoadHuman;
  boFoundSession: boolean;
begin
  DecodeBuffer(sMsg, @LoadHuman, SizeOf(TLoadHuman));
  sAccount   := LoadHuman.sAccount;
  sHumName   := LoadHuman.sChrName;
  sIPaddr    := LoadHuman.sUserAddr;
  nSessionID := LoadHuman.nSessionID;
  nCheckCode := -1;
  if (sAccount <> '') and (sHumName <> '') then begin
    if (FrmIDSoc.CheckSessionLoadRcd(sAccount, sIPaddr, nSessionID, boFoundSession)) then
    begin
      nCheckCode := 1;
    end else begin
      if boFoundSession then begin
        OutMainMessage('[非法重复请求] ' + '帐号: ' + sAccount +
          ' IP: ' + sIPaddr + ' 标识: ' + IntToStr(nSessionID));
      end else begin
        OutMainMessage('[非法请求] ' + '帐号: ' + sAccount + ' IP: ' +
          sIPaddr + ' 标识: ' + IntToStr(nSessionID));
      end;
      //nCheckCode:= 1; //测试用，正常去掉
    end;
  end;
  if nCheckCode = 1 then begin
    try
      if HumDataDB.Open then begin
        nIndex := HumDataDB.Index(sHumName);
        if nIndex >= 0 then begin
          if HumDataDB.Get(nIndex, HumanRCD) < 0 then nCheckCode := -2;
        end else
          nCheckCode := -3;
      end else
        nCheckCode := -4;
    finally
      HumDataDB.Close();
    end;
  end;

  if nCheckCode = 1 then begin
    m_DefMsg := MakeDefaultMsg(DBR_LOADHUMANRCD, 1, 0, 0, 1);
    SendSocket(Socket, EncodeMessage(m_DefMsg) + EncodeString(sHumName) +
      '/' + EncodeBuffer(@HumanRCD.Data, SizeOf(THumData)));
  end else begin //0x004A8C7E
    m_DefMsg := MakeDefaultMsg(DBR_LOADHUMANRCD, nCheckCode, 0, 0, 0);
    SendSocket(Socket, EncodeMessage(m_DefMsg));
  end;
end;
//004A8D38
procedure TFrmDBSrv.SaveHumanRcd(nRecog: integer; sMsg: string;
  Socket: TCustomWinSocket);
var
  sChrName: string;
  sUserID: string;
  sHumanRCD: string;
  I:      integer;
  nIndex: integer;
  bo21:   boolean;
  HumData: THumData;
  HumanRCD: THumDataInfo;
  HumSession: pTHumSession;
begin
  sHumanRCD := GetValidStr3(sMsg, sUserID, ['/']);
  sHumanRCD := GetValidStr3(sHumanRCD, sChrName, ['/']);
  sUserID   := DecodeString(sUserID);
  sChrName  := DecodeString(sChrName);
  bo21      := False;
  FillChar(HumData, SizeOf(THumData), #0);
  FillChar(HumanRCD, SizeOf(THumDataInfo), #0);
  if Length(sHumanRCD) = GetCodeMsgSize(SizeOf(THumData) * 4 / 3) then
    DecodeBuffer(sHumanRCD, @HumData, SizeOf(THumData))
  else
    bo21 := True;
  if not bo21 then begin
    bo21 := True;
    try
      if HumDataDB.Open then begin
        nIndex := HumDataDB.Index(sChrName);
        if nIndex < 0 then begin