unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, ScktComp;
type
TForm1 = class(TForm)
ClientSocket1: TClientSocket;
Button1: TButton;
Edit1: TEdit;
Edit2: TEdit;
Edit3: TEdit;
Edit4: TEdit;
RadioButton1: TRadioButton;
RadioButton2: TRadioButton;
Timer1: TTimer;
procedure Button1Click(Sender: TObject);
procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
procedure Timer1Timer(Sender: TObject);
private
public
end;
Pers = record
ID: string;
rait: integer;
nick: string;
clan: string;
x: integer;
end;
var
Form1: TForm1;
users: array [1..70] of pers;
ParseStack: string;
reccode, startedplanet: string;
MyId,Mypass: string;
Hash:string;
var_6b8e: integer=0;
var_6bae: integer=0;
var_6b9e: integer=0;
var_6b96: integer=0;
ctc: integer=1;
ctct: integer;
implementation
{$R *.dfm}
function NextStr(var s: string):string;
var
i: integer;
begin
i:=pos(' ',s);
if i<>0 then begin
result:=copy(s,1,i-1);
delete(s,1,i);
end else begin
result:=s;
s:='';
end;
end;
function UpperCaseRU(s: string): string;
var
i: integer;
begin
result := s;
for i := 1 to length(result) do
if (result[i] in ['a'..'z', 'а'..'я']) then
result[i] := chr(ord(result[i]) - 32)
else if result[i]='ё' then result[i]:='Ё';
end;
function sub_1cfc(i,j:integer): integer;
var
k: integer;
begin
k:=1;
while (j > 0) do begin
if((j mod 2) = 1)
then k:=k*i;
j:= j shr 1;
i := i*i;
end;
result:=k;
end;
function ConvertCTKey(s: string):integer;
var
l,r: integer;
begin
r:=0;
for l:=1 to length(s) do begin
r:=(r shl 8) + ord(s[l]);
end;
result:=r;
end;
procedure SendText(s:string);
procedure ParseText(s:string);
procedure ProgRun;
procedure TForm1.SendText(s:string);
var
i,j: integer;
begin
var_6b9e:=var_6b9e+length(s);
var_6bae:=var_6bae+1;
s:=ansitoutf8(s);
oursock.socket.SendText(s+#13#10);
inc(ctc);
if ctc=(ctct+1) then begin
ctc:=1;
if(var_6b8e = 0) then
var_6b8e:= var_6b96;
i:=sub_1cfc(var_6b8e,var_6bae);
j:= var_6b96 shl var_6b9e;
var_6b8e:= i xor j;
oursock.socket.SendText('ct '+inttostr(var_6b8e)+#13#10);
end;
end;
function GetEmptyUser:integer;
var
i: integer;
begin
result:=-1;
for i:=1 to 70 do
if users[i].ID='0' then begin
result:=i;
break;
end;
end;
procedure EraseUser(N: integer);
begin
users[n].ID:='0';
users[n].rait:=0;
users[n].nick:='-';
users[n].clan:='-';
users[n].x:=0;
end;
procedure EraseAllUsers;
var
i:byte;
begin
for i:=1 to 70 do
EraseUser(i);
end;
procedure LoadUsers(s:string);
var
i:integer;
tpos:integer;
ind: integer;
sub:string;
begin
s:=copy(s,pos(':',s)+1,length(s));
s:=utf8toansi(s);
i:=GetEmptyUser;
while true do begin
if length(s)<10 then break;
users[i].clan:=Nextstr(s);
users[i].nick:=NextStr(s);
if users[i].nick[1]='+' then begin
delete(users[i].nick,1,1);
end;
if users[i].nick[1]='@' then begin
delete(users[i].nick,1,1);
end;
users[i].id:=Nextstr(s);
if Nextstr(s) = '-1' then begin
NextStr(s); NextStr(s);
NextStr(s); NextStr(s);
NextStr(s);
end else begin
NextStr(s);
end;
users[i].x:=Strtoint(Nextstr(s));
inc(i);
end;
end;
procedure TForm1.ParseText(s:string);
var
sub:string;
i:integer;
cmd: string;
begin
if s='' then exit;
cmd:=NextStr(s);
if cmd='HAAAPSI' then begin
sub:=NextStr(s);
HASH:=GHash.CreateHash(sub);
var_6b96:=ConvertCTKey(sub);
ctct:=strtoint(NextStr(s));
sendtext(':ru IDENT 111 -1 4030 1 2 :GALA');
sendtext('RECOVER '+reccode);
end else
if cmd='REGISTER' then begin
MyID:=NextStr(s);
MyPass:=NextStr(s);
sendtext('USER'+' '+MyId+' '+MyPass+' 0 '+HASH);
end else
if cmd='999' then begin
Sendtext('FWLISTVER 0');
sendtext('ADDONS');
sendtext('MYADDONS');
Sendtext('JOIN '+StartedPlanet);
end else
if cmd='PING' then begin
sendtext('PONG');
end else
if cmd='LBS' then begin
sendtext('LBS 2 platform=MPP cellid=null mcc=null mnc=null lac=null');
end else
if cmd='353' then begin
LoadUsers(s);
form1.ProgRun;
end;
end;
procedure TForm1.ProgRun;
begin
Timer1.Interval:=StrToInt(Edit3.text);
Timer1.Enabled:=true;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
var
id: String;
i: integer;
begin
Timer1.Enabled:=false;
id:='hz';
if RadioButton1.Checked then
for i:=1 to 70 do
if UpperCaseRU(Edit4.Text)=UpperCaseRu(Users[i].nick) then begin
id:=users[i].ID;
break;
end;
if RadioButton2.Checked then
for i:=1 to 70 do
if UpperCaseRU(Edit5.Text)=UpperCaseRu(Users[i].clan) then begin
id:=users[i].ID;
break;
end;
if id<>'hz' then SendText('ACTION 3 '+id);
SendText('QUIT :ds');
OurSock.Close;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
EraseAllUsers;
reccode:=Edit1.Text;
StartedPlanet:=Edit2.text;
OurSock.Active:=true;
end;
procedure TForm1.ClientSocket1Read(Sender: TObject;
Socket: TCustomWinSocket);
begin
var
recv: string;
l: integer;
send: string;
begin
recv:=Socket.ReceiveText;
ParseStack:=ParseStack+recv;
l:=pos(#13#10,ParseStack);;
while l>0 do begin
recv:=copy(ParseStack,1,l+1);
parsetext(recv);
Delete(ParseStack,1,l+1);
l:=pos(#13#10,ParseStack);
end;
end;
end.
04.01.2015, 21:23
Подскажите новичку, что не так ?
Линейный вид
