loginfrm.pas

NetHook API 对战平台内核库是一套实现时下流行的网络对战平台[如浩方、VS]同样功能的通用内核库

unit LoginFrm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ExtCtrls, NhcNetManager, NhGlobalDef, NhGlobalST,
  NhcNetBusiness, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  IdHTTP, IdAntiFreezeBase, IdAntiFreeze, NhcConfig, BaseFrm, ComCtrls;

type
  TLoginForm = class(TBaseForm)
    LoginButton: TButton;
    RegButton: TButton;
    ExitButton: TButton;
    Panel1: TPanel;
    Label1: TLabel;
    SrvCombox: TComboBox;
    UserNameEdit: TEdit;
    Label4: TLabel;
    Label5: TLabel;
    PasswordEdit: TEdit;
    Bevel1: TBevel;
    Panel2: TPanel;
    Label3: TLabel;
    IdHTTPMain: TIdHTTP;
    TimeCheckUpdateLabel: TTimer;
    RadioLocalSrv: TRadioButton;
    RadioPublicSrv: TRadioButton;
    UpdateSrvListLabel: TLabel;
    procedure LoginButtonClick(Sender: TObject);
    procedure ExitButtonClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure RegButtonClick(Sender: TObject);
    procedure UpdateSrvListLabelClick(Sender: TObject);
    procedure TimeCheckUpdateLabelTimer(Sender: TObject);
    procedure RadioPublicSrvClick(Sender: TObject);
    procedure RadioLocalSrvClick(Sender: TObject);
  private
    FDispather: TBcNetEventDisper;
    FNeedTerminate: Boolean;
    FCheckAbort: Boolean;
    FIsRunngingThread: Boolean;

    procedure OnLoginResult(ResultCode: Integer; const ResultMsg: string;
      UserAry: TBaseUserInfoAry);
    procedure OnRegisterResult(ResultCode: Integer; const ResultMsg: string);
  private
    procedure FormatSrvList(const S: string; var SrvIpAry: TServerIPInfoAry);
    procedure LoadServers(IsLocalSrv: Boolean);

    procedure CreateDispatcher;
    procedure DestroyDispatcher;

    procedure SetServerAddr(IsLocalSrv: Boolean);
  public

  end;

  TUpdateThread = class(TThread)
  private
    FForm: TLoginForm;
    FDataStr: string;

    procedure DoUpdateSrvList;
    procedure DoGetDataFromSrv;
  protected
    procedure Execute; override;
  public
    constructor Create(AForm: TLoginForm);
  end;


function ShowLoginForm(AlwaysOnTop, IsCheckAbort: Boolean; var NeedTerminate: Boolean): Boolean;

implementation

uses NhSocketObj, ProjectUtils, MainFrm, NhBaseBizPacket, StrUtils, BackMainFrm;

{$R *.dfm}

function ShowLoginForm(AlwaysOnTop, IsCheckAbort: Boolean; var NeedTerminate: Boolean): Boolean;
var
  Form: TLoginForm;
begin
  Form := TLoginForm.Create(nil);
  try
    Form.Visible := False;
    Form.FCheckAbort := IsCheckAbort;
    if AlwaysOnTop then
      Form.FormStyle := fsStayOnTop;

    Result := (Form.ShowModal = mrOk);
    NeedTerminate := Form.FNeedTerminate;
  finally
    Form.Free;
  end;
end;

procedure TLoginForm.CreateDispatcher;
begin
  FDispather := TBcNetEventDisper.Create;
  FDispather.OnLoginResult := OnLoginResult;
  FDispather.OnRegisterResult := OnRegisterResult;
end;

procedure TLoginForm.DestroyDispatcher;
begin
  if FDispather <> nil then
  begin
    FreeAndNil(FDispather);
  end;
end;

procedure TLoginForm.ExitButtonClick(Sender: TObject);
const
  MSG = '服务器已切换，现在退出将退出程序，是否继续？';
begin
  if FNeedTerminate and FCheckAbort then
  begin
    if MessageBox(0, PChar(MSG), '提示信息', MB_YESNO + MB_ICONQUESTION) = mrYes then
    begin
      ModalResult := mrCancel;
    end;
  end else
  begin
    ModalResult := mrCancel;
  end;
end;

procedure TLoginForm.LoadServers(IsLocalSrv: Boolean);
var
  I: Integer;
begin
  SrvCombox.Items.Clear;

  if IsLocalSrv then
  begin
    for I := 0 to ConfigMgr.UserServerCount - 1 do
    begin
      SrvCombox.Items.Add(ConfigMgr.UserServers[I].Name)
    end;
  end else
  begin
    for I := 0 to ConfigMgr.NetServerCount - 1 do
    begin
      SrvCombox.Items.Add(ConfigMgr.NetServers[I].Name);
    end;
  end;

  if SrvCombox.Items.Count > 0 then
    SrvCombox.ItemIndex := 0;
end;

procedure TLoginForm.FormCreate(Sender: TObject);
  procedure CreateObjects;
  begin
    CreateDispatcher;
  end;

  procedure LoadUserConfig;
  begin
    UserNameEdit.Text := ConfigMgr.UserName;
    PasswordEdit.Text := ConfigMgr.Password;
  end;
begin
  LoadServers(RadioLocalSrv.Checked);
  CreateObjects;
  LoadUserConfig;

  FNeedTerminate := False;
  FIsRunngingThread := False;
  FCheckAbort := False;
end;

procedure TLoginForm.FormDestroy(Sender: TObject);
begin
  DestroyDispatcher;
end;

procedure TLoginForm.LoginButtonClick(Sender: TObject);
const
  MSG = '登录将断开当前连接，是否继续?';
  FLAGS = MB_YESNO + MB_ICONWARNING;
begin
  if FCheckAbort then
  begin
    if MessageBox(Handle, PChar(MSG), '提示信息', FLAGS) <> mrYes then
    begin
      Exit;
    end else
      MainForm.Hide;
  end;
  
  FNeedTerminate := True;

  DestroyDispatcher;
  NetMgr.Finalize;

  NetMgr.Initialize;
  CreateDispatcher;
  SetServerAddr(RadioLocalSrv.Checked);

  ConfigMgr.UserName := Trim(UserNameEdit.Text);
  ConfigMgr.Password := Trim(PasswordEdit.Text);
  ConfigMgr.Save;

  NetMgr.NetBusiness.Login(ConfigMgr.UserName, ConfigMgr.Password, GetExeCardinalVer);
  LoginButton.Enabled := False;
  LoginButton.Caption := '登录中';
end;

procedure TLoginForm.OnLoginResult(ResultCode: Integer; const ResultMsg: string;
  UserAry: TBaseUserInfoAry);

  procedure AddUsers;
  var
    I: Integer;
    SaveIndex: Integer;
    ListItem: TListItem;
  begin
    MainForm.UserListView.Items.Clear;
    for I := 0 to Length(UserAry) - 1 do
    begin
      if UserAry[I].UserName = NetMgr.NetBusiness.SelfInfo.UserName then
        ListItem := MainForm.UserListView.Items.Insert(0)
      else
        ListItem := MainForm.UserListView.Items.Add; 

      SaveIndex := MainForm.AllocUserAryIndex;

      ListItem.Caption := UserAry[I].UserName;
      ListItem.SubItems.Add(UserAry[I].LevelName);
      ListItem.SubItems.Add(NetMgr.NetBusiness.SelfInfo.GetGameNameByID(UserAry[I].GameID));
      ListItem.Data := Pointer(SaveIndex);   // 记录存储位置

      // 复制数据
      MainForm.FUserAry[SaveIndex] := UserAry[I];
    end;
  end;
  
  procedure AddGames;
  var
    I: Integer;
  begin
    MainForm.GameNameCombox.Items.Clear;

    with NetMgr.NetBusiness do
    begin
      for I := 0 to Length(SelfInfo.GameAry) - 1 do
        MainForm.GameNameCombox.Items.Add(SelfInfo.GameAry[I].GameName);

      if MainForm.GameNameCombox.Items.Count > 0 then
      begin
        MainForm.GameNameCombox.ItemIndex := 0;
        MainForm.DisplayGameExeAndParam;
      end;
    end;

    MainForm.GameNameCombox.Enabled := True;
    MainForm.RunGameExeEdit.Enabled := True;
    MainForm.RunGameParamEdit.Enabled := True;
    MainForm.SelectExeButton.Enabled := True;
    MainForm.SearchGameExeBtn.Enabled := True;

    MainForm.RunGameExeEdit.Color := clWhite;
    MainForm.RunGameParamEdit.Color := clWhite;
  end;
begin
  if ResultCode = retSuccess then
  begin
    FreeAndNil(MainForm);
    Application.CreateForm(TMainForm, MainForm);

    AddGames;
    AddUsers;
    MainForm.BrowserFileDisplay(NetMgr.NetBusiness.SelfInfo.BoardMsg);

    MainForm.SendMsgButton.Enabled := True;
    MainForm.StartGameButton.Enabled  := True;

    MainForm.Caption := Format('%s [虚拟IP: %s - %s]',[MainForm.Caption,
      NetMgr.NetBusiness.SelfInfo.BaseInfo.VirtualIP, SrvCombox.Text]);

    LoginButton.Enabled := False;
    LoginButton.Caption := '已经登录';

    ModalResult := mrOk;
  end
  else
  begin
    LoginButton.Enabled := True;
    LoginButton.Caption := '登录';
    MessageBox(Handle, PChar('登录失败! 原因:' + ResultMsg), '提示信息', MB_ICONINFORMATION);
  end;
end;

procedure TLoginForm.OnRegisterResult(ResultCode: Integer; const ResultMsg: string);
begin
  RegButton.Enabled := True;
  RegButton.Caption := '注册帐号';

  if ResultCode = retSuccess then
  begin
    MessageBox(Handle, '恭喜您! 注册成功!', '提示信息', MB_ICONINFORMATION);
  end
  else
  begin
    MessageBox(Handle, PChar('注册失败! 原因:' + ResultMsg), '提示信息', MB_ICONINFORMATION);
  end;
end;

procedure TLoginForm.RadioLocalSrvClick(Sender: TObject);
begin
  LoadServers(RadioLocalSrv.Checked);
  UpdateSrvListLabel.Visible := False;
end;

procedure TLoginForm.RadioPublicSrvClick(Sender: TObject);
begin
  UpdateSrvListLabelClick(nil);
  UpdateSrvListLabel.Visible := True;
end;

procedure TLoginForm.RegButtonClick(Sender: TObject);
const
  MSG = '注册用户将断开当前连接，是否继续?';
  FLAGS = MB_YESNO + MB_ICONWARNING;
begin
  if FCheckAbort then
  begin
    if MessageBox(Handle, PChar(MSG), '提示信息', FLAGS) <> mrYes then
    begin
      Exit;
    end else
      MainForm.Hide;
  end;

  FNeedTerminate := True;

  DestroyDispatcher;
  NetMgr.Finalize;

  NetMgr.Initialize;
  CreateDispatcher;
  SetServerAddr(RadioLocalSrv.Checked);

  NetMgr.NetBusiness.RegisterUser(Trim(UserNameEdit.Text), Trim(PasswordEdit.Text));
  RegButton.Enabled := False;
  RegButton.Caption := '正在注册';
end;

procedure TLoginForm.SetServerAddr(IsLocalSrv: Boolean);
var
  SrvInfo: TServerIpInfo;
begin
  if SrvCombox.ItemIndex <> -1 then
  begin
    if IsLocalSrv then
    begin
      SrvInfo := ConfigMgr.UserServers[SrvCombox.ItemIndex];
    end else
    begin
      SrvInfo := ConfigMgr.NetServers[SrvCombox.ItemIndex];
    end;

    // 解析IP地址
    SrvInfo.IP := LookupHostAddr(SrvInfo.IP);
    NetMgr.ServerAddr := PeerAddress(SrvInfo.IP, SrvInfo.Port);
  end;
end;

procedure TLoginForm.TimeCheckUpdateLabelTimer(Sender: TObject);
begin
  UpdateSrvListLabel.Enabled := not FIsRunngingThread;
  SrvCombox.Enabled := not FIsRunngingThread;
end;

procedure TLoginForm.FormatSrvList(const S: string; var SrvIpAry: TServerIPInfoAry);
var
  List, SubList: TStringList;
  I: Integer;
begin
  List := TStringList.Create;
  SubList := TStringList.Create;
  try
    List.Text := AnsiReplaceText(S, '|', #13#10);

    SetLength(SrvIpAry, List.Count);
    for I := 0 to List.Count - 1 do
    begin
      SubList.Text := AnsiReplaceText(List[I], ',', #13#10);

      SrvIpAry[I].Name := SubList[0];
      SrvIpAry[I].IP := SubList[1];
      SrvIpAry[I].Port := StrToInt(SubList[2]);
    end;
  finally
    SubList.Free;
    List.Free;
  end;
end;

procedure TLoginForm.UpdateSrvListLabelClick(Sender: TObject);
begin
  TUpdateThread.Create(Self).Resume;
end;

{ TUpdateThread }

constructor TUpdateThread.Create(AForm: TLoginForm);
begin
  inherited Create(True);

  FreeOnTerminate := True;
  FForm  := AForm;
end;

procedure TUpdateThread.DoGetDataFromSrv;
begin
  FForm.IdHTTPMain.ConnectTimeout := 5000;
  FForm.IdHTTPMain.ReadTimeout := 5000;

  try
    FDataStr := FForm.IdHTTPMain.Get(ConfigMgr.UpdateSrvListUrl);
  except
    FDataStr := '';
  end;
end;

procedure TUpdateThread.DoUpdateSrvList;
var
  SrvIpAry: TServerIPInfoAry;
begin
  if FDataStr <> '' then
  begin
    try
      FForm.FormatSrvList(FDataStr, SrvIpAry);
    except
      SetLength(SrvIpAry, 0);
    end;

    if Length(SrvIpAry) > 0 then
    begin
      ConfigMgr.UpdateNetServers(SrvIpAry);
      FForm.LoadServers(FForm.RadioLocalSrv.Checked);
    end;
  end;
end;

procedure TUpdateThread.Execute;
begin
  FForm.FIsRunngingThread := True;
  try
    try
      DoGetDataFromSrv;
      Synchronize(DoUpdateSrvList);
    except
    end;
  finally
    FForm.FIsRunngingThread := False;
  end;
end;

end.