Pascal — Говнокод.ру

Pascal / Говнокод #6768

+114

01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26

procedure TForm1.Button1Click(Sender: TObject);
  var
    a,b,c,x:integer;
    chas, nedel1,nedel2,nedel3:integer;
begin
  a:=0;
  b:=0;
  c:=0;
  repeat
    chas:= strtoint (edit1.text);
    nedel1:= strtoint (edit2.text);
    nedel2:= strtoint (edit3.text);
    nedel3:= strtoint (edit4.text);
    x:=((nedel1*a)+(nedel2*b)+(nedel3*c));
    if chas<>((nedel1*a)+(nedel2*b)+(nedel3*c)) then
      a:=a+1;
    if chas<>((nedel1*a)+(nedel2*b)+(nedel3*c)) then
      b:=b+1;
    if chas<>((nedel1*a)+(nedel2*b)+(nedel3*c)) then
      c:=c+1;
  until chas=x;
  label1.Caption:=inttostr (a);
  label2.Caption:=inttostr (b);
  label3.Caption:=inttostr (c);
end;
end.

евклид плачет

bugmenot, 27 Мая 2011

Комментарии (11)

Pascal / Говнокод #6731

+87

01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18

procedure TForm1.Edit1Change(Sender: TObject);
begin
if Edit1.Text='515' then
Form1.Caption:='Пароль взломан!'
else Form1.Caption:='неправельно!';
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Edit1.Text:='1';
if Edit1.Text='1' then
begin
if Form1.Caption='неправельно!' then
Edit1.Text:='2';
if Edit1.Text='2' then
begin
if Form1.Caption='неправельно!' then
Edit1.Text:='3';

Личинка человека решила сделать брутфорс паролей. Когда нажимается кнопка идёт беспощадный перебор без цикла на предмет совпадения пароля

memnek, 23 Мая 2011

Комментарии (21)

Pascal / Говнокод #6689

+107

01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
20

function HexToInt(s: string): integer;
label
  gte;
var
  tempt: string;
  i: integer;
begin
  tempt := '';
  if s = '' then
  begin
    HexToInt := 0;
    goto gte;
  end;
  for i := 1 to Length(s) do
  begin
    tempt := tempt + IntToHex(Ord(s[i]), 2);
  end;
  HexToInt := StrToInt('$' + tempt);
  gte:
end;

Ряд гениальных решений из-за незнания особенностей языка.

Честно взято с: http://www.delphisources.ru/pages/faq/base/hex_to_int.html
Честно написано автором: Перегинец Иваном ( [email protected] )

miLord-Corwin, 17 Мая 2011

Комментарии (88)

Pascal / Говнокод #6676

+112

1
2
3

while (FilePos(SrcFile) <> FileSize(SrcFile)) do begin
    BlockRead(SrcFile,Res,1);
...

Пытаюсь одному объяснить кое-что из основ. Мне плохо от его перлов.
Нехорошо смеяться над новичками, но я уже не выдержал...

http://www.gamedev.ru/flame/forum/?id=147021&page=10#m148

TarasB, 15 Мая 2011

Комментарии (26)

Pascal / Говнокод #6617

+103

01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51

function TForm1.getyoutube(ss: string): string;
var
//Вылавливаем ссылку
i:integer;
pos:integer;
length1:integer;
ssylka:string;
pos_str:string;
//Удаляем ненужные символы
pos_str2:string;
pos2,pos23:integer;
ssc:char;
begin
//Вылавливаем ссылку если это ютубовская ссылка
if isitok('youtube.com',ss)=true then
begin
  protect;
  memo1.lines.Text:=idhttp1.Get(ss);
  for i:=0 to memo1.Lines.Count do
  begin
  pos_str:='				img.src = '+#39;
  pos:=AnsiPos(pos_str,memo1.Lines.Strings[i]);
  if pos=1 then
  begin
  length1:=length(memo1.Lines.Strings[i])-length(pos_str)-2;
   ssylka:=copy(memo1.Lines.Strings[i],pos+length(pos_str),length1);
    end;
    end;
    ssc:=#160;
     pos_str:='youtube.com';
    pos:=AnsiPos(pos_str,ssylka);
    delete(ssylka,pos+length(pos_str),1);
    delete(ssylka,6,1);
    delete(ssylka,7,1);
      pos_str2:='youtube.com/';
    pos2:=AnsiPos(pos_str,ssylka);
    pos2:=pos2+length(pos_str2);
       pos_str2:='?ip';
    pos23:=AnsiPos(pos_str,ssylka);
    delete(ssylka,pos2,pos2-pos23);
    insert('videoplayback',ssylka,pos2);
    result:=ssylka;
    end
    else
    begin
      protectoff;
    form2.show;
      form1.enabled:=false;
    end;
      protectoff;
end;

Очень старый способ скачать видео с YouTube

KapoeD, 10 Мая 2011

Комментарии (43)

Pascal / Говнокод #6594

+78

01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38

procedure TForm1.WSocket1DataAvailable(Sender: TObject; ErrCode: Word);
var
msg,msg1: string;
begin
msg:=Wsocket1.ReceiveStr;
Memo1.Lines.add(UTF8DECODE(msg));
if copy(msg,0,8)='HAAAPSI ' then
begin
msg1:=Copy(msg,8,pos(msg,#20));
WSocket1.SendStr(':ru IDENT 34 -1 4030 :GALA'+#13#10);
if Edit1.Text='' then
exit;
WSocket1.SendStr('RECOVER ' +Edit1.Text+#13#10)
end
else if Copy(msg,0,9)='REGISTER ' then
begin
msg1:=copy(msg,9,length(msg));
WSocket1.SendStr('USER '+msg1+#13#10);
end
else if Copy(msg,0,5)='LBS 1' then
WSocket1.SendStr('GETPL'+#13#10)
else if Copy(msg,0,3)='822' then
begin
WSocket1.SendStr('JOIN'+#13#10);
WSocket1.SendStr('ADDONS'+#13#10);
WSocket1.SendStr('MYADDONS'+#13#10);
end
else if Copy(msg,0,4)='PING' then
WSocket1.SendStr('PONG'+#13#10);
end;
procedure TForm1.WSocket1DnsLookupDone(Sender: TObject; ErrCode: Word);
begin
WSocket1.Port:='6667';
WSocket1.Proto:='tcp';
WSocket1.Addr:=WSocket1.DnsResult;
WSocket1.Connect;
con:=true;
end;

Говно код подкл. к чату галактика знакомств да еще по 34 протоколу его скоро закроют....

megaruliz, 08 Мая 2011

Комментарии (14)

Pascal / Говнокод #6592

+147

01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17

procedure AddColoredLine(ARichEdit: TRichEdit; AText: string; AColor: TColor);
begin
with ARichEdit do
begin
SelStart := Length(Text);
SelAttributes.Color := AColor;
SelAttributes.Size := 8;
SelAttributes.Name := 'MS Sans Serif';
Lines.Add(AText);
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
AddColoredLine(RichEdit1, 'Govnokoder уебок', clRed);
AddColoredLine(RichEdit1, 'Govnocoder уебок', clGreen);
end;

говнокодер уебак разными цветами

megaruliz, 07 Мая 2011

Комментарии (1)

Pascal / Говнокод #6591

+147

01
02
03
04
05
06
07
08
09
10
11
12
13

Program n_a;
uses crt;
Var c:char; k: byte;
BEGIN
clrscr; k:=0;
Write(‘Введите текст:'); read(c);
Repeat
      While(c=' ') and Not eoln Do 	                    		Read(c);
      	inc(k);
      While(c<>' ') and Not eoln Do 	                    		Read(c);
Until eoln;
WriteLn('k= ',k:3);
END.

так физматы находят сколько слов в тексте

megaruliz, 07 Мая 2011

Комментарии (12)

Pascal / Говнокод #6590

+147

01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18

Program n_g;
uses crt;
Var c:char; st:string[50]; k: byte;
BEGIN  clrscr;
k:=255;
Write('Vvedite tekst:');
read(c);
Repeat
      While(c=' ') and (c<>#13 Do Read(c);
      	st:='';
      While(c<>' ') and (c<>#13 Do	 Begin
      	st:=st+c;
      	Read(c);			 End;
      WriteLn('st=',st);
      If ord(st[0])<k Then k:=ord(st[0]);
Until c=#13;
WriteLn('k= ',k:3); readLn   
END.

Так физматы находят длинну самого короткого слова

megaruliz, 07 Мая 2011

Комментарии (6)

Pascal / Говнокод #6589

+147

1
2
3
4
5
6
7

Procedure ks(s:string;q:char; var k:byte);
    var i:byte;
Begin
k:=0;
For i:=1 To Length(s) Do
   If s[i]=q Then inc(k);
End;

Гавно код

megaruliz, 07 Мая 2011

Комментарии (10)

Говнокод: по колено в коде.

Pascal / Говнокод #6768

Pascal / Говнокод #6731

Pascal / Говнокод #6689

Pascal / Говнокод #6676

Pascal / Говнокод #6617

Pascal / Говнокод #6594

Pascal / Говнокод #6592

Pascal / Говнокод #6591

Pascal / Говнокод #6590

Pascal / Говнокод #6589