传奇很好玩,现在的年轻人对于这种游戏可能不喜欢。网上下载的登录器会自动转移目录,并且在桌面产生快捷方式,有的还会释放出其他程序。目前市面上的宏图和绿盟登录器都是将客户端和登录器集成在一起,这样做有好处也有弊端。所以准备自己弄一个登录器,把登录器和客户端独立开来,这样一个登录器可以启动无数款传奇游戏,只要配置上传奇游戏的资源包和服务器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;