传奇单机版,GM论坛,传奇版本库,GM基地

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

[复制链接]
查看: 227   回复: 0     # 登录器源码

197

主题

199

帖子

7614

积分

霸王教主

Rank: 9Rank: 9Rank: 9

积分
7614
2022-9-12 16:44:12   显示全部楼层   阅读模式  
Lyy冷雨夜登录器源码,适配新火鸟0528插件,其他插件正版的需要改SelGate 不然要花屏,登录器编译通过可用,外面买的登录器都是这版代码编译出来的。
0528Dlq.png



[Delphi] 纯文本查看 复制代码
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.



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







上一篇:老42插件版lyy冷雨夜登录器Delphi源码
下一篇:新1.4C登录器Delphi源码冷雨夜适配King1.4c插件
回复 关闭延时

使用道具 举报

您需要登录后才可以回帖   登录 立即注册

高级模式

Powered by Discuz! X3.4 © Comsenz Inc.

Archiver|手机版|小黑屋|美林传奇GM论坛 ( 蜀ICP备2020030293号-2 )