main.pas

传奇的登陆器!也是在网上搜索的!不知道好不好用

    ClientSocket.Address := '';
    if CheckIsIpAddr(m_SelGameZone.sGameIPaddr) then begin
      ClientSocket.Address := m_SelGameZone.sGameIPaddr;
    end else begin
      ClientSocket.Host := m_SelGameZone.sGameIPaddr;
    end;
    ClientSocket.Port := m_SelGameZone.nGameIPPort;
    ClientSocket.Active := true;
    WebBrowser1.Navigate(WideString(m_SelGameZone.sNoticeUrl));
  end;
end;

procedure TMainForm.ListBoxServerListDblClick(Sender: TObject);
begin
  if m_SelGameZone <> nil then begin
    ShellExecute(0, 'open', PChar(string(m_SelGameZone.sNoticeUrl)), nil, nil, SW_SHOWNORMAL);
  end;
end;

procedure TMainForm.ButtonHomePageClick(Sender: TObject);
begin
  ShellExecute(0, 'open', PChar(HomePage), nil, nil, SW_SHOWNORMAL);
end;

procedure TMainForm.ButtonLocalStartClick(Sender: TObject);
begin
  try
    if m_SelGameZone <> nil then begin
      frmCMain := TfrmCMain.Create(Owner);
      frmCMain.Open;
      Application.Minimize;
    end;
  except
  end;
end;

procedure TMainForm.ButtonAddGameClick(Sender: TObject);
begin
  frmEditGame := TfrmEditGame.Create(Owner);
  frmEditGame.Open();
  frmEditGame.Free;
end;

procedure TMainForm.TimerGetGameListTimer(Sender: TObject);
var
  s: TStringlist;
begin
  TimerGetGameList.Enabled := FALSE;
  IdHTTP.ReadTimeout := 1500; //此处是用来限制得到服务器列表所用的时间,用处请自行研究,本人认为1500左右较好
  try
    s := TStringlist.Create;
    s.Text := IdHTTP.Get(m_sRemoteAddress);
    s.SaveToFile(m_sGameListName); //读取游戏服务器列表
    //s.Clear;
    {s.Add(IdHTTP.Get('http://'+ConfigList+'/config.txt'));    //读取配置文件
    s.SaveToFile(Config);}
    s.Free;
  except
    TimerGetGameList.Enabled := FALSE;
  end;
  TimerGetGameList.Enabled := FALSE;
  LoadGameList;
  LoadLocalGameList;
  LoadGameListToBox;
  WebBrowser1.Navigate(Trim(HomePage));
end;

procedure TMainForm.ListBoxServerListDrawItem(Control: TWinControl;
  Index: Integer; Rect: TRect; State: TOwnerDrawState);
var
  nIdx: Integer;
begin
  ListBoxServerList.Canvas.FillRect(Rect);
  nIdx := Index mod 2;
  if nIdx = 0 then ListBoxServerList.Canvas.Font.Color := clRed
  else ListBoxServerList.Canvas.Font.Color := clBlue;
  ListBoxServerList.Canvas.TextOut(Rect.Left + 5, Rect.top + ((Rect.Bottom - Rect.top) - ListBoxServerList.Canvas.TextHeight('A')) div 2, ListBoxServerList.Items[Index]);
end;

procedure TMainForm.IdHTTPWork(Sender: TObject; AWorkMode: TWorkMode;
  const AWorkCount: Integer);
begin
  //Application.ProcessMessages;
end;

procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  UnLoadGameList;
  UnLoadLocalGameList;
  UnRegisterHotKey(Handle, HotKeyId); //注销CTRL+J
  DeleteFile(ExtractFilePath(ParamStr(0)) + sProgamFile); //删除文件
  DeleteFile(ExtractFilePath(ParamStr(0)) + mClientName); //删除文件
end;

procedure TMainForm.ButtonMinClick(Sender: TObject);
begin
  Application.Minimize;
end;

procedure TMainForm.ButtonCloseClick(Sender: TObject);
begin
  close;
end;
//==============================================================================
procedure TMainForm.SendCSocket(sendstr: string);
var
  sSendText: string;
begin
  if ClientSocket.Socket.Connected then begin
    sSendText := '#' + IntToStr(code) + sendstr + '!';
    ClientSocket.Socket.SendText('#' + IntToStr(code) + sendstr + '!');
    Inc(code);
    if code >= 10 then code := 1;
  end;
end;

procedure TMainForm.SendChgPw(sAccount, sPasswd, sNewPasswd: string); //发送修改密码
var
  Msg: TDefaultMessage;
begin
  Msg := MakeDefaultMsg(CM_CHANGEPASSWORD, 0, 0, 0, 0);
  SendCSocket(EncodeMessage(Msg) + EncodeString(sAccount + #9 + sPasswd + #9 + sNewPasswd));
end;

procedure TMainForm.SendGetBackPassword(sAccount, sQuest1, sAnswer1,
  sQuest2, sAnswer2, sBirthDay: string); //发送找回密码
var
  Msg: TDefaultMessage;
begin
  Msg := MakeDefaultMsg(CM_GETBACKPASSWORD, 0, 0, 0, 0);
  SendCSocket(EncodeMessage(Msg) + EncodeString(sAccount + #9 + sQuest1 + #9 + sAnswer1 + #9 + sQuest2 + #9 + sAnswer2 + #9 + sBirthDay));
end;

procedure TMainForm.SendUpdateAccount(ue: TUserEntry; ua: TUserEntryAdd); //发送新建账号
var
  Msg: TDefaultMessage;
begin
  MakeNewAccount := ue.sAccount;
  Msg := MakeDefaultMsg(CM_ADDNEWUSER, 0, 0, 0, 0);
  SendCSocket(EncodeMessage(Msg) + EncodeBuffer(@ue, SizeOf(TUserEntry)) + EncodeBuffer(@ua, SizeOf(TUserEntryAdd)));
end;

procedure TMainForm.ClientTimerTimer(Sender: TObject);
var
  str, data: string;
  len, I, n, mcnt: Integer;
begin
  if busy then Exit;
  busy := true;
  try
    BufferStr := BufferStr + SocStr;
    SocStr := '';
    if BufferStr <> '' then begin
      mcnt := 0;
      while Length(BufferStr) >= 2 do begin
        if Pos('!', BufferStr) <= 0 then break;
        BufferStr := ArrestStringEx(BufferStr, '#', '!', data);
        if data <> '' then begin
          DecodeMessagePacket(data);
        end else
          if Pos('!', BufferStr) = 0 then
          break;
      end;
    end;
  finally
    busy := FALSE;
  end;
end;

procedure TMainForm.DecodeMessagePacket(datablock: string);
var
  head, body, body2, tagstr, data, rdstr, str: string;
  Msg: TDefaultMessage;
  smsg: TShortMessage;
  mbw: TMessageBodyW;
  desc: TCharDesc;
  wl: TMessageBodyWL;
  featureEx: word;
  L, I, j, n, BLKSize, param, sound, cltime, svtime: Integer;
  tempb: Boolean;
begin
  if datablock[1] = '+' then begin
    Exit;
  end;
  if Length(datablock) < DEFBLOCKSIZE then begin
    Exit;
  end;
  head := Copy(datablock, 1, DEFBLOCKSIZE);
  body := Copy(datablock, DEFBLOCKSIZE + 1, Length(datablock) - DEFBLOCKSIZE);
  Msg := DecodeMessage(head);
  case Msg.Ident of
    SM_NEWID_SUCCESS: begin
        Application.MessageBox('您的帐号创建成功。' + #13 +
          '请妥善保管您的帐号和密码，' + #13 + '并且不要因任何原因把帐号和密码告诉任何其他人。' + #13 +
          '如果忘记了密码,你可以通过我们的主页重新找回。', '提示信息', MB_OK);
        frmNewAccount.close;
      end;
    SM_NEWID_FAIL: begin
        case Msg.Recog of
          0: begin
              Application.MessageBox(PChar('帐号 "' + MakeNewAccount + '" 已被其他的玩家使用了。' + #13 +
                '请选择其它帐号名注册。'), '提示信息', MB_OK);
            end;
          -2: Application.MessageBox('此帐号名被禁止使用！', '提示信息', MB_OK);
          else Application.MessageBox(PChar('帐号创建失败，请确认帐号是否包括空格、及非法字符！Code: ' + IntToStr(Msg.Recog)), '提示信息', MB_OK);
        end;
        frmNewAccount.ButtonOK.Enabled := true;
        Exit;
      end;
    ////////////////////////////////////////////////////////////////////////////////
    SM_CHGPASSWD_SUCCESS: begin
        Application.MessageBox('密码修改成功。', '提示信息', MB_OK);
        {frmChangePassword.ChgEditAccount.Text:='';
        frmChangePassword.ChgEditPassword.Text:='';
        frmChangePassword.ChgEditConfirm.Text:='';
        frmChangePassword.ChgEditNewPassword.Text:='';}
        frmChangePassword.ButtonOK.Enabled := FALSE;
        //frmNewAccount.Close;
        Exit;
      end;
    SM_CHGPASSWD_FAIL: begin
        case Msg.Recog of
          0: Application.MessageBox('输入的帐号不存在！！！', '提示信息', MB_OK);
          -1: Application.MessageBox('输入的原始密码不正确！', '提示信息', MB_OK);
          -2: Application.MessageBox('此帐号被锁定！', '提示信息', MB_OK);
          else Application.MessageBox('输入的新密码长度小于四位！', '提示信息', MB_OK);
        end;
        frmChangePassword.ButtonOK.Enabled := true;
        Exit;
      end;
    SM_GETBACKPASSWD_SUCCESS: begin
        frmGetBackPassword.EditPassword.Text := DecodeString(body);
        Application.MessageBox(PChar('密码找回成功。'), '提示信息', MB_OK);
        Exit;
      end;
    SM_GETBACKPASSWD_FAIL: begin
        case Msg.Recog of
          0: Application.MessageBox('输入的帐号不存在！！！', '提示信息', MB_OK + MB_ICONERROR);
          -1: Application.MessageBox('问题答案不正确！！！', '提示信息', MB_OK + MB_ICONERROR);
          -2: Application.MessageBox(PChar('此帐号被锁定！！！' + #13 + '请稍候三分钟再重新找回。'), '提示信息', MB_OK + MB_ICONERROR);
          -3: Application.MessageBox('答案输入不正确！！！', '提示信息', MB_OK + MB_ICONERROR);
          else Application.MessageBox('未知错误！', '提示信息', MB_OK + MB_ICONERROR);
        end;
        frmGetBackPassword.ButtonOK.Enabled := true;
        Exit;
      end;
  end;
end;

procedure TMainForm.ClientSocketRead(Sender: TObject;
  Socket: TCustomWinSocket);
var
  n: Integer;
  data, data2: string;
begin
  data := Socket.ReceiveText;
  n := Pos('*', data);
  if n > 0 then begin
    data2 := Copy(data, 1, n - 1);
    data := data2 + Copy(data, n + 1, Length(data));
    ClientSocket.Socket.SendText('*');
  end;
  SocStr := SocStr + data;
end;

procedure TMainForm.ButtonNewAccountClick(Sender: TObject);
begin
  ClientTimer.Enabled := true;
  frmNewAccount.LabelStatus.Caption := MsgLabel.Caption;
  frmNewAccount.Open;
end;

procedure TMainForm.ButtonChgPasswordClick(Sender: TObject);
begin
  ClientTimer.Enabled := true;
  frmChangePassword.LabelStatus.Caption := MsgLabel.Caption;
  frmChangePassword.Open;
end;

procedure TMainForm.ButtonGetBackPasswordClick(Sender: TObject);
begin
  ClientTimer.Enabled := true;
  frmGetBackPassword.LabelStatus.Caption := MsgLabel.Caption;
  frmGetBackPassword.Open;
end;

procedure TMainForm.ClientSocketError(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin
  m_boClientSocketConnect := FALSE;
  ErrorCode := 0;
  Socket.close;
end;

procedure TMainForm.ClientSocketConnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  m_boClientSocketConnect := true;
  MsgLabel.Caption := '服务器状态良好...';
  frmGetBackPassword.LabelStatus.Caption := MsgLabel.Caption;
  frmNewAccount.LabelStatus.Caption := MsgLabel.Caption;
  frmChangePassword.LabelStatus.Caption := MsgLabel.Caption;
end;

procedure TMainForm.ClientSocketDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  m_boClientSocketConnect := FALSE;
  MsgLabel.Font.Color := clLime;
  MsgLabel.Caption := '服务器连接关闭...';
  frmGetBackPassword.LabelStatus.Caption := MsgLabel.Caption;
  frmNewAccount.LabelStatus.Caption := MsgLabel.Caption;
  frmChangePassword.LabelStatus.Caption := MsgLabel.Caption;
end;

procedure TMainForm.ClientSocketConnecting(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  Application.ProcessMessages;
  MsgLabel.Font.Color := clLime;
  MsgLabel.Caption := '正在测试服务器状态...';
end;
//==============================================================================
///////////////////检测程序是否已经运行，如果已经运行则显示出来/////////////////
function GetMIError: Integer;
begin
  Result := MIERROR;
end;

function NewWndProc(Handle: HWND; Msg: Integer; wParam, lParam: Longint): Longint; stdcall;
begin
  Result := 0;
  if Msg = MessageId then begin
    case wParam of
      MI_QUERYWINDOWHANDLE: begin
          if IsIconic(Application.Handle) then begin
            Application.MainForm.WindowState := wsNormal;
            Application.Restore;
          end;
          PostMessage(HWND(lParam), MessageId, MI_RESPONDWINDOWNHANDLE, Application.MainForm.Handle);
        end;
      MI_RESPONDWINDOWNHANDLE: begin
          SetForegroundWindow(HWND(lParam));
          Application.Terminate;
        end;
    end;
  end
  else
    Result := CallWindowProc(WProc, Handle, Msg, wParam, lParam);
end;

procedure SubClassApplication;
begin
  WProc := TFNWndProc(SetWindowLong(Application.Handle, GWL_WNDPROC, Longint(@NewWndProc)));
  if WProc = nil then
    MIERROR := MIERROR or MI_ERROR_FAILSUBCLASS;
end;

procedure DoFirstinstance;
begin
  MutHandle := CreateMutex(nil, FALSE, UniqueAppStr);
  if MutHandle = 0 then
    MIERROR := MIERROR or MI_ERROR_CREATINGMUTEX;
end;

procedure BroadcastFocusMessage;
var
  BSMRecipients: DWORD;
begin
  Application.ShowMainForm := FALSE;
  BSMRecipients := BSM_APPLICATIONS;
  BroadCastSystemMessage(BSF_IGNORECURRENTTASK or BSF_POSTMESSAGE, @BSMRecipients,
    MessageId, MI_QUERYWINDOWHANDLE, Application.Handle);
end;

procedure initInstance;
begin
  SubClassApplication;
  MutHandle := OpenMutex(MUTEX_ALL_ACCESS, FALSE, UniqueAppStr);
  if MutHandle = 0 then
    DoFirstinstance
  else
    BroadcastFocusMessage;
end;

initialization
  begin
    MessageId := RegisterWindowMessage(UniqueAppStr);
    initInstance;
    Move(ColorArray, ColorTable, SizeOf(ColorArray));
  end;

finalization
  begin
    if WProc <> nil then
      SetWindowLong(Application.Handle, GWL_WNDPROC, Longint(WProc));
    if MutHandle <> 0 then
      CloseHandle(MutHandle);
  end;

end.