GOM登录器技术研究,闪退、掉线的原因分析和解决

      传奇很好玩,现在的年轻人对于这种游戏可能不喜欢。网上下载的登录器会自动转移目录,并且在桌面产生快捷方式,有的还会释放出其他程序。目前市面上的宏图和绿盟登录器都是将客户端和登录器集成在一起,这样做有好处也有弊端。所以准备自己弄一个登录器,把登录器和客户端独立开来,这样一个登录器可以启动无数款传奇游戏,只要配置上传奇游戏的资源包和服务器IP和微端IP、还有微端密码等基本参数即可。这样就纯粹一点,也是传统游戏的做法,目前市面上主流的宏图和绿盟登陆器并不是传统模式的登录器,在技术实现的角度上是超前的,比目前所有的网络游戏都也强大。

       对于GOM团队比较有点陌生,技术上很厉害,支起传奇游戏的半边天。最近在研究学习传奇GOM登录器技术的路上又了一些突破,无需额外的登录器,直接启动GOM客户端。不过在启动这个GOM客户端的时候,遇到层层困难,不过最后都是逐一突破,这个GOM客户端设计的非常精妙,登录器原理上也非常精妙,不按他的模式或结构去做登录器,GOM客户端就无法启动。不是闪退,就是启动了以后 显示断开连接掉线。从技术的角度触发这是一款设计非常精妙的登录器架构,里面有各种压缩和加密算法,结构层次复杂。一不小心就会让客户端闪退无法启动。

      纪念下,研究GOM登录器技术的这些日日夜夜,前方荆棘满地,从一开始的不知错所到最后的柳暗花明又一村,感谢GOM团队创作出这么优秀的登录器技术。

下面贴下原始Delphi版的代码,这份代码并不是适合做登录器开发,只是一个参考

unit Main;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, jpeg, ExtCtrls, RzBmpBtn, StdCtrls, RzLstBox, RzButton, RzRadChk,
  OleCtrls, SHDocVw, ComCtrls, ShlObj, ComObj, ActiveX, Grobal2, JSocket,
  Registry, winsock, WinInet, ShellApi, IniFiles, GameShare, IdBaseComponent,
  IdComponent, IdTCPConnection, IdTCPClient, IdHTTP, {ZLib,} tlHelp32, RzForms;
 
type
  TSearchThread = class(TThread)
  protected
    procedure Execute; override;
  public
    constructor Create(CreateSuspended: Boolean);
    destructor Destroy; override;
  end;
 
  TfrmMain = class(TForm)
    RzBmpButtonHomePage: TRzBmpButton;
    RzBmpButtonEditGameList: TRzBmpButton;
    RzBmpButtonNewAccount: TRzBmpButton;
    RzBmpButtonGetBakPassWord: TRzBmpButton;
    RzBmpButtonChgPassWord: TRzBmpButton;
    RzBmpButtonAutoLogin: TRzBmpButton;
    RzBmpButtonFullScreenStart: TRzBmpButton;
    RzBmpButtonClose: TRzBmpButton;
    Timer: TTimer;
    ClientSocket: TClientSocket;
    TimerStart: TTimer;
    CloseTimer: TTimer;
    RzBmpButtonMin: TRzBmpButton;
    TreeView: TTreeView;
    RzBmpButtonStart: TRzBmpButton;
    RzBmpButtonExitGame: TRzBmpButton;
    RzBmpButtonUpgrade: TRzBmpButton;
    Image: TRzFormShape;
    LabelStatus: TLabel;
    TimerReakSkin: TTimer;
    ComboBox: TComboBox;
    procedure TimerTimer(Sender: TObject);
    procedure ClientSocketConnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientSocketConnecting(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientSocketDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientSocketError(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure ClientSocketRead(Sender: TObject; Socket: TCustomWinSocket);
    procedure FormCreate(Sender: TObject);
    procedure RzBmpButtonCloseClick(Sender: TObject);
    procedure RzBmpButtonHomePageClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure RzBmpButtonFullScreenStartClick(Sender: TObject);
    procedure RzBmpButtonEditGameListClick(Sender: TObject);
    procedure TimerStartTimer(Sender: TObject);
    procedure RzBmpButtonNewAccountClick(Sender: TObject);
    procedure RzBmpButtonGetBakPassWordClick(Sender: TObject);
    procedure RzBmpButtonChgPassWordClick(Sender: TObject);
    procedure RzBmpButtonAutoLoginClick(Sender: TObject);
    procedure CloseTimerTimer(Sender: TObject);
    procedure ImageMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure RzBmpButtonMinClick(Sender: TObject);
    procedure TreeViewClick(Sender: TObject);
    procedure TimerReakSkinTimer(Sender: TObject);
    procedure RzBmpButtonUpgradeClick(Sender: TObject);
  private
    { Private declarations }
    procedure CreateUlr(sCreateUlrName: string);
    procedure DecodeMessagePacket(datablock: string);
    procedure ChgButtonStatus(btStatus: Byte);
    procedure ReleaseClient(sDirectory: string; GameZone: TGameZone);
//    function RunApp(AppName: string; I: Integer): Integer;
    procedure OnProgramException(Sender: TObject; E: Exception);
    function GetProcesses: Boolean;
    function GetModules(ProcessID: DWORD): Boolean;
    procedure ReadSkin;
    function SearchMirClient(Path: string): Boolean;
 
    procedure LoadUserConfig;
    procedure SaveUserConfig;
  public
    { Public declarations }
    procedure SendGetRandomCode;
    procedure SendUpdateAccount(ue: TUserEntry; ua: TUserEntryAdd; nRandomCode: Integer);
    procedure SendGetBackPassword(sAccount, sQuest1, sAnswer1,
      sQuest2, sAnswer2, sBirthDay: string);
    procedure SendChgPw(sAccount, sPasswd, sNewPasswd: string);
    procedure SendCSocket(sendstr: string);
    procedure LoadListToBox();
    procedure ProcessMessage(var Msg: TMsg; var Handled: Boolean);
    procedure MyMessage(var MsgData: TWmCopyData); message WM_COPYDATA;
  end;
 
var
  frmMain: TfrmMain;
  MirClient: TMemoryStream;
  WebBrowser: TWebBrowser;
function CheckLegendPath(Path: string): Boolean;
function CheckMirPath(Path: string): Boolean;
function CheckFullPath(Path: string): Boolean;
procedure LoopFiles(Path, Mask: string; SubDir: TStrings);
function GetDrives: string;
function RunApp(AppName: string): Integer;
function SearchPath: Boolean;
implementation
uses EncryptUnit, HUtil32, LNewAccount, LChgPassword, LGetBackPassword {, SecrchInfoMain},
  LEditGame, LUpgrade, { CMain, NPCDialog, NPCMain,} CheckPrevious, ZLibEx;
const
  R_MyRootKey = HKEY_LOCAL_MACHINE; //注册表根键
  R_MySubKey = '\SOFTWARE\cqfir\Legend of mir'; //注册表子键
  R_SndaSubKey = '\SOFTWARE\snda\Legend of mir';
  R_Key = 'Path';
{$R *.dfm}
 
procedure TSearchThread.Execute;
var
  DriverList: string;
  I, Len: Integer;
begin
  DriverList := GetDrives; //得到可写的磁盘列表 //遍历每个磁盘驱动器
  Len := Length(DriverList);
  for I := 1 to Len do begin
    g_SearchList.Add(DriverList[I] + ':\');
  end;
  while (not Terminated) and (not SearchPath) and (not g_boClose) do begin
 
  end;
end;
 
constructor TSearchThread.Create(CreateSuspended: Boolean);
begin
  inherited;
 
end;
 
destructor TSearchThread.Destroy;
begin
  inherited;
end;
 
function ReadRegKey(const iMode: Integer; const sPath,
  sKeyName: string; var sResult: string): Boolean;
var
  rRegObject: TRegistry;
begin
  rRegObject := TRegistry.Create;
  Result := False;
  try
    with rRegObject do begin
      RootKey := R_MyRootKey;
      if OpenKey(sPath, True) then begin
        case iMode of
          1: sResult := Trim(ReadString(sKeyName));
          2: sResult := IntToStr(ReadInteger(sKeyName));
          //3: sResult := ReadBinaryData(sKeyName, Buffer, BufSize);
        end;
        if sResult = '' then Result := False else Result := True;
      end
      else
        Result := False;
      CloseKey;
    end;
  finally
    rRegObject.Free;
  end;
end;
//_____________________________________________________________________//
 
function WriteRegKey(const iMode: Integer; const sPath, sKeyName,
  sKeyValue: string): Boolean;
var
  rRegObject: TRegistry;
  bData: Byte;
begin
  rRegObject := TRegistry.Create;
  try
    with rRegObject do begin
      RootKey := R_MyRootKey;
      if OpenKey(sPath, True) then begin
        case iMode of
          1: WriteString(sKeyName, sKeyValue);
          2: WriteInteger(sKeyName, StrToInt(sKeyValue));
          3: WriteBinaryData(sKeyName, bData, 1);
        end;
        Result := True;
      end
      else
        Result := False;
      CloseKey;
    end;
  finally
    rRegObject.Free;
  end;
end;
//_____________________________________________________________________//
 
function SelectDirCB(Wnd: Hwnd; uMsg: UINT; LPARAM, lpData: LPARAM): Integer stdcall;
begin
  if (uMsg = BFFM_INITIALIZED) and (lpData <> 0) then
    SendMessage(Wnd, BFFM_SETSELECTION, Integer(True), lpData);
  Result := 0;
end;
 
function SelectDirectory(const Caption: string; const Root: WideString;
  var Directory: string; Owner: THandle): Boolean;
var
  WindowList: Pointer;
  BrowseInfo: TBrowseInfo;
  Buffer: PChar;
  RootItemIDList, ItemIDList: PItemIDList;
  ShellMalloc: IMalloc;
  IDesktopFolder: IShellFolder;
  Eaten, Flags: LongWord;
begin
  Result := False;
  if not DirectoryExists(Directory) then
    Directory := '';
  FillChar(BrowseInfo, SizeOf(BrowseInfo), 0);
  if (ShGetMalloc(ShellMalloc) = S_OK) and (ShellMalloc <> nil) then begin
    Buffer := ShellMalloc.Alloc(MAX_PATH);
    try
      RootItemIDList := nil;
      if Root <> '' then begin
        SHGetDesktopFolder(IDesktopFolder);
        IDesktopFolder.ParseDisplayName(Application.Handle, nil,
          POleStr(Root), Eaten, RootItemIDList, Flags);
      end;
      with BrowseInfo do begin
        hwndOwner := Owner;
        pidlRoot := RootItemIDList;
        pszDisplayName := Buffer;
        lpszTitle := PChar(Caption);
        ulFlags := BIF_RETURNONLYFSDIRS;
        if Directory <> '' then begin
          lpfn := SelectDirCB;
          LPARAM := Integer(PChar(Directory));
        end;
      end;
      WindowList := DisableTaskWindows(0);
      try
        ItemIDList := ShBrowseForFolder(BrowseInfo);
      finally
        EnableTaskWindows(WindowList);
      end;
      Result := ItemIDList <> nil;
      if Result then begin
        ShGetPathFromIDList(ItemIDList, Buffer);
        ShellMalloc.Free(ItemIDList);
        Directory := Buffer;
      end;
    finally
      ShellMalloc.Free(Buffer);
    end;
  end;
end;
//_____________________________________________________________________//
 
function AddString(S: string): string;
begin
  Result := S;
  if S[Length(S)] <> '\' then Result := S + '\';
end;
 
//获取当前的硬盘所有的盘符
{
Lbl_DriveType:Tlabel;
  DriveType:WORD; //定义驱动器类型变量
  DriveType:=GetDriveType(RootPathName); //获得RootPathName所对应的磁盘驱动器信息
  case DriveType of
  DRIVE_REMOVABLE:Lbl_DriveType.Caption:= '软盘驱动器';
  DRIVE_FIXED : Lbl_DriveType.Caption:= '硬盘驱动器';
  DRIVE_REMOTE: Lbl_DriveType.Caption:= '网络驱动器';
  DRIVE_CDROM: Lbl_DriveType.Caption:= '光盘驱动器';
  DRIVE_RAMDISK: Lbl_DriveType.Caption:= '内存虚拟盘';
  end; //将该磁盘信息显示在Lbl_DriveType中
}
 
function GetDrives: string;
var
  DiskType: Word;
  D: Char;
  Str: string;
  I: Integer;
begin
  for I := 0 to 25 do //遍历26个字母
  begin
    D := Chr(I + 65);
    Str := D + ':';
    DiskType := GetDriveType(PChar(Str));
    //得到本地磁盘和网络盘
    if (DiskType = DRIVE_FIXED) {or (DiskType = DRIVE_REMOTE)} then
      Result := Result + D;
  end;
end;
 
{ 遍历目录 }
{
procedure LoopFiles(Path, Mask: string);
var
  I, Count: Integer;
  Fn, Ext: string;
  SubDir: TStrings;
  SearchRec: TSearchRec;
  Msg: TMsg;
  function IsValidDir(SearchRec: TSearchRec): Integer;
  begin
    if (SearchRec.Attr <> 16) and (SearchRec.Name <> '.') and
      (SearchRec.Name <> '..') then
      Result := 0 //不是目录
    else if (SearchRec.Attr = 16) and (SearchRec.Name <> '.') and
      (SearchRec.Name <> '..') then
      Result := 1 //不是根目录
    else Result := 2; //是根目录
  end;
begin
  SubDir := TStringList.Create;
  if (FindFirst(Path + '*.*', faDirectory, SearchRec) = 0) then
  begin
    repeat
      if g_boClose then break;
      Application.ProcessMessages;
      if IsValidDir(SearchRec) = 1 then begin
        if not CheckMirPath(Path + SearchRec.Name + '\') then begin
          SubDir.Add(SearchRec.Name);
          FrmMain.LabelStatus.Caption := Path + SearchRec.Name;
        end else begin
          g_sMirPath := Path + SearchRec.Name + '\';
          WriteRegKey(1, R_MySubKey, R_Key, g_sMirPath);
          Break;
        end;
      end;
      Sleep(1);
    until (FindNext(SearchRec) <> 0);
  end;
  FindClose(SearchRec);
  if not CheckMirPath(g_sMirPath) then begin
    Count := SubDir.Count - 1;
    for I := 0 to Count do begin
      if g_boClose then break;
      LoopFiles(Path + SubDir.Strings[I] + '\', Mask);
    end;
  end;
  FreeAndNil(SubDir);
end;
}
 
//缩短显示不下的长路径名
 
function FormatPath(APath: string; Width: Integer): string;
var
  SLen: Integer;
  i, j: Integer;
  TString: string;
begin
  SLen := Length(APath);
  if (SLen <= Width) or (Width <= 6) then
  begin
    Result := APath;
    Exit
  end
  else
  begin
    i := SLen;
    TString := APath;
    for j := 1 to 2 do
    begin
      while (TString[i] <> '\') and (SLen - i < Width - 8) do
        i := i - 1;
      i := i - 1;
    end;
    for j := SLen - i - 1 downto 0 do
      TString[Width - j] := TString[SLen - j];
    for j := SLen - i to SLen - i + 2 do
      TString[Width - j] := '.';
    Delete(TString, Width + 1, 255);
    Result := TString;
  end;
end;
 
procedure LoopFiles(Path, Mask: string; SubDir: TStrings);
var
  I, Count: Integer;
  Fn, Ext, FullPath: string;
  SearchRec: TSearchRec;
  Msg: TMsg;
  function IsValidDir(SearchRec: TSearchRec): Integer;
  begin
    if (SearchRec.Attr <> 16) and (SearchRec.Name <> '.') and
      (SearchRec.Name <> '..') then
      Result := 0 //不是目录
    else if (SearchRec.Attr = 16) and (SearchRec.Name <> '.') and
      (SearchRec.Name <> '..') then
      Result := 1 //不是根目录
    else Result := 2; //是根目录
  end;
begin
  if (FindFirst(Path + '*.*', faDirectory, SearchRec) = 0) then begin
    repeat
      if g_boClose then break;
      Application.ProcessMessages;
      if IsValidDir(SearchRec) = 1 then begin
        FullPath := Path + SearchRec.Name + '\';
        if not CheckFullPath(FullPath) then begin
          //if CheckLegendPath(FullPath) then
          if CheckLegendPath(FullPath) then
            g_LegendPathList.Add(FullPath);
 
          SubDir.Add(FullPath);
 
          FrmMain.LabelStatus.Caption := FormatPath(FullPath, 40);
          {if Length(FullPath) > 30 then begin
            FrmMain.LabelStatus.Caption := ExtractShortPathName(FullPath);
          end else begin
            FrmMain.LabelStatus.Caption := FullPath;
          end; }
        end else begin
          g_sMirPath := FullPath;
          WriteRegKey(1, R_MySubKey, R_Key, g_sMirPath);
          Break;
        end;
      end;
      Sleep(1);
 
    until (FindNext(SearchRec) <> 0);
  end;
  FindClose(SearchRec);
end;
 
function CheckLegendPath(Path: string): Boolean;
begin
  Result := (DirectoryExists(Path + 'Data')) and
    (DirectoryExists(Path + 'Map')) and
    (DirectoryExists(Path + 'Wav'));
end;
 
function CheckFullPath(Path: string): Boolean;
begin
  Result := (DirectoryExists(Path + 'Data')) and
    (DirectoryExists(Path + 'Map')) and
    (DirectoryExists(Path + 'Wav')) and
    (not FileExists(Path + 'Data\ChrSel_16.wil')) and
    (not FileExists(Path + 'Data\Prguse_16.wil')) and
    (not FileExists(Path + 'Data\Prguse2_16.wil')) and
    (not FileExists(Path + 'Data\Prguse3_16.wil'));
end;
 
function CheckMirPath(Path: string): Boolean;
var
  sKeyValue: string;
begin
  if CheckLegendPath(Path) then begin
    g_sMirPath := Path;
    Result := True;
  end else begin
    if ReadRegKey(1, R_MySubKey, R_Key, sKeyValue) then begin
      if CheckLegendPath(sKeyValue) then begin
        g_sMirPath := sKeyValue;
        Result := True;
        Exit;
      end;
    end;
 
    if ReadRegKey(1, R_SndaSubKey, R_Key, sKeyValue) then begin
      if CheckLegendPath(sKeyValue) then begin
        g_sMirPath := sKeyValue;
        WriteRegKey(1, R_MySubKey, R_Key, g_sMirPath);
        Result := True;
        Exit;
      end;
    end;
    Result := False;
  end;
end;
 
function SearchPath: Boolean;
var
  I: Integer;
  SubDir: TStrings;
begin
  Result := False;
  SubDir := TStringList.Create;
  for I := 0 to g_SearchList.Count - 1 do begin
    LoopFiles(g_SearchList[I], '*.*', SubDir);
    if g_boClose or CheckFullPath(g_sMirPath) then begin
      break;
    end;
  end;
  if not CheckFullPath(g_sMirPath) then begin
    g_SearchList.Clear;
    g_SearchList.AddStrings(SubDir);
  end else Result := True;
  FreeAndNil(SubDir);
end;
 
function TFrmMain.SearchMirClient(Path: string): Boolean;
var
  DriverList: string;
  sKeyValue: string;
  I, Len: Integer;
begin
  Result := False;
  if not CheckLegendPath(Path) then begin
    if ReadRegKey(1, R_MySubKey, R_Key, sKeyValue) then begin
      if CheckLegendPath(sKeyValue) then begin
        g_sMirPath := sKeyValue;
        Result := True;
        Exit;
      end;
    end;
 
    if ReadRegKey(1, R_SndaSubKey, R_Key, sKeyValue) then begin
      if CheckLegendPath(sKeyValue) then begin
        g_sMirPath := sKeyValue;
        WriteRegKey(1, R_MySubKey, R_Key, g_sMirPath);
        Result := True;
        Exit;
      end;
    end;
 
    DriverList := GetDrives; //得到可写的磁盘列表 //遍历每个磁盘驱动器
    Len := Length(DriverList);
    for I := 1 to Len do begin
      g_SearchList.Add(DriverList[I] + ':\');
    end;
 
    while (not SearchPath) and (not g_boClose) do begin
    end;
 
    if (not CheckMirPath(g_sMirPath)) and (g_LegendPathList.Count > 0) then begin
      g_sMirPath := g_LegendPathList.Strings[0];
    end;
 
    Result := CheckLegendPath(g_sMirPath);
 
    {DriverList := GetDrives; //得到可写的磁盘列表
    Len := Length(DriverList);
    for I := Len downto 1 do begin //遍历每个磁盘驱动器
      try
        LoopFiles(DriverList[I] + ':\', '*.*');
        if CheckMirPath(g_sMirPath) then begin
          Result := True;
          Break;
        end;
      except
      end;
      if g_boClose then break;
    end;
    }
  end else begin
    g_sMirPath := Path;
    if not ReadRegKey(1, R_MySubKey, R_Key, sKeyValue) then begin
      WriteRegKey(1, R_MySubKey, R_Key, g_sMirPath);
    end else begin
      if not CheckLegendPath(sKeyValue) then begin
        WriteRegKey(1, R_MySubKey, R_Key, g_sMirPath);
      end;
    end;
    Result := True;
  end;
end;
 
 
procedure TfrmMain.ProcessMessage(var Msg: TMsg; var Handled: Boolean);
begin
  if Msg.message = WM_SENDPROCMSG then begin
    //    ShowMessage('asfd');
    Handled := True;
  end;
end;
 
procedure TfrmMain.MyMessage(var MsgData: TWmCopyData);
var
  I, nHandle: Integer;
  sData: string;
  wIdent, wRecog: Word;
begin
  if not g_boClose then begin
    wIdent := HiWord(MsgData.From);
    wRecog := LoWord(MsgData.From);
    sData := StrPas(MsgData.CopyDataStruct^.lpData);
    case wIdent of
      CM_HANDLE: begin
          nHandle := Str_ToInt(sData, 0);
          for I := 0 to g_ClientHandleList.Count - 1 do begin
            if nHandle = Integer(g_ClientHandleList.Items[I]) then begin
              Exit;
            end;
          end;
          g_ClientHandleList.Add(Pointer(nHandle));
        //Showmessage('CM_HANDLE:'+IntToStr(nHandle));
        end;
      CM_QUIT: begin
          nHandle := Str_ToInt(sData, 0);
        //Showmessage('CM_QUIT:'+IntToStr(nHandle));
          for I := 0 to g_ClientHandleList.Count - 1 do begin
            if nHandle = Integer(g_ClientHandleList.Items[I]) then begin
              g_ClientHandleList.Delete(I);
              Break;
            end;
          end;
          if IsIconic(Application.Handle) then
            ShowWindow(Application.Handle, SW_RESTORE);
          SetForegroundWindow(Application.Handle);
        end;
    end;
  end;
end;
 
procedure TfrmMain.CreateUlr(sCreateUlrName: string); //创建快捷方式
var
  ShLink: IShellLink;
  PFile: IPersistFile;
  FileName: string;
  WFileName: WideString;
  Reg: TRegIniFile;
  AnObj: IUnknown;
  UrlName: string;
begin
  UrlName := Trim(sCreateUlrName);
  if UrlName <> '' then begin
    AnObj := CreateComObject(CLSID_ShellLink);
    ShLink := AnObj as IShellLink;
    PFile := AnObj as IPersistFile;
    FileName := ParamStr(0);
    ShLink.SetPath(PChar(FileName));
    ShLink.SetWorkingDirectory(PChar(ExtractFilePath(FileName)));
    Reg := TRegIniFile.Create('Software\MicroSoft\Windows\CurrentVersion\Explorer');
    WFileName := Reg.ReadString('Shell Folders', 'Desktop', '') + '\' + UrlName + '.lnk';
    PFile.Save(PWChar(WFileName), True);
  end;
end;
 
procedure TfrmMain.SendCSocket(sendstr: string);
var
  sSendText: string;
begin
  if ClientSocket.Socket.Connected then begin  //是否被连接
    sSendText := '#' + IntToStr(btCode) + sendstr + '!'; //btcode =1  #+btcode+sendstr+!
    ClientSocket.Socket.SendText('#' + IntToStr(btCode) + sendstr + '!');
    Inc(btCode);//+1
    if btCode >= 10 then btCode := 1;//>=10 则 赋值1
  end;
end;
 
procedure TfrmMain.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 TfrmMain.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));
  //消息代码 + 编码字符串 tab分割参数
end;
 
procedure TfrmMain.SendGetRandomCode;
var
  Msg: TDefaultMessage;
begin
  Msg := MakeDefaultMsg(CM_RANDOMCODE, 0, 0, 0, 0); //make 一个默认消息
  SendCSocket(EncodeMessage(Msg)); //加密消息 发送消息
end;
 
procedure TfrmMain.SendUpdateAccount(ue: TUserEntry; ua: TUserEntryAdd; nRandomCode: Integer); //发送新建账号
var
  Msg: TDefaultMessage;  //发送更新用户 新建用户
begin
  sMakeNewAccount := ue.sAccount;//全局变量
  Msg := MakeDefaultMsg(CM_ADDNEWUSER, nRandomCode, 0, 0, 0);//发送消息
  SendCSocket(EncodeMessage(Msg) + EncodeBuffer(@ue, SizeOf(TUserEntry)) + EncodeBuffer(@ua, SizeOf(TUserEntryAdd))); //329
  //发送 消息码+编码缓冲区ue+编码缓冲区ua
end;
 
procedure TfrmMain.TimerTimer(Sender: TObject);
var
  Str, data: string;
  len, I, n, mcnt: Integer;
begin
  if boBusy then Exit;
  boBusy := True;
  try
    sBufferStr := sBufferStr + sSocStr;
    sSocStr := '';
    if sBufferStr <> '' then begin
      mcnt := 0;
      while Length(sBufferStr) >= 2 do begin
        if Pos('!', sBufferStr) <= 0 then Break;
        sBufferStr := ArrestStringEx(sBufferStr, '#', '!', data);
        if data <> '' then begin
          DecodeMessagePacket(data);
        end else
          if Pos('!', sBufferStr) = 0 then
          Break;
      end;
    end;
    {if frmNewAccount.Visible then begin
      frmNewAccount.LabelRandomCode.Caption := g_sRandomCode;
    end;}
  finally
    boBusy := False;
  end;
end;
 
procedure TfrmMain.TreeViewClick(Sender: TObject);
var
  TreeNode: TTreeNode;
  GameZone: TGameZone;
  sServerAddr: string;
  sServerPort: string;
begin
  g_SelGameZone := nil;
  TreeNode := TreeView.Selected;
  if (TreeNode = nil) or (TreeNode.Parent = nil) then begin
    //Showmessage('TreeNode.Parent = nil');
    Exit;
  end;
  g_SelGameZone := TGameZone(TreeNode.Data);
  try
    if not g_SelGameZone.Connected then begin
      ClientSocket.Active := False;
      ClientSocket.Host := '';
      ClientSocket.Address := '';
 
      if g_SelGameZone.Encrypt then begin
        sServerAddr := DeCodeString(g_SelGameZone.GameHost);
        sServerPort := DeCodeString(g_SelGameZone.GameIPPort);
      end else begin
        sServerAddr := g_SelGameZone.GameHost;
        sServerPort := g_SelGameZone.GameIPPort;
      end;
 
      if IsIpAddr(sServerAddr) then begin
        ClientSocket.Address := sServerAddr;
      end else begin
        ClientSocket.Host := sServerAddr;
      end;
      ClientSocket.Port := Str_ToInt(sServerPort, 7000);
 
      ClientSocket.Active := True;
    end else begin
      g_boClientSocketConnect := True;
      LabelStatus.Font.Color := g_GameLoginConfig.LabelConnectColor;
      LabelStatus.Caption := sClientConnect;
      RzBmpButtonFullScreenStart.Enabled := True;
      RzBmpButtonStart.Enabled := True;
      RzBmpButtonAutoLogin.Enabled := True;
      RzBmpButtonNewAccount.Enabled := True;
      RzBmpButtonGetBakPassWord.Enabled := True;
      RzBmpButtonChgPassWord.Enabled := True;
    end;
    //WebBrowser.Height := g_nWebHeiht;
    //WebBrowser.Width := g_WebBrowser.Width;
    WebBrowser.Navigate(g_SelGameZone.NoticeUrl);
    //WebBrowser.Width := g_WebBrowser.Width;
    {Showmessage(IntToStr(WebBrowser.Width));
    Showmessage(IntToStr(WebBrowser.Height));}
  except
 
  end;
end;
 

  • 3
    点赞
  • 2
    收藏
    觉得还不错? 一键收藏
  • 打赏
    打赏
  • 2
    评论
评论 2
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包

打赏作者

侠客软件开发

你的鼓励将是我创作的最大动力

¥1 ¥2 ¥4 ¥6 ¥10 ¥20
扫码支付:¥1
获取中
扫码支付

您的余额不足,请更换扫码支付或充值

打赏作者

实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值