|
|
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]
|
|
发表于 2022-9-12 16:44:12
发表于 2023-7-2 11:18:14
