dbsmain.~pas

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

unit DBSMain;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics,
  Controls, Forms, Dialogs, StdCtrls, ExtCtrls, JSocket, Buttons, IniFiles,
  Menus, Grobal2, HumDB, DBShare, ComCtrls, ActnList, AppEvnts, DB,
  DBTables, Common;
type
  TServerInfo = record
    nSckHandle: Integer; //0x00
    sStr: string; //0x04
    bo08: Boolean; //0x08
    Socket: TCustomWinSocket; //0x0C
  end;
  pTServerInfo = ^TServerInfo;
  THumSession = record
    sChrName: string[14];
    nIndex: Integer;
    Socket: TCustomWinSocket; //0x20
    bo24: Boolean;
    bo2C: Boolean;
    dwTick30: LongWord;
  end;
  pTHumSession = ^THumSession;
  TLoadHuman = record
    sAccount: string[12];
    sChrName: string[14];
    sUserAddr: string[15];
    nSessionID: Integer;
  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;
    LbTransCount: TLabel;
    Label2: TLabel;
    Label6: TLabel;
    LbUserCount: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    Label11: TLabel;
    CkViewHackMsg: TCheckBox;
    MainMenu: TMainMenu;
    MENU_CONTROL: TMenuItem;
    MENU_OPTION: TMenuItem;
    MENU_MANAGE: TMenuItem;
    MENU_OPTION_GENERAL: TMenuItem;
    MENU_OPTION_GAMEGATE: TMenuItem;
    MENU_CONTROL_START: TMenuItem;
    T1: TMenuItem;
    N1: TMenuItem;
    G1: TMenuItem;
    MENU_MANAGE_DATA: TMenuItem;
    MENU_MANAGE_TOOL: TMenuItem;
    MENU_TEST: TMenuItem;
    MENU_TEST_SELGATE: TMenuItem;
    ListView: TListView;
    ApplicationEvents1: TApplicationEvents;
    N2: TMenuItem;
    N3: TMenuItem;
    X1: TMenuItem;
    Query: TQuery;
    DataSource: TDataSource;
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure AniTimerTimer(Sender: TObject);
    procedure StartTimerTimer(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
    procedure BtnUserDBToolClick(Sender: TObject);
    procedure CkViewHackMsgClick(Sender: TObject);
    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 MENU_TEST_SELGATEClick(Sender: TObject);
    procedure MENU_CONTROL_STARTClick(Sender: TObject);
    procedure G1Click(Sender: TObject);
    procedure ApplicationEvents1Exception(Sender: TObject; E: Exception);
    procedure X1Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure MENU_OPTION_GENERALClick(Sender: TObject);
  private
    n334: Integer;
    m_DefMsg: TDefaultMessage;
    n344: Integer;
    n348: Integer;
    s34C: string;
    ServerList: TList; //0x354
    HumSessionList: TList; //0x358
    m_boRemoteClose: Boolean;
    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);
    procedure ShowModule();
    function LoadItemsDB(): Integer;
    function LoadMagicDB(): Integer;
    { Private declarations }
  public
    function CopyHumData(sSrcChrName, sDestChrName, sUserId: string): Boolean;
    procedure DelHum(sChrName: string);
    procedure MyMessage(var MsgData: TWmCopyData); message WM_COPYDATA;
    { Public declarations }
  end;

var
  FrmDBSrv: TFrmDBSrv;
implementation
uses FIDHum, UsrSoc, AddrEdit, HUtil32, EDcode,
  IDSocCli, DBTools, TestSelGate, RouteManage, Setting;

{$R *.DFM}
procedure TFrmDBSrv.ServerSocketClientConnect(Sender: TObject;
  Socket: TCustomWinSocket);
var
  ServerInfo: pTServerInfo;
  sIPaddr: string;
begin
  sIPaddr := Socket.RemoteAddress;
  if not CheckServerIP(sIPaddr) then begin
    MainOutMessage('非法服务器连接: ' + sIPaddr);
    Socket.Close;
    Exit;
  end;
  Server_sRemoteAddress := sIPaddr;
  Server_nRemotePort := Socket.RemotePort;
  ServerSocketClientConnected := True;
  //MainOutMessage('ServerSocketClientConnect' + sIPaddr);
  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;
  ServerSocketClientConnected := False;
end;

procedure TFrmDBSrv.ServerSocketClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
var
  i: Integer;
  ServerInfo: pTServerInfo;
  s10: string;
begin
  dwKeepServerAliveTick := GetTickCount;
  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;
  DefMsg: TDefaultMessage;
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;
  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);
  //MemoLog.Lines.Add('DefMsg.Ident ' + IntToStr(DefMsg.Ident));
  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);
        MemoLog.Lines.Add('Fail ' + IntToStr(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;
  DefMsg: TDefaultMessage;
  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
        MainOutMessage('[非法重复请求] ' + '帐号: ' + sAccount + ' IP: ' + sIPaddr + ' 标识: ' + IntToStr(nSessionID));
      end else begin
        MainOutMessage('[非法请求] ' + '帐号: ' + sAccount + ' IP: ' + sIPaddr + ' 标识: ' + IntToStr(nSessionID));
      end;
      //nCheckCode:= 1; //测试用，正常去掉
    end;
  end;
  if nCheckCode = 1 then begin
    try
      if HumDataDB.OpenEx 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, SizeOf(THumDataInfo)));
  end else begin
    m_DefMsg := MakeDefaultMsg(DBR_LOADHUMANRCD, nCheckCode, 0, 0, 0);
    SendSocket(Socket, EncodeMessage(m_DefMsg));
  end;