![]() |
|
|
Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
![]() |
|
Опции темы | Поиск в этой теме | Опции просмотра |
#1
|
|||
|
|||
![]() Код:
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 { Private declarations } public { Public declarations } 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. |
#2
|
|||
|
|||
![]() |
#4
|
||||
|
||||
![]() Код беззастенчиво содран с чужих исходников без понимания что и для чего и, компилироваться в принципе не может.
Je venus de nulle part 55.026263 с.ш., 73.397636 в.д. |
#5
|
|||
|
|||
![]() ещё как может
|
#6
|
||||
|
||||
![]() почитай как объявляются классы, добавляются методы, свойства...
Пишу программы за еду. __________________ |
#7
|
||||
|
||||
![]() Цитата:
Je venus de nulle part 55.026263 с.ш., 73.397636 в.д. |
#8
|
|||
|
|||
![]() я та позавчера только скачал дельфи, а другие собирают, закройте тему, все такие умные аж не знаю кого слушать
|
#9
|
||||
|
||||
![]() Ну попытайтесь хотя бы понять, что у вас делают строки 107-109.
Je venus de nulle part 55.026263 с.ш., 73.397636 в.д. |