dbsmain.pas

来自「FIR引擎最新源码+注册」· PAS 代码 · 共 1,088 行 · 第 1/3 页

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;
    sStr: string;
    s34C: string;
    bo08: Boolean;
    Socket: TCustomWinSocket;
  end;
  pTServerInfo = ^TServerInfo;

  THumSession = record
    sChrName: string[14];
    nIndex: Integer;
    Socket: TCustomWinSocket;
    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;
    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 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;
    ServerArray: array[0..1000] of TServerInfo;
    nServerCount: Integer;
    //HumSessionList: TList;
    m_boRemoteClose: Boolean;
    procedure ProcessServerPacket(ServerInfo: pTServerInfo);
    procedure ProcessServerMsg(sMsg: string; nLen: Integer; ServerInfo: pTServerInfo);
    procedure SendSocket(ServerInfo: pTServerInfo; sMsg: string);
    procedure LoadHumanRcd(sMsg: string; ServerInfo: pTServerInfo);
    procedure SaveHumanRcd(nRecog: Integer; sMsg: string; ServerInfo: pTServerInfo);
    procedure SaveHumanRcdEx(sMsg: string; nRecog: Integer; ServerInfo: pTServerInfo);
    procedure ClearSocket(Socket: TCustomWinSocket);
    procedure ShowModule();
    function LoadItemsDB(): Integer;
    function LoadMagicDB(): Integer;
    procedure ResServerArray;
    { 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
  sIPaddr: string;
  i: Integer;
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;

  if not boOpenDBBusy then begin
    for i := Low(ServerArray) to High(ServerArray) do begin
      if ServerArray[i].Socket = nil then begin
        ServerArray[i].nSckHandle := Socket.SocketHandle;
        ServerArray[i].sStr := '';
        ServerArray[i].s34C := '';
        ServerArray[i].bo08 := True;
        ServerArray[i].Socket := Socket;
        Socket.nIndex := i;
        Inc(nServerCount);
        Break;
      end;
    end;
  end else begin
    Socket.Close;
  end;
end;

procedure TFrmDBSrv.ServerSocketClientDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
var
  nSockIndex: Integer;
begin
  nSockIndex := Socket.nIndex;
  if (nSockIndex >= Low(ServerArray)) and (nSockIndex <= High(ServerArray)) then begin
    if ServerArray[nSockIndex].Socket = Socket then begin
      ServerArray[nSockIndex].nSckHandle := 0;
      ServerArray[nSockIndex].sStr := '';
      ServerArray[nSockIndex].s34C := '';
      ServerArray[nSockIndex].bo08 := False;
      ServerArray[nSockIndex].Socket := nil;
      Dec(nServerCount);
    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;
  nSockIndex: Integer;
  s10: string;
begin
  dwKeepServerAliveTick := GetTickCount;
  g_CheckCode.dwThread0 := 1001000;
  nSockIndex := Socket.nIndex;
  if (nSockIndex >= Low(ServerArray)) and (nSockIndex <= High(ServerArray)) then begin
    g_CheckCode.dwThread0 := 1001001;
    ServerInfo := @ServerArray[nSockIndex];
    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);
        end else begin
          if Length(ServerInfo.sStr) > 81920 then begin
            ServerInfo.sStr := '';
            Inc(n4ADC2C);
          end;
        end;
      end;
    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));
        ServerInfo.s34C := s24;
        if CompareBackLStr(s20, SC, Length(SC)) then begin
          g_CheckCode.dwThread0 := 1001104;
          ProcessServerMsg(s20, n14, ServerInfo);
          g_CheckCode.dwThread0 := 1001105;
          bo25 := True;
        end;
      end;
    end;
    if s1C <> '' then begin
      Inc(n4ADC00);
      Label4.Caption := 'Error ' + IntToStr(n4ADC00);
    end;
    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, EncodeMessage(m_DefMsg));
      Inc(n4ADC00);
      Label4.Caption := 'Error ' + IntToStr(n4ADC00);
    end;
  finally
  end;
  g_CheckCode.dwThread0 := 1001106;
end;

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

procedure TFrmDBSrv.ProcessServerMsg(sMsg: string; nLen: Integer; ServerInfo: pTServerInfo);
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;
  DefMsg := DecodeMessage(sDefMsg);
  //MemoLog.Lines.Add('DefMsg.Ident ' + IntToStr(DefMsg.Ident));
  case DefMsg.Ident of
    DB_LOADHUMANRCD: begin
        LoadHumanRcd(sData, ServerInfo);
      end;
    DB_SAVEHUMANRCD: begin
        SaveHumanRcd(DefMsg.Recog, sData, ServerInfo);
      end;
    DB_SAVEHUMANRCDEX: begin
        SaveHumanRcdEx(sData, DefMsg.Recog, ServerInfo);
      end;
  else begin
      m_DefMsg := MakeDefaultMsg(DBR_FAIL, 0, 0, 0, 0);
      SendSocket(ServerInfo, EncodeMessage(m_DefMsg));
      Inc(n4ADC04);
      MemoLog.Lines.Add('Fail ' + IntToStr(n4ADC04));
    end;
  end;
  g_CheckCode.dwThread0 := 1001216;
end;

procedure TFrmDBSrv.LoadHumanRcd(sMsg: string; ServerInfo: pTServerInfo);
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;