新火鸟登录器源代码Delphi,lyy冷雨夜代码

夜游神 · 发表于 2022-9-12 16:44:12

Lyy冷雨夜登录器源码,适配新火鸟0528插件，其他插件正版的需要改SelGate 不然要花屏，登录器编译通过可用,外面买的登录器都是这版代码编译出来的。

[mw_shl_code=delphi,true]unit Reg;

interface

uses
  Windows, Forms, SysUtils, SUIMgr, JSocket, SUIButton, StdCtrls, SUIMemo,
  SUIEdit, Controls, Classes, SUIForm, ExtCtrls;

type
  TRegForm = class(TForm)
suiForm1: TsuiForm;
ClientSocket1: TClientSocket;
ID: TsuiEdit;
PassWD: TsuiEdit;
RePass: TsuiEdit;
Q1: TsuiEdit;
A1: TsuiEdit;
EMail: TsuiEdit;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label6: TLabel;
Label7: TLabel;
Label10: TLabel;
Info: TsuiMemo;
suiButton1: TsuiButton;
suiButton2: TsuiButton;
A2: TsuiEdit;
Label12: TLabel;
suiThemeManager1: TsuiThemeManager;
Label4: TLabel;
RenKey: TsuiEdit;
L_RenStr: TLabel;
procedure EnID(Sender: TObject);
procedure EnPassWD(Sender: TObject);
procedure EnRePass(Sender: TObject);
procedure ClientSocket1Error(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer);
procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
procedure suiButton1Click(Sender: TObject);
procedure IDKeyPress(Sender: TObject; var Key: Char);
procedure Q1Enter(Sender: TObject);
procedure A1Enter(Sender: TObject);
procedure EMailEnter(Sender: TObject);
procedure EMailKeyPress(Sender: TObject; var Key: Char);
procedure suiButton2Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure IDChange(Sender: TObject);
procedure ClientSocket1Disconnect(Sender: TObject; Socket: TCustomWinSocket);
procedure A2Enter(Sender: TObject);
procedure RenKeyEnter(Sender: TObject);
procedure PassWDKeyPress(Sender: TObject; var Key: Char);
procedure RePassKeyPress(Sender: TObject; var Key: Char);
procedure Q1KeyPress(Sender: TObject; var Key: Char);
procedure A1KeyPress(Sender: TObject; var Key: Char);
procedure A2KeyPress(Sender: TObject; var Key: Char);
procedure FormShow(Sender: TObject);
procedure RenKeyKeyPress(Sender: TObject; var Key: Char);
procedure ClientSocket1Connect(Sender: TObject;
   Socket: TCustomWinSocket);

  private
IsClose: Boolean;
CPN: Char;
function IsEMail(EMail: string): Boolean;

  public
{ Public declarations }
  end;

var
  RegForm          : TRegForm;
implementation

uses Func, EDCode;

{$R *.dfm}

function TRegForm.IsEMail(EMail: string): Boolean;
var
  s                : string;
  ETpos          : Integer;
begin
  ETpos := Q_PosStr('@', EMail);
  if ETpos > 1 then
  begin
s := copy(EMail, ETpos + 1, Length(EMail));
if (Q_PosStr('.', s) > 1) and (Q_PosStr('.', s) < Length(s)) then
   Result := True
else
   Result := False;
  end
  else
Result := False;
end;

procedure TRegForm.IDKeyPress(Sender: TObject; var Key: Char);
begin
  if Key = #13 then PassWD.SetFocus;
  if not (Key in ['a'..'z', 'A'..'Z', '0'..'9', '_', #8]) then
  begin
Key := #0;
MessageBeep(1);
  end;
end;

procedure TRegForm.PassWDKeyPress(Sender: TObject; var Key: Char);
begin
  if (Key = '''') or (Key = ' ') then Key := #0;
  if Key = #13 then RePass.SetFocus;
end;

procedure TRegForm.RePassKeyPress(Sender: TObject; var Key: Char);
begin
  if (Key = '''') or (Key = ' ') then Key := #0;
  if Key = #13 then Q1.SetFocus;
end;

procedure TRegForm.Q1KeyPress(Sender: TObject; var Key: Char);
begin
  if Key = #13 then A1.SetFocus;
  if Key in ['"', ',', '`', '=', '<', '>', '\', '(', ')', Chr(34), Chr(39)] then Key := #0;
  if (Key = '''') or (Key = ' ') then Key := #0;
end;

procedure TRegForm.A1KeyPress(Sender: TObject; var Key: Char);
begin
  if Key = #13 then A2.SetFocus;
  if Key in ['"', ',', '`', '=', '<', '>', '\', '(', ')', Chr(34), Chr(39)] then Key := #0;
  if (Key = '''') or (Key = ' ') then Key := #0;
end;

procedure TRegForm.A2KeyPress(Sender: TObject; var Key: Char);
begin
  if Key = #13 then EMail.SetFocus;
  if (Key = '''') or (Key = ' ') then Key := #0;
end;

procedure TRegForm.EMailKeyPress(Sender: TObject; var Key: Char);
begin
  if Key = #13 then RenKey.SetFocus;
  if not (Key in ['@', 'a'..'z', 'A'..'Z', '0'..'9', '_', '-', '.', #8]) then
  begin
Key := #0;
MessageBeep(1);
  end;
end;

procedure TRegForm.RenKeyKeyPress(Sender: TObject; var Key: Char);
begin
  if Key = #13 then suiButton1.Click;
  if not (Key in ['a'..'z', 'A'..'Z', '0'..'9', #8]) then
  begin
Key := #0;
MessageBeep(1);
  end;
end;

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

procedure TRegForm.ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
var
  Msg             : TLongMsg;
  Data             : string;
  Body             : string;
begin
  Data := Socket.ReceiveText;
  UnClientPack(Data, Msg, Body);
  case Msg.Comm of
CM_GetRenStr:                      //随机验证码
   begin
      L_RenStr.Caption := Q_UpperCase(Body);
   end;
CM_Reg:
   begin
      case Msg.param of             //start case
      PM_UserRep: MessShow(2, '建立帐号失败！' + #10#10 + '你输入的帐号已经存在,请用别的帐号注册！');
      PM_RenError: MessShow(2, '建立帐号失败！' + #10#10 + '输入的随机验证码不符合！');
      PM_Disable: MessShow(2, '建立帐号失败！' + #10#10 + '服务器禁止注册帐号,请稍候再注册！');
      PM_SqlError: MessShow(2, '建立帐号失败！' + #10#10 + '服务器数据库错误，请通知管理员！');
      PM_StrError: MessShow(2, '建立帐号失败！' + #10 + '你输入的资料当中包含有禁用字符' + #10 + '输入的资料不要包含如下禁止字符:' + #10 + '" , ` = < > \ ( ) ' + Chr(39) + #10 + '请重新注册！');
      PM_StrBlank: MessShow(2, '建立帐号失败！' + #10#10 + '输入的资料中包含有空格,请重新注册！');
      PM_UnError: MessShow(2, '建立帐号失败！' + #10#10 + '发生未知错误,请通知管理员！');
      PM_UserOK: MessShow(1, '恭喜你,帐号:' + ID.Text + '注册成功！' + #10#10 + '祝你游戏愉快！');
      end;                         //end sase
      IsClose := False;
      Close;
   end;
  end;
end;

procedure TRegForm.EnID(Sender: TObject);
begin
  Info.Clear;
  Info.Lines.Add(#13#10 + ' ID的输入格式:');
  Info.Lines.Add(#13#10 + ' 由4-15位数字、字母、或下划线组成.');
  Info.Lines.Add(#13#10 + ' 注意事项:');
  Info.Lines.Add(#13#10 + ' 1.请不要包含中文字符或空格等特殊字符.');
  Info.Lines.Add(#13#10 + ' 2.请一定记住你输入的ID.');
  Info.Lines.Add(#13#10 + ' 3.ID尽量不要和你将来的角色名相同.');
end;

procedure TRegForm.EnPassWD(Sender: TObject);
begin
  Info.Clear;
  Info.Lines.Add(#13#10 + ' 密码的输入格式:');
  Info.Lines.Add(#13#10 + ' 由4-15位数字、字母和符号组成.');
  Info.Lines.Add(#13#10 + ' 注意事项:');
  Info.Lines.Add(#13#10 + ' 1.请不要包含空格或者特殊字符.');
  Info.Lines.Add(#13#10 + ' 2.请一定要记住你输入的密码.');
  Info.Lines.Add(#13#10 + ' 3.为了帐号安全,请不要使用过于简单的密码.');
end;

procedure TRegForm.EnRePass(Sender: TObject);
begin
  Info.Clear;
  Info.Lines.Add(#13#10 + ' 请再输入一次密码,两次输入的密码必须相同');
end;

procedure TRegForm.Q1Enter(Sender: TObject);
begin
  Info.Clear;
  Info.Lines.Add(#13#10 + ' 输入密码保护提示问题:');
  Info.Lines.Add(#13#10 + ' 1.请不要包含空格或者特殊字符.');
  Info.Lines.Add(#13#10 + ' 2.务必认真填写,这对你找回密码非常重要.');
  Info.Lines.Add(#13#10 + ' 3.建议不要使用过于简单的提示问题.');
end;

procedure TRegForm.A1Enter(Sender: TObject);
begin
  Info.Clear;
  Info.Lines.Add(#13#10 + ' 输入密码保护答案:');
  Info.Lines.Add(#13#10 + ' 1.答案为30位以为的字符（15个以内汉字）.');
  Info.Lines.Add(#13#10 + ' 2.务必记住答案,这是找回密码必须的依据.');
  Info.Lines.Add(#13#10 + ' 3.建议不要使用过于简单的答案.');
  Info.Lines.Add(#13#10 + ' 4.为了帐号安全,请不要把此答案告诉任何人.');
end;

procedure TRegForm.A2Enter(Sender: TObject);
begin
  Info.Clear;
  Info.Lines.Add(#13#10 + ' 输入密码保护密匙:');
  Info.Lines.Add(#13#10 + ' 1.密匙由4-15位数字、字母和符号组成.');
  Info.Lines.Add(#13#10 + ' 2.此项配合密码保护答案找回密码之用.');
  Info.Lines.Add(#13#10 + ' 3.务必记住密匙,这是找回密码必须的依据.');
  Info.Lines.Add(#13#10 + ' 4.密匙区分字母大小写，一定要注意.');
  Info.Lines.Add(#13#10 + ' 5.为了帐号安全,请不要把密匙告诉任何人.');
end;

procedure TRegForm.EMailEnter(Sender: TObject);
begin
  Info.Clear;
  Info.Lines.Add(#13#10 + ' 电子邮件的输入格式:');
  Info.Lines.Add(#13#10 + ' 请输入你常用的电子邮件.');
  Info.Lines.Add(#13#10 + ' 注意事项:');
  Info.Lines.Add(#13#10 + ' 输入正确的电子邮件对你找回密码有所帮助.');
end;

procedure TRegForm.RenKeyEnter(Sender: TObject);
begin
  Info.Clear;
  Info.Lines.Add(#13#10 + ' 输入随机验证码:');
  Info.Lines.Add(#13#10 + ' 请输入右边红色方框内的内容.');
  Info.Lines.Add(#13#10 + ' 字母不区分大小写.');
end;

procedure TRegForm.suiButton1Click(Sender: TObject);
var
  User             : TRegUser;
  SendMsg          : TLongMsg;
  SendBody       : string;
  UserID          : string[15];
  UserPass       : string[15];
  RRePass          : string[15];
  PQ1             : string[30];
  PA1             : string[30];
  PQ2             : string[30];
  PA2             : string[15];
  UserEmail       : string[40];
  EnRenKey       : string[8];
begin
  UserID := trim(ID.Text);
  if Length(UserID) < 4 then
  begin
MessShow(1, 'ID不能少于4位!');
ID.SetFocus;
exit;
  end;
  UserPass := trim(PassWD.Text);
  RRePass := trim(RePass.Text);
  if Length(UserPass) < 4 then
  begin
MessShow(1, '密码不能少于4位!');
PassWD.SetFocus;
exit;
  end;
  if UserPass <> RRePass then
  begin
MessShow(1, '两次输入的密码必须相同!');
RePass.SetFocus;
exit;
  end;
  if UserPass = UserID then
  begin
MessShow(1, '为了帐号安全,输入的ID和密码不能相同!');
PassWD.SetFocus;
exit;
  end;
  PQ1 := trim(Q1.Text);
  if Length(PQ1) = 0 then
  begin
MessShow(1, '请输入密码保护提示问题!');
Q1.SetFocus;
exit;
  end;
  PA1 := trim(A1.Text);
  if Length(PA1) = 0 then
  begin
MessShow(1, '请输入密码保护的答案!');
A1.SetFocus;
exit;
  end;
  if (UserPass = PA1) or (UserID = PA1) or (PQ1 = PA1) then
  begin
MessShow(1, '为了帐号安全,密码保护的答案不能和提示问题、ID或密码相同!');
A1.SetFocus;
exit;
  end;
  PA2 := trim(A2.Text);
  if Length(PA2) = 0 then
  begin
MessShow(1, '请输入密码保护密匙!');
A2.SetFocus;
exit;
  end;
  if Length(PA2) < 4 then
  begin
MessShow(1, '密码保护密匙不能少于4位!');
A2.SetFocus;
exit;
  end;
  if (UserPass = PA2) or (UserID = PA2) then
  begin
MessShow(1, '为了帐号安全,密钥不能和用户ID或密码相同!');
A2.SetFocus;
exit;
  end;
  PQ2 := '■问题2■';
  UserEmail := trim(EMail.Text);
  if not IsEMail(UserEmail) then
  begin
MessShow(1, '填写的Email格式错误,请输入正确的电子信箱!');
EMail.SetFocus;
exit;
  end;
  EnRenKey := trim(RenKey.Text);
  EnRenKey := Q_LowerCase(EnRenKey);
  if EnRenKey <> Q_LowerCase(L_RenStr.Caption) then
  begin
MessShow(1, '动态验证码输入错误,请输入红色方框上的字母和数字!');
RenKey.SetFocus;
exit;
  end;
  suiButton1.Enabled := False;
  User.UserID := UserID;
  User.UserPass := UserPass;
  User.PQ1 := PQ1;
  User.PA1 := PA1;
  User.PQ2 := PQ2;
  User.PA2 := PA2;
  User.UserEmail := UserEmail;
  User.EnRenKey := EnRenKey;
  SendMsg.Comm := CM_Reg;
  SendBody := EncodeBuffer(@User, SizeOf(TRegUser), edtMir2);
  SendSocket(ClientSocket1.Socket, CPN, SendMsg, SendBody)
end;

procedure TRegForm.suiButton2Click(Sender: TObject);
begin
  IsClose := False;
  Close;
end;

procedure TRegForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if ClientSocket1.Active then ClientSocket1.Active := False;
end;

procedure TRegForm.IDChange(Sender: TObject);
begin
  suiButton1.Enabled := True;
end;

procedure TRegForm.ClientSocket1Disconnect(Sender: TObject; Socket: TCustomWinSocket);
begin
  if IsClose then
  begin
MessShow(2, '连接帐号服务器失败' + #10 + '帐号服务器可能已关闭或正在维护' + #10 + '请稍候再试...');
Close;
  end;
end;

procedure TRegForm.FormShow(Sender: TObject);
begin
  ID.Text := '';
  PassWD.Text := '';
  RePass.Text := '';
  Q1.Text := '';
  A1.Text := '';
  A2.Text := '';
  EMail.Text := '';
  RenKey.Text := '';
  L_RenStr.Caption := '........';
  ID.SetFocus;
  IsClose := True;
  CPN := '1';
  ClientSocket1.Active := True;
end;

procedure TRegForm.ClientSocket1Connect(Sender: TObject;
  Socket: TCustomWinSocket);
var
  SendMsg          : TLongMsg;
begin
  SendMsg.Comm := CM_GetRenStr;
  SendSocket(Socket, CPN, SendMsg);
end;

end.[/mw_shl_code]

游客，如果您要查看本帖隐藏内容请回复

MooCa · 发表于 2023-7-2 11:18:14

瞧瞧什么价格

hbzh1001 · 发表于 2023-7-8 17:23:37

太感谢楼主喽。

ryancg · 发表于 2024-3-1 08:51:20

asdfsdfsdfsdf

cwqc1 · 发表于 2024-3-12 17:06:46

点点滴滴都是恩惠

guzrong · 发表于 2024-4-9 23:46:43

积分任务

test39857 · 发表于 2024-4-12 13:17:02

感谢楼主分享，赞

hahaq · 发表于 2024-5-24 10:44:10

顶顶顶顶顶顶顶顶顶顶顶顶顶顶顶顶顶顶顶

新火鸟登录器源代码Delphi,lyy冷雨夜代码 [传奇3源码]

相关帖子