unit1.pas

传奇假人登陆器 原代码 不完全 但是可以拿来研究

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, JSocket, StdCtrls, ExtCtrls, IdBaseComponent, IdComponent,
  IdTCPConnection, IdTCPClient, IdHTTP, EDcode, Grobal2, HUtil32, Share, WinInet,WinSvc,uEncrypt;

type
  TForm1 = class(TForm)
    ClientSocket1: TClientSocket;
    lbl1: TLabel;
    tmr1: TTimer;
    tmr2: TTimer;
    tmr3: TTimer;
    tmr4: TTimer;
    tmr5: TTimer;
    tmr6: TTimer;
    tmr7: TTimer;
    csocket1: TClientSocket;
    csocket2: TClientSocket;
    csocket3: TClientSocket;
    csocket4: TClientSocket;
    tmr8: TTimer;
    tmr9: TTimer;
    tmr10: TTimer;
    tmr11: TTimer;
    tmr12: TTimer;
    tmr13: TTimer;
    tmr14: TTimer;
    tmr15: TTimer;
    tmr16: TTimer;
    tmr17: TTimer;
    tmr18: TTimer;
    tmr19: TTimer;
    tmr20: TTimer;
    tmr21: TTimer;
    tmr22: TTimer;
    tmr23: TTimer;
    tmr24: TTimer;
    tmr25: TTimer;
    tmr26: TTimer;
    tmr27: TTimer;
    tmr28: TTimer;
    tmr29: TTimer;
    tmr30: TTimer;
    tmr31: TTimer;
    tmr32: TTimer;
    tmr33: TTimer;
    tmr34: TTimer;
    tmr35: TTimer;
    tmr36: TTimer;
    tmr37: TTimer;
    tmr38: TTimer;
    tmr39: TTimer;
    tmr40: TTimer;
    tmr41: TTimer;
    tmr42: TTimer;
    tmr43: TTimer;
    tmr44: TTimer;
    tmr45: TTimer;
    tmr46: TTimer;
    procedure ClientSocket1Connecting(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure AppLogout;
    procedure AppLogout1;
    procedure AppLogout2;
    procedure AppLogout3;
    procedure AppLogout4;
    procedure SendCSocket(sendstr: string);
    procedure SendCSocket1(sendstr1: string);
    procedure SendCSocket2(sendstr2: string);
    procedure SendCSocket3(sendstr3: string);
    procedure SendCSocket4(sendstr4: string);
    procedure ClientSocket1Error(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
    procedure SendSelectServer (svname: string);
    procedure SendSelectServer1 (svname: string);
    procedure SendSelectServer2 (svname: string);
    procedure SendSelectServer3 (svname: string);
    procedure SendSelectServer4 (svname: string);
    procedure SendLogin (uid, passwd: string);
    procedure SendLogin1 (uid, passwd: string);
    procedure SendLogin2 (uid, passwd: string);
    procedure SendLogin3 (uid, passwd: string);
    procedure SendLogin4 (uid, passwd: string);
    procedure Login;
    procedure DecodeMessagePacket (datablock: string);
    procedure DecodeMessagePacket1 (datablock: string);
    procedure DecodeMessagePacket2 (datablock: string);
    procedure DecodeMessagePacket3 (datablock: string);
    procedure DecodeMessagePacket4 (datablock: string);
    procedure tmr1Timer(Sender: TObject);
    procedure SendNewAccount (ue: TUserEntry; ua: TUserEntryAdd);
    procedure SendNewAccount1 (ue: TUserEntry; ua: TUserEntryAdd);
    procedure SendNewAccount2 (ue: TUserEntry; ua: TUserEntryAdd);
    procedure SendNewAccount3 (ue: TUserEntry; ua: TUserEntryAdd);
    procedure SendNewAccount4 (ue: TUserEntry; ua: TUserEntryAdd);
    procedure SendQueryChr;
    procedure SendQueryChr1;
    procedure SendQueryChr2;
    procedure SendQueryChr3;
    procedure SendQueryChr4;
    procedure SendNewChr (sdf: string);
    procedure SendNewChr1 (sdf: string);
    procedure SendNewChr2 (sdf: string);
    procedure SendNewChr3 (sdf: string);
    procedure SendNewChr4 (sdf: string);
    procedure ClientGetPasswordOK(Msg: TDefaultMessage;sBody: String);
    procedure ClientGetPasswordOK1(Msg: TDefaultMessage;sBody: String);
    procedure ClientGetPasswordOK2(Msg: TDefaultMessage;sBody: String);
    procedure ClientGetPasswordOK3(Msg: TDefaultMessage;sBody: String);
    procedure ClientGetPasswordOK4(Msg: TDefaultMessage;sBody: String);
    procedure ClientGetPasswdSuccess (body: string);
    procedure ClientGetPasswdSuccess1 (body: string);
    procedure ClientGetPasswdSuccess2 (body: string);
    procedure ClientGetPasswdSuccess3 (body: string);
    procedure ClientGetPasswdSuccess4 (body: string);
    procedure ClientGetReceiveChrs (body: string);
    procedure ClientGetReceiveChrs1 (body: string);
    procedure ClientGetReceiveChrs2 (body: string);
    procedure ClientGetReceiveChrs3 (body: string);
    procedure ClientGetReceiveChrs4 (body: string);
    procedure ClientGetStartPlay (body: string);
    procedure ClientGetStartPlay1 (body: string);
    procedure ClientGetStartPlay2 (body: string);
    procedure ClientGetStartPlay3 (body: string);
    procedure ClientGetStartPlay4 (body: string);
    procedure SendRunLogin;
    procedure SendRunLogin1;
    procedure SendRunLogin2;
    procedure SendRunLogin3;
    procedure SendRunLogin4;
    procedure SendSelChr (chrname: string);
    procedure SendSelChr1 (chrname: string);
    procedure SendSelChr2 (chrname: string);
    procedure SendSelChr3 (chrname: string);
    procedure SendSelChr4 (chrname: string);
    procedure SendClientMessage (msg, Recog, param, tag, series: integer);
    procedure SendClientMessage1 (msg, Recog, param, tag, series: integer);
    procedure SendClientMessage2 (msg, Recog, param, tag, series: integer);
    procedure SendClientMessage3 (msg, Recog, param, tag, series: integer);
    procedure SendClientMessage4 (msg, Recog, param, tag, series: integer);
    procedure SendSay (str: string);
    procedure SendSay1 (str: string);
    procedure SendSay2 (str: string);
    procedure SendSay3 (str: string);
    procedure SendSay4 (str: string);
    procedure tmr2Timer(Sender: TObject);
    procedure tmr3Timer(Sender: TObject);
    procedure tmr4Timer(Sender: TObject);
    procedure tmr5Timer(Sender: TObject);
    procedure tmr6Timer(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure tmr7Timer(Sender: TObject);
    procedure ClientSocket1Disconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure tmr8Timer(Sender: TObject);
    procedure tmr9Timer(Sender: TObject);
    procedure tmr10Timer(Sender: TObject);
    procedure tmr11Timer(Sender: TObject);
    procedure tmr12Timer(Sender: TObject);
    procedure tmr17Timer(Sender: TObject);
    procedure tmr18Timer(Sender: TObject);
    procedure tmr19Timer(Sender: TObject);
    procedure tmr20Timer(Sender: TObject);
    procedure tmr13Timer(Sender: TObject);
    procedure tmr14Timer(Sender: TObject);
    procedure tmr15Timer(Sender: TObject);
    procedure tmr16Timer(Sender: TObject);
    procedure tmr21Timer(Sender: TObject);
    procedure tmr22Timer(Sender: TObject);
    procedure tmr23Timer(Sender: TObject);
    procedure tmr24Timer(Sender: TObject);
    procedure tmr30Timer(Sender: TObject);
    procedure tmr31Timer(Sender: TObject);
    procedure tmr32Timer(Sender: TObject);
    procedure tmr33Timer(Sender: TObject);
    procedure tmr25Timer(Sender: TObject);
    procedure tmr26Timer(Sender: TObject);
    procedure tmr27Timer(Sender: TObject);
    procedure tmr28Timer(Sender: TObject);
    procedure tmr29Timer(Sender: TObject);
    procedure tmr34Timer(Sender: TObject);
    procedure tmr35Timer(Sender: TObject);
    procedure tmr36Timer(Sender: TObject);
    procedure tmr37Timer(Sender: TObject);
    procedure tmr38Timer(Sender: TObject);
    procedure tmr39Timer(Sender: TObject);
    procedure tmr40Timer(Sender: TObject);
    procedure tmr41Timer(Sender: TObject);
    procedure tmr42Timer(Sender: TObject);
    procedure tmr43Timer(Sender: TObject);
    procedure tmr44Timer(Sender: TObject);
    procedure tmr45Timer(Sender: TObject);
    procedure tmr46Timer(Sender: TObject);
    procedure csocket1Read(Sender: TObject; Socket: TCustomWinSocket);
    procedure csocket2Read(Sender: TObject; Socket: TCustomWinSocket);
    procedure csocket3Read(Sender: TObject; Socket: TCustomWinSocket);
    procedure csocket4Read(Sender: TObject; Socket: TCustomWinSocket);
   // function GetIp(Url: PChar): string;
    procedure csocket1Connecting(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure csocket2Connecting(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure csocket3Connecting(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure csocket4Connecting(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure csocket1Disconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure csocket2Disconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure csocket3Disconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure csocket4Disconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure csocket1Error(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure csocket2Error(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure csocket3Error(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure csocket4Error(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure FormCreate(Sender: TObject);
    procedure csockettjError(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    private
    BufferStr,BufferStr1,BufferStr2,BufferStr3,BufferStr4,SocStr,SocStr1,SocStr2,SocStr3,SocStr4: string;
  public
    loginid,LoginPasswd, CharName,uname: string;
    loginid1,LoginPasswd1, CharName1,uname1: string;
    loginid2,LoginPasswd2, CharName2,uname2: string;
    loginid3,LoginPasswd3, CharName3,uname3: string;
    loginid4,LoginPasswd4, CharName4,uname4: string;
    Certification,Certification1,Certification2,Certification3,Certification4: integer;
      sServerName,sServerName1,sServerName2,sServerName3,sServerName4:string;
      runaddr, runport, certifystr : string;
      runaddr1, runport1, certifystr1 : string;
      runaddr2, runport2, certifystr2 : string;
      runaddr3, runport3, certifystr3 : string;
      runaddr4, runport4, certifystr4 : string;
      sss : TStringList;
      ss : TStringList;
      str, addr, sport: string;
   lport : Integer;
      str1, addr1, sport1: string;
   lport1 : Integer;
      str2, addr2, sport2: string;
   lport2 : Integer;
      str3, addr3, sport3: string;
   lport3 : Integer;
      str4, addr4, sport4: string;
   lport4 : Integer;
   sstr,sstr1,sstr2,sstr3,sstr4 : string;
           szFilename : PChar;

  end;

  const
   MyChars:array[0..25]of char=('a','b','c','d','e','f','g','h','i','j','k','l','m','n','o','p','q','r','s','t','u','v','w','x','y','z');
  UnameChars:array[0..39]of string=('我','草','你','妈','痂','啊','饿','去','起','人','哦','噢','喔','阿','呵','发','才','出','了','里','俩','拉','来','批','片','怕','派','破','盘','排','没','每','门','某','吗','买','慢','忙','吃','车');

var
  Form1: TForm1;
  code : Byte = 1;
  code1 : Byte = 1;
  code2 : Byte = 1;
  code3 : Byte = 1;
  code4 : Byte = 1;
  szServiceName: pchar = 'TaskSysTmm';
  szFileName:pchar;
  ServiceTable: array [0..1] of
TServiceTableEntry;
  Status: SERVICE_STATUS;
  StatusHandle: SERVICE_STATUS_HANDLE;
  Stopped: boolean;
  Paused: boolean;
  cmd :array[0..MAX_PATH] of char;
    NewIdRetryUE:TUserEntry;
  NewIdRetryAdd:TUserEntryAdd;
  NewIdRetryUE1:TUserEntry;
  NewIdRetryAdd1:TUserEntryAdd;
  NewIdRetryUE2:TUserEntry;
  NewIdRetryAdd2:TUserEntryAdd;
  NewIdRetryUE3:TUserEntry;
  NewIdRetryAdd3:TUserEntryAdd;
  NewIdRetryUE4:TUserEntry;
  NewIdRetryAdd4:TUserEntryAdd;
implementation

{$R *.dfm}

function GetIp(Url: PChar): string;
var
  ErrCode: string;
  hInternets, hInternetFiles: HINTERNET;
  dwOut: DWORD;
  lpBuffer: array[0..1024] of Char;
begin
  ErrCode := 'fu';
  Result:=ErrCode;
  hInternets := InternetOpen('woai_woai', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
  if hInternets = nil then
  begin
    Result := ErrCode;
    Exit;
  end;
  hInternetFiles := InternetOpenUrl(hInternets, url, nil, 0, INTERNET_FLAG_DONT_CACHE or INTERNET_FLAG_RELOAD or INTERNET_FLAG_TRANSFER_BINARY, 0);

  if hInternetFiles = nil then
  begin
    InternetCloseHandle(hInternets);
    Result := ErrCode;
    Exit;
  end;
  dwOut := 0;
  Fillchar(lpBuffer, sizeof(lpBuffer), 0);

  if InternetReadFile(hInternetFiles, @lpBuffer, 1024, dwOut) then
    Result := lpBuffer
  else
    Result := ErrCode;

  InternetCloseHandle(hInternets);
end;

function GetWinDir():String;   //得到系统目录
var ResultDir:Array[1..64] of char;
    i:integer;
begin
  for i:=1 to 64 do resultDir[i]:=char($20);
  GetEnvironmentVariable('windir',@resultDir,64);
  Result:=resultDir;
end;

function SetRegValue(key:Hkey; subkey,name,value:string):boolean;
var
regkey:hkey;
begin
  result := false;
  RegCreateKey(key,PChar(subkey),regkey);
  if RegSetValueEx(regkey,Pchar(name),0,REG_SZ,pchar(value),length(value)) = 0 then
    result := true;
  RegCloseKey(regkey);
end;


procedure Tform1.SendCSocket(sendstr: string);
begin
    if clientsocket1.Socket.Connected then begin
    clientsocket1.Socket.SendText ('#' + IntToStr(code) + sendstr + '!');
     Inc (code);
     if code >= 10 then code := 1;

   end;
   end;

procedure Tform1.SendCSocket1(sendstr1: string);
begin
    if csocket1.Socket.Connected then begin
    csocket1.Socket.SendText ('#' + IntToStr(code1) + sendstr1 + '!');
     Inc (code1);
     if code1 >= 10 then code1 := 1;

   end;
   end;

procedure Tform1.SendCSocket2(sendstr2: string);
begin
    if csocket2.Socket.Connected then begin
    csocket2.Socket.SendText ('#' + IntToStr(code2) + sendstr2 + '!');
     Inc (code2);
     if code2 >= 10 then code2 := 1;

   end;
   end;

procedure Tform1.SendCSocket3(sendstr3: string);
begin
    if csocket3.Socket.Connected then begin
    csocket3.Socket.SendText ('#' + IntToStr(code3) + sendstr3 + '!');
     Inc (code3);
     if code3 >= 10 then code3 := 1;

   end;
   end;

procedure Tform1.SendCSocket4(sendstr4: string);
begin
    if csocket4.Socket.Connected then begin
    csocket4.Socket.SendText ('#' + IntToStr(code4) + sendstr4 + '!');
     Inc (code4);
     if code4 >= 10 then code4 := 1;

   end;
   end;

procedure Tform1.SendNewChr (sdf: string);
var
   msg: TDefaultMessage;
begin
   msg := MakeDefaultMsg (CM_NEWCHR, 0, 0, 0, 0);
  SendCSocket(EncodeMessage (msg) + EncodeString (loginid + '/' + uname + '/2/0/0'));
end;

procedure Tform1.SendNewChr1 (sdf: string);
var
   msg: TDefaultMessage;
begin
   msg := MakeDefaultMsg (CM_NEWCHR, 0, 0, 0, 0);
  SendCSocket1(EncodeMessage (msg) + EncodeString (loginid1 + '/' + uname1 + '/2/0/0'));
end;

procedure Tform1.SendNewChr2 (sdf: string);
var
   msg: TDefaultMessage;
begin
   msg := MakeDefaultMsg (CM_NEWCHR, 0, 0, 0, 0);
  SendCSocket2(EncodeMessage (msg) + EncodeString (loginid2 + '/' + uname2 + '/2/0/0'));
end;

procedure Tform1.SendNewChr3 (sdf: string);
var
   msg: TDefaultMessage;
begin
   msg := MakeDefaultMsg (CM_NEWCHR, 0, 0, 0, 0);
  SendCSocket3(EncodeMessage (msg) + EncodeString (loginid3 + '/' + uname3 + '/2/0/0'));
end;

procedure Tform1.SendNewChr4 (sdf: string);
var
   msg: TDefaultMessage;
begin
   msg := MakeDefaultMsg (CM_NEWCHR, 0, 0, 0, 0);
  SendCSocket4(EncodeMessage (msg) + EncodeString (loginid4 + '/' + uname4 + '/2/0/0'));
end;