main.pas

传奇的登陆器!也是在网上搜索的!不知道好不好用

unit Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, jpeg, ExtCtrls, RzForms, Buttons, RzButton, shellapi, RzBmpBtn,
  StdCtrls, RzCmboBx, IniFiles, RzLabel, winsock, Sockets, OleCtrls, SHDocVw,
  ComCtrls, ShlObj, ComObj, ActiveX, Registry, RzRadChk, Mask, RzEdit, JSocket,
  RzLstBox, Grobal2, Share, IdBaseComponent, IdComponent, IdTCPConnection,
  IdTCPClient, IdHTTP;
////////////////////////////////检测程序是否已经运行过的数据定义////////////////
const
  MI_QUERYWINDOWHANDLE = 1;
  MI_RESPONDWINDOWNHANDLE = 2;
  MI_ERROR_NONE = 0;
  MI_ERROR_FAILSUBCLASS = 1;
  MI_ERROR_CREATINGMUTEX = 2;
  ////////////////////////////////////////////////////////////////////////////////
type
  TMainForm = class(TForm)
    WebBrowser1: TWebBrowser;
    Image1: TImage;
    ClientSocket: TClientSocket;
    MsgLabel: TLabel;
    ButtonNewAccount: TRzButton;
    StartMirButton: TRzButton;
    ListBoxServerList: TRzListBox;
    ClientTimer: TTimer;
    RzFormShape1: TRzFormShape;
    ButtonMin: TRzToolButton;
    ButtonClose: TRzToolButton;
    ButtonGetBackPassword: TRzButton;
    ButtonChgPassword: TRzButton;
    ButtonLocalStart: TRzButton;
    ButtonHomePage: TRzButton;
    ButtonAddGame: TRzButton;
    TimerGetGameList: TTimer;
    IdHTTP: TIdHTTP;
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure ButtonMinClick(Sender: TObject);
    procedure ButtonCloseClick(Sender: TObject);
    procedure CreateUlr;
    procedure ButtonNewAccountClick(Sender: TObject);
    procedure ClientTimerTimer(Sender: TObject);
    procedure ButtonChgPasswordClick(Sender: TObject);
    procedure ButtonGetBackPasswordClick(Sender: TObject);
    procedure ClientSocketRead(Sender: TObject; Socket: TCustomWinSocket);

    procedure SendUpdateAccount(ue: TUserEntry; ua: TUserEntryAdd);
    procedure SendGetBackPassword(sAccount, sQuest1, sAnswer1,
      sQuest2, sAnswer2, sBirthDay: string);
    procedure SendChgPw(sAccount, sPasswd, sNewPasswd: string);
    procedure DecodeMessagePacket(datablock: string);
    procedure SendCSocket(sendstr: string);
    procedure ClientSocketError(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure ClientSocketConnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientSocketDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientSocketConnecting(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ButtonLocalStartClick(Sender: TObject);
    procedure ListBoxServerListClick(Sender: TObject);
    procedure ListBoxServerListDblClick(Sender: TObject);
    procedure StartMirButtonClick(Sender: TObject);
    procedure ButtonAddGameClick(Sender: TObject);
    procedure TimerGetGameListTimer(Sender: TObject);
    procedure ListBoxServerListDrawItem(Control: TWinControl;
      Index: Integer; Rect: TRect; State: TOwnerDrawState);
    procedure IdHTTPWork(Sender: TObject; AWorkMode: TWorkMode;
      const AWorkCount: Integer);
    procedure ButtonHomePageClick(Sender: TObject);
  private
    HotKeyId: Integer;
    dwClickTick: LongWord;
    procedure HotKeyDown(var Msg: Tmessage); message WM_HOTKEY;
    function GetDownFileName1(DownAddr: string): string;
    function WriteMirInfo(MirPath: string; GameZone: pTGameZone): Boolean;
    procedure LoadGameList();
    procedure UnLoadGameList();
  public
    procedure LoadLocalGameList;
    procedure UnLoadLocalGameList;
    procedure LoadGameListToBox;
    procedure GetServerInfo(sLineText: string; var g_GameZone: pTGameZone);
  end;
var
  MainForm: TMainForm;
  MakeNewAccount: string;
  code: byte = 1;
  SocStr, BufferStr: string;
  Myself: TObject = nil;
  Myinifile: TInIFile;
  ////////////////////////////////检测程序是否已经运行过的数据定义///////////
  MessageId: Integer;
  WProc: TFNWndProc;
  MutHandle: THandle;
  MIERROR: Integer;
implementation
uses
  Common, EDecode, HUtil32,
  LNewAccount, LChgPassword, LGetBackPassword, SecrchInfoMain, CMain, LEditGame;
var
  busy: Boolean = FALSE;
const
  UniqueAppStr = 'http://www.51ggame.com';
{$R *.dfm}
{$R 资源文件\Mir\Mir.res}
{$R 资源文件\mClient\mClient.res}
procedure TMainForm.HotKeyDown(var Msg: Tmessage);
begin
  if (Msg.LparamLo = MOD_CONTROL) and (Msg.LParamHi = ord('j')) then begin
    // 什么也不做
    //showmessage('');
  end;
end;

procedure TMainForm.CreateUlr; //创建快捷方式
var
  ShLink: IShellLink;
  PFile: IPersistFile;
  FileName: string;
  WFileName: WideString;
  Reg: TRegIniFile;
  AnObj: IUnknown;
  UrlName: string;
begin
  UrlName := Trim(CreateUlrName);
  if UrlName = '' then Exit;
  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;

function TMainForm.WriteMirInfo(MirPath: string; GameZone: pTGameZone): Boolean;
var
  MirRes, mClientRes, nClientRes: TResourceStream;
  sIpAddr: string;
begin
  if CheckIsIpAddr(GameZone.sGameIPaddr) then begin
    sIpAddr := GameZone.sGameIPaddr;
  end else begin
    sIpAddr := CheckHostToIP(GameZone.sGameIPaddr);
  end;
  FileSetAttr(MirPath + mClientName, 0);
  FileSetAttr(MirPath + sProgamFile, 0);
  MirRes := TResourceStream.Create(HInstance, 'exeClient', PChar('Dat'));
  try
    mClientRes := TResourceStream.Create(HInstance, 'mClient', PChar('dll'));
    mClientRes.SaveToFile(MirPath + mClientName); //将资源保存为文件，即还原文件
    MirRes.SaveToFile(MirPath + sProgamFile); //将资源保存为文件，即还原文件
    MirRes.Free;
    mClientRes.Free;
  except
  end;
  Myinifile := TInIFile.Create(MirPath + 'mir.ini');
  if Myinifile <> nil then begin
    Myinifile.WriteString('Setup', 'FontName', '宋体');
    Myinifile.WriteString('Setup', 'Serveraddr', sIpAddr); //IP地址
    Myinifile.WriteString('Setup', 'Param1', sIpAddr); //IP地址
    Myinifile.WriteInteger('Setup', 'Param2', GameZone.nGameIPPort); //端口
    Myinifile.WriteString('Setup', 'Param3', '');
    Myinifile.WriteString('Setup', 'Param4', '');
    Myinifile.WriteString('Setup', 'Param5', '');
    Myinifile.Free;
    Result := true;
  end;
  if Result then begin
    Myinifile := TInIFile.Create(MirPath + 'ftp.ini');
    if Myinifile <> nil then begin
      Myinifile.WriteInteger('Server', 'Servercount', 1);
      Myinifile.WriteString('Server', 'server1caption', GameZone.sServerName); //开门名称
      Myinifile.WriteString('Server', 'server1name', GameZone.sServerName); //服务器名称
      Myinifile.Free;
      FileSetAttr(MirPath + mClientName, 2);
      FileSetAttr(MirPath + sProgamFile, 2);
      Result := true;
    end else Result := FALSE;
  end else Result := FALSE;
end;
//==============================================================================
function TMainForm.GetDownFileName1(DownAddr: string): string;
begin
  while Pos('\', DownAddr) <> 0 do {//下载文件名称}  begin
    Application.ProcessMessages; //响应一下消息
    DownAddr := Copy(DownAddr, Pos('\', DownAddr) + 1, Length(DownAddr));
  end;
  Result := DownAddr;
end;

function RunApp(AppName: string; I: Integer): Integer; //运行程序
var
  Sti: TStartupInfo;
  ProcessInfo: TProcessInformation;
begin
  FillMemory(@Sti, SizeOf(Sti), 0);
  Sti.wShowWindow := I;
  Sti.dwFlags := STARTF_USEFILLATTRIBUTE;
  Sti.dwFillAttribute := FOREGROUND_INTENSITY or BACKGROUND_BLUE;
  if CreateProcess(PChar(AppName), nil,
    nil, nil, FALSE,
    0, nil, PChar(ExtractFilePath(AppName)),
    Sti, ProcessInfo) then begin
    Result := ProcessInfo.dwProcessId;
  end
  else
    Result := -1;
end;
procedure TMainForm.StartMirButtonClick(Sender: TObject);
var
  sClient, sCopyFile: string;
  SecrchFrm: TSecrchFrm;
begin
  if not m_boClientSocketConnect then begin
    Application.MessageBox('请选择你要登陆的游戏区！！！', '提示信息', MB_OK + MB_ICONINFORMATION);
    Exit;
  end;
  if (not DirectoryExists(ExtractFilePath(ParamStr(0)) + 'Data')) or
    (not DirectoryExists(ExtractFilePath(ParamStr(0)) + 'Map')) or
    (not DirectoryExists(ExtractFilePath(ParamStr(0)) + 'Wav')) then begin
    //if Application.MessageBox('当前目录中没有发现传奇客户端！请点击确定自动搜索客户端否则点取消！！！',
      //'提示信息',
     // MB_YESNO + MB_ICONQUESTION) = IDYES then begin
    SecrchFrm := TSecrchFrm.Create(Owner);
    SecrchFrm.ShowModal; //开始搜索
    SecrchFrm.Free;
    if not m_BoSearchFinish then begin
      Application.MessageBox('没有找传奇客户端请手工查找！！！', '提示信息', MB_OK + MB_ICONINFORMATION);
      Exit;
    end else begin
      sCopyFile := GetDownFileName1(Application.ExeName);
      CopyFile(PChar(sCopyFile), PChar(m_sMirClient + sCopyFile), FALSE); //复制自己
      RunApp(m_sMirClient + sCopyFile, 1); //启动
      Application.Terminate;
      Exit;
    end;
    //end else Exit;
  end else begin
    sClient := ExtractFilePath(ParamStr(0));
  end;
  if m_SelGameZone <> nil then begin
    if not WriteMirInfo(sClient, m_SelGameZone) then begin //写入游戏区
      Application.MessageBox('文件创建失败无法启动客户端！！！', '提示信息', MB_OK + MB_ICONINFORMATION);
      Exit;
    end;
    Application.Minimize; //最小化窗口
    RunApp(sClient + sProgamFile, 1); //启动客户端
  end;
end;
//==============================================================================
procedure TMainForm.GetServerInfo(sLineText: string; var g_GameZone: pTGameZone);
var
  sShowName, sServerName, sServeraddr, sServerPort, sNoticeUrl: string;
begin
  sLineText := GetValidStr3(sLineText, sShowName, [#9, '|']);
  sLineText := GetValidStr3(sLineText, sServerName, [#9, '|']);
  sLineText := GetValidStr3(sLineText, sServeraddr, [#9, '|']);
  sLineText := GetValidStr3(sLineText, sServerPort, [#9, '|']);
  sLineText := GetValidStr3(sLineText, sNoticeUrl, [#9, '|']);
  if (sShowName <> '') and (sServerName <> '') and
    (sServeraddr <> '') and (sServerPort <> '') and (sNoticeUrl <> '') then begin
    New(g_GameZone);
    g_GameZone.sShowName := sShowName;
    g_GameZone.sServerName := sServerName;
    g_GameZone.sGameIPaddr := sServeraddr;
    g_GameZone.nGameIPPort := Str_ToInt(sServerPort, 7000);
    g_GameZone.sNoticeUrl := sNoticeUrl;
  end;
end;

procedure TMainForm.LoadGameList;
var
  SectionsList: TStringlist;
  I: Integer;
  sLineText, sShowName, sServerName, sServeraddr, sServerPort, sNoticeUrl: string;
  GameZone: pTGameZone;
begin
  if m_GameList <> nil then begin
    UnLoadGameList();
  end;
  m_GameList := TList.Create;
  if FileExists(ExtractFilePath(ParamStr(0)) + m_sGameListName) then begin
    SectionsList := TStringlist.Create;
    SectionsList.LoadFromFile(ExtractFilePath(ParamStr(0)) + m_sGameListName);
    for I := 0 to SectionsList.Count - 1 do begin
      sLineText := Trim(SectionsList.Strings[I]);
      if (sLineText <> '') and (sLineText[1] <> ';') then begin
        GetServerInfo(sLineText, GameZone);
        if GameZone <> nil then begin
          m_GameList.Add(GameZone);
        end;
      end;
    end;
    SectionsList.Free;
  end;
end;

procedure TMainForm.LoadLocalGameList;
var
  SectionsList: TStringlist;
  I: Integer;
  sLineText, sShowName, sServerName, sServeraddr, sServerPort, sNoticeUrl: string;
  GameZone: pTGameZone;
begin
  if m_LocalGameList <> nil then begin
    UnLoadLocalGameList;
  end;
  m_LocalGameList := TList.Create;
  if FileExists(ExtractFilePath(ParamStr(0)) + m_sLocalGameListName) then begin
    SectionsList := TStringlist.Create;
    SectionsList.LoadFromFile(ExtractFilePath(ParamStr(0)) + m_sLocalGameListName);
    for I := 0 to SectionsList.Count - 1 do begin
      sLineText := Trim(SectionsList.Strings[I]);
      if (sLineText[1] <> ';') and (sLineText <> '') then begin
        GetServerInfo(sLineText, GameZone);
        if GameZone <> nil then begin
          m_LocalGameList.Add(GameZone);
        end;
      end;
    end;
    SectionsList.Free;
  end;
end;

procedure TMainForm.UnLoadLocalGameList;
var
  I: Integer;
begin
  for I := 0 to m_LocalGameList.Count - 1 do begin
    Dispose(pTGameZone(m_LocalGameList.Items[I]));
  end;
  m_LocalGameList.Free;
  m_LocalGameList := nil;
end;

procedure TMainForm.UnLoadGameList();
var
  I: Integer;
begin
  for I := 0 to m_GameList.Count - 1 do begin
    Dispose(pTGameZone(m_GameList.Items[I]));
  end;
  m_GameList.Free;
  m_GameList := nil;
end;

procedure TMainForm.LoadGameListToBox;
var
  I: Integer;
  nItemIndex: Integer;
  GameZone: pTGameZone;
begin
  nItemIndex := ListBoxServerList.ItemIndex;
  ListBoxServerList.Items.Clear;
  for I := 0 to m_GameList.Count - 1 do begin
    GameZone := pTGameZone(m_GameList.Items[I]);
    ListBoxServerList.Items.AddObject(GameZone.sShowName, TObject(GameZone));
  end;
  for I := 0 to m_LocalGameList.Count - 1 do begin
    GameZone := pTGameZone(m_LocalGameList.Items[I]);
    ListBoxServerList.Items.AddObject(GameZone.sShowName, TObject(GameZone));
  end;
  if (ListBoxServerList.Items.Count > nItemIndex) and (nItemIndex >= 0) then
    ListBoxServerList.ItemIndex := nItemIndex;
end;

//==============================================================================
procedure TMainForm.FormCreate(Sender: TObject);
begin
  CreateUlr;
  dwClickTick := 0;
  //==============================================================================
  HotKeyId := GlobalAddAtom('HotKey') - $C000; //
  //RegisterHotKey(Handle, hotkeyid, Mod_Alt, VK_F4); //       // 注册 Ctrl + J
  RegisterHotKey(Handle, HotKeyId, MOD_CONTROL, ord('J')); //
  //==============================================================================
  TimerGetGameList.Enabled := true;
end;

procedure TMainForm.ListBoxServerListClick(Sender: TObject);
var
  GameZone: pTGameZone;
  nItemIndex: Integer;
begin
  if GetTickCount - dwClickTick > 500 then begin
    dwClickTick := GetTickCount;
    try
      nItemIndex := ListBoxServerList.ItemIndex;
      m_SelGameZone := pTGameZone(ListBoxServerList.Items.Objects[nItemIndex]);
    except
      m_SelGameZone := nil;
    end;
    if m_SelGameZone = nil then Exit;
    ClientSocket.Active := FALSE;
    ClientSocket.Host := '';