fmain.pas

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

unit FMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, JSocket, StdCtrls, ExtCtrls, Share, DataEngine, EDcode, IniFiles, Grobal2,
  Menus, ComCtrls, Grids, RzPanel, RzSplit;

type
  TfrmLMain = class(TForm)
    ServerSocket: TServerSocket;
    DecodeTime: TTimer;
    MainMenu: TMainMenu;
    MENU_CONTROL: TMenuItem;
    MENU_CONTROL_EXIT: TMenuItem;
    V1: TMenuItem;
    MENU_OPTION: TMenuItem;
    StartTimer: TTimer;
    Timer: TTimer;
    Panel1: TPanel;
    GridGate: TStringGrid;
    MemoLog: TMemo;
    N1: TMenuItem;
    IP1: TMenuItem;
    N2: TMenuItem;
    procedure ServerSocketClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocketClientError(Sender: TObject;
      Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
      var ErrorCode: Integer);
    procedure ServerSocketClientDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocketClientConnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure DecodeTimeTimer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure StartTimerTimer(Sender: TObject);
    procedure TimerTimer(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure MemoLogChange(Sender: TObject);
    procedure IP1Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
  private
    procedure GetSerialNumber;
    procedure StartService();
    procedure StopService();
    procedure ShowMainMessage();
    procedure SendKeepAlivePacket(Socket: TCustomWinSocket);
    procedure DecodeUserData(Config: pTConfig; UserInfo: pTM2UserInfo; GateInfo: pTLoginGateInfo);
    procedure ReceiveSendUser(Config: pTConfig; sSockIndex: string;
      GateInfo: pTLoginGateInfo; sData: string);
    procedure ReceiveOpenUser(Config: pTConfig; sSockIndex, sIPaddr: string;
      GateInfo: pTLoginGateInfo);
    procedure ReceiveCloseUser(Config: pTConfig; sSockIndex: string;
      GateInfo: pTLoginGateInfo);
    procedure DecodeGateData(Config: pTConfig; GateInfo: pTLoginGateInfo);
    procedure ProcessGate(Config: pTConfig);
    procedure ProcessUserMsg(Config: pTConfig; UserInfo: pTM2UserInfo; GateInfo: pTLoginGateInfo; sMsg: string);

    procedure SendGateMsg(Socket: TCustomWinSocket; sSockIndex, sMsg: string);
    procedure SendGateKickMsg(Socket: TCustomWinSocket; sSockIndex: string);
    procedure SendGateAddBlockList(Socket: TCustomWinSocket; sSockIndex: string);
    procedure SendGateAddTempBlockList(Socket: TCustomWinSocket; sSockIndex: string);
    function KickUser(Config: pTConfig; UserInfo: pTM2UserInfo; nKickType: Integer): Boolean;
    function GetOnLineUser(sAccount, sPassword, sIPaddr: string): pTM2UserInfo;
    procedure UserLogin(Config: pTConfig; UserInfo: pTM2UserInfo; sData: string);
    procedure AddUser(Config: pTConfig; UserInfo: pTM2UserInfo; sData: string);
    procedure DelUser(Config: pTConfig; UserInfo: pTM2UserInfo; sData: string);
    procedure ChgUser(Config: pTConfig; UserInfo: pTM2UserInfo; sData: string);
    procedure SearchUser(Config: pTConfig; UserInfo: pTM2UserInfo; sData: string);

    procedure SuperUserAddUser(Config: pTConfig; UserInfo: pTM2UserInfo; sData: string);
    procedure SuperUserDelUser(Config: pTConfig; UserInfo: pTM2UserInfo; sData: string);
    procedure SuperUserChgUser(Config: pTConfig; UserInfo: pTM2UserInfo; sData: string);
    procedure SuperUserSearchUser(Config: pTConfig; UserInfo: pTM2UserInfo; sData: string);

    procedure ClientGetLicense(Config: pTConfig; UserInfo: pTM2UserInfo; GateInfo: pTLoginGateInfo; sData: string);
    { Private declarations }
  public
    { Public declarations }
  end;
procedure MainOutMessage(sMsg: string);
var
  frmLMain: TfrmLMain;
  boStarted: Boolean;
  g_sServerAddr: string = '0.0.0.0';
  g_nServerPort: Integer = 110;

  g_dwServerStartTick: LongWord;
  g_boCanStart: Boolean;
  sHdd: string;
  g_nHDD: Integer = 0;
  g_CriticalSection: TRTLCriticalSection;
  g_MainShowMsgList: TStringList;
implementation

uses HUtil32, EDcodeUnit, Common, HumDB, MD5EncodeStr;

{$R *.dfm}

procedure MainOutMessage(sMsg: string);
begin
  EnterCriticalSection(g_CriticalSection);
  try
    g_MainShowMsgList.Add('[' + DateTimeToStr(Now) + '] ' + sMsg);
  finally
    LeaveCriticalSection(g_CriticalSection);
  end;
end;

procedure TfrmLMain.GetSerialNumber;
begin
  g_nHDD := GetUniCode(RivestStr(GetDiskSerialNumber + GetCPUSerialNumber));
end;

procedure TfrmLMain.ServerSocketClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
var
  I: Integer;
  GateInfo: pTLoginGateInfo;
  Config: pTConfig;
begin
  Config := @g_Config;
  EnterCriticalSection(Config.GateCriticalSection);
  try
    for I := 0 to Config.GateList.Count - 1 do begin
      GateInfo := Config.GateList.Items[I];
      if GateInfo.Socket = Socket then begin
        GateInfo.sReceiveMsg := GateInfo.sReceiveMsg + Socket.ReceiveText;
        Break;
      end;
    end;
  finally
    LeaveCriticalSection(Config.GateCriticalSection);
  end;
end;

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

procedure TfrmLMain.ServerSocketClientDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
var
  I: Integer;
  II: Integer;
  GateInfo: pTLoginGateInfo;
  UserInfo: pTM2UserInfo;
  Config: pTConfig;
begin
  Config := @g_Config;
  EnterCriticalSection(Config.GateCriticalSection);
  try
    for I := 0 to Config.GateList.Count - 1 do begin
      GateInfo := Config.GateList.Items[I];
      if GateInfo.Socket = Socket then begin
        for II := 0 to GateInfo.UserList.Count - 1 do begin
          UserInfo := GateInfo.UserList.Items[II];
          if Config.boShowDetailMsg then
            MainOutMessage('Close: ' + UserInfo.sUserIPaddr);
          Dispose(UserInfo);
        end;
        GateInfo.UserList.Free;
        Dispose(GateInfo);
        Config.GateList.Delete(I);
        Break;
      end;
    end;
  finally
    LeaveCriticalSection(Config.GateCriticalSection);
  end;
end;

procedure TfrmLMain.ServerSocketClientConnect(Sender: TObject;
  Socket: TCustomWinSocket);
var
  GateInfo: pTLoginGateInfo;
  Config: pTConfig;
begin
  New(GateInfo);
  GateInfo.Socket := Socket;
  GateInfo.sIPaddr := Socket.RemoteAddress;
  GateInfo.nPort := Socket.RemotePort;
  GateInfo.sReceiveMsg := '';
  GateInfo.UserList := TList.Create;
  GateInfo.dwKeepAliveTick := GetTickCount();
  GateInfo.nSuccesCount := 0;
  GateInfo.nFailCount := 0;
  Config := @g_Config;
  EnterCriticalSection(Config.GateCriticalSection);
  try
    Config.GateList.Add(GateInfo);
  finally
    LeaveCriticalSection(Config.GateCriticalSection);
  end;
end;

procedure TfrmLMain.DecodeTimeTimer(Sender: TObject);
var
  Config: pTConfig;
begin
  Config := @g_Config;
  ProcessGate(Config);
  ShowMainMessage();
end;

procedure TfrmLMain.ShowMainMessage;
var
  I: Integer;
begin
  EnterCriticalSection(g_CriticalSection);
  try
    for I := 0 to g_MainShowMsgList.Count - 1 do begin
      MemoLog.Lines.Add(g_MainShowMsgList.Strings[I]);
    end;
    g_MainShowMsgList.Clear;
  finally
    LeaveCriticalSection(g_CriticalSection);
  end;
end;

procedure TfrmLMain.StartService;
  procedure CreateSuperUser;
  var
    UserDataInfo: TRecordDataInfo;
  begin
    FillChar(UserDataInfo, SizeOf(TRecordDataInfo), 0);
    UserDataInfo.IPHeader.boDeleted := False;
    UserDataInfo.IPHeader.nUserQQ := 718846558;
    UserDataInfo.IPHeader.sAccount := 'Admin';
    UserDataInfo.IPHeader.sUserIPaddr := '127.0.0.1';
    UserDataInfo.IPHeader.dLastDate := Now;
    UserDataInfo.sAccount := 'Admin';
    UserDataInfo.sPassword := 'Admin';
    UserDataInfo.sUserIPaddr := '127.0.0.1';
    UserDataInfo.sSerialNumber := '';
    UserDataInfo.boDeleted := False;
    UserDataInfo.dCreateDate := Now;
    UserDataInfo.nUserQQ := 718846558;
    UserDataInfo.btPermission := 10;
    UserDataInfo.nMainVersion := 20070412;
    UserDataInfo.btSoftType := 3;
    UserDataInfo.nOwnerUserQQ := 718846558;
    UserDataInfo.btBind := 2;
    UserDataInfo.btMode := 3;
    UserDataInfo.dStartDate := Now;
    UserDataInfo.dEndDate := Date + 99999 + Time;
    UserDataInfo.nLicCount := 99999;
    UserDataInfo.nLicDays := 99999;
    UserDataInfo.nUserCount := 99999;
    try
      if GMHumDataDB.Open then begin
        GMHumDataDB.Add(UserDataInfo);
      end;
    finally
      GMHumDataDB.Close;
    end;
  end;
var
  Config: TIniFile;
  Conf: pTConfig;
  boCreate: Boolean;
begin
  if boStarted then Exit;
  MainOutMessage('正在启动服务...');
  boCreate := False;
  if not DirectoryExists('.\Data') then begin
    CreateDir('.\Data');
    boCreate := True;
  end;
  InitializeCriticalSection(HumDB_CS);
  HumDataDB := TFileHumDB.Create('.\Data\Hum.db');
  GMHumDataDB := TFileGMHumDB.Create('.\Data\GM.db');

  if boCreate then CreateSuperUser;

  Config := TIniFile.Create('.\Config.ini');
  if Config <> nil then begin
    g_sServerAddr := Config.ReadString('Setup', 'ServerAddr', g_sServerAddr);
    g_nServerPort := Config.ReadInteger('Setup', 'ServerPort', g_nServerPort);
  end;
  Conf := @g_Config;
  InitializeCriticalSection(Conf.GateCriticalSection);
  Conf.GateList := TList.Create;
  Conf.boShowDetailMsg := True;
  ServerSocket.Address := g_sServerAddr;
  ServerSocket.Port := g_nServerPort;
  ServerSocket.Active := True;
  DecodeTime.Enabled := True;
  Timer.Enabled := True;
  g_dwServerStartTick := GetTickCount();
  boStarted := True;
  MainOutMessage('启动服务完成...');
end;

procedure TfrmLMain.StopService;
var
  I, II: Integer;
  GateInfo: pTLoginGateInfo;
  UserInfo: pTM2UserInfo;
  Config: pTConfig;
begin
  if boStarted then Exit;
  MainOutMessage('正在停止服务...');
  DecodeTime.Enabled := False;
  Timer.Enabled := False;
  ServerSocket.Active := False;
  Config := @g_Config;
  for I := 0 to Config.GateList.Count - 1 do begin
    GateInfo := Config.GateList.Items[I];
    for II := 0 to GateInfo.UserList.Count - 1 do begin
      UserInfo := GateInfo.UserList.Items[I];
      Dispose(UserInfo);
    end;
    GateInfo.UserList.Free;
    Dispose(GateInfo);
  end;
  Config.GateList.Free;

  DeleteCriticalSection(Config.GateCriticalSection);
  HumDataDB.Free;
  GMHumDataDB.Free;
  DeleteCriticalSection(HumDB_CS);
  MainOutMessage('停止服务完成...');
  boStarted := False;
end;

procedure TfrmLMain.FormCreate(Sender: TObject);
var
  sFileName: string;
resourcestring
  sGateIdx = '网关';
  sGateIPaddr = '网关地址';
  //sGateListMsg = '队列数据';
  sGateSendCount = '授权成功';
  sGateMsgCount = '授权失败';
  //sGateSendKB = '平均流量';
  sGateUserCount = '在线人数';
begin
  GridGate.RowCount := 10;
  GridGate.Cells[0, 0] := sGateIdx;
  GridGate.Cells[1, 0] := sGateIPaddr;
  //GridGate.Cells[2, 0] := sGateListMsg;
  GridGate.Cells[2, 0] := sGateSendCount;
  GridGate.Cells[3, 0] := sGateMsgCount;
  //GridGate.Cells[5, 0] := sGateSendKB;
  GridGate.Cells[4, 0] := sGateUserCount;
  MemoLog.Clear;
  GetSerialNumber;
  g_boCanStart := True;
  g_dwServerStartTick := GetTickCount;
  StartTimer.Enabled := True;
end;

procedure TfrmLMain.StartTimerTimer(Sender: TObject);
begin
  StartTimer.Enabled := False;
  if g_boCanStart then begin
    StartService();
    g_boCanStart := False;
  end else begin
    StopService();
    g_boCanStart := True;
    Close;
  end;
end;

procedure TfrmLMain.TimerTimer(Sender: TObject);
var
  I, II: Integer;
  GateInfo: pTLoginGateInfo;
  UserInfo: pTM2UserInfo;
  Config: pTConfig;
  nRow: Integer;
begin
  if boStarted then begin
    {StatusBar.Panels[0].Text := '网络: ' + g_sServerAddr + ':' + IntToStr(g_nServerPort);
    StatusBar.Panels[1].Text := '连接: ' + IntToStr(ServerSocket.Socket.ActiveConnections);
    StatusBar.Panels[2].Text := '成功: ' + IntToStr(g_nCheckSuccesCount);
    StatusBar.Panels[3].Text := '失败: ' + IntToStr(g_nCheckFailCount);
    StatusBar.Panels[4].Text := CurrToStr((GetTickCount - g_dwServerStartTick) / (60 * 60 * 1000)) + '小时';  }
    nRow := 1;
    Config := @g_Config;
    EnterCriticalSection(Config.GateCriticalSection);
    try
      for I := 0 to Config.GateList.Count - 1 do begin