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

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

+100

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

{Podschet dlini}
Reset(f1);
kol:=0;
while not eof(f1) do begin
readln(f1,l);
For i1:=1 to length(l) do if (l[i]='a')or(l[i]='A') or (l[i]='b')or(l[i]='B')
or(l[i]='c')or(l[i]='C')or(l[i]=' ')or(l[i]='d')or(l[i]='D')
or(l[i]='e')or (l[i]='E') or(l[i]='f') or(l[i]='F')
or (l[i]='g')or (l[i]='G') or (l[i]='h')or(l[i]='H')
or(l[i]='i')or(l[i]='I')or(l[i]='J')or(l[i]='j')
or(l[i]='k')or(l[i]='K')or(l[i]='l')or(l[i]='L')
or (l[i]='m')or (l[i]='M')or(l[i]='n')or(l[i]='N')
or (l[i]='o')or(l[i]='O')or(l[i]='p')or(l[i]='P')
or(l[i]='q')or(l[i]='Q')or (l[i]='r')or (l[i]='R')
or(l[i]='S')or(l[i]='s')or(l[i]='t')or(l[i]='T')
or(l[i]='v')or(l[i]='V') or(l[i]='w')or(l[i]='W')
or(l[i]='u')or(l[i]='U')or(l[i]='x')or(l[i]='X')
or(l[i]='y')or(l[i]='Y')or (l[i]='z')or(l[i]='Z') then
kol:=kol+1;
end;
WriteLn('kol=',kol);

Необходимо создать текстовый файл, содержащий исходную программу, а также подсчитать длину созданного файла.
http://ithappens.ru/story/7652

d_dev, 31 Октября 2011

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

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

+84

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

program index;
uses crt;
const y=20;
var a:array[1..y]of Integer;
    i,
    j,
    x,
    Found:Integer;
begin
  clrscr;
  Found:=0;
  for i:=1 to y do
  begin
    WriteLn('Vvedite ',i,'- and element massiva');
    ReadLn(a[i]);
  end;
  Write('Vvedite X=');
  ReadLn(x);
  for i:=1 to y do
    for j:=i+1 to y do
    begin
      if (x=(Sqr(a[i])+Sqr(a[j]))) then
      begin
        Found:=Found+1;
        WriteLn('a=',a[i],' b=',a[j]);
      end;
    end;
  if Found=0 then
        WriteLn('Takih chisel net');
  ReadLn;
end.

одномерный числовой масив

ITdocer, 23 Октября 2011

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

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

+146

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

program chet;
uses crt;
var a,
    b,
    x,
    y:Integer;
begin
  clrscr;
  Write('Vvedite X=');
  ReadLn(x);
  Write('Vvedite Y=');
  ReadLn(y);
  for a:=0 to 30000 do
    for b:=0 to 30000 do
    begin
      if (a+b=x)and(a*b=y) then
      begin
        Write('a=',a);
        WriteLn('b=',b);
      end;
    end;
  ReadLn;
end.

находи все возможные пары A и B!

ITdocer, 23 Октября 2011

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

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

+147

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

program s_27;
uses crt;
function SummaCifr(n:integer):byte;

var s,
    x:integer;
{----------------------------------------------------------------------------}
begin
  clrscr;
  s:=0;
  x:=n;
  while x>0 do begin
    s:=s+(x mod 10);

    x:=x div 10;
  end;
  SummaCifr:=s;
end;
{----------------------------------------------------------------------------}
var i,k:integer;
begin
  i:=2;
  k:=99;
  while SummaCifr(k)<>27 do
  begin
    k:=i*99;
    inc(i);
  end;
  WriteLn('Rezult:',k);
  ReadLn;
end.

поиск числа!

ITdocer, 23 Октября 2011

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

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

+145

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
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85

program gays;
uses crt;
var k,k1,kn,n,i,j:integer;
    a,c:array [1..100,1..100] of real;
    f,x,b,d:array [1..100] of real;
    r:real;
begin
  repeat
  Write ('put poriadok n<100, n=');
  readln(n);
  until n<100;
  for i:=1 to n do
   begin
     for j:=1 to n do
      begin
        write('a [',i,';',j,']=');
        readln(a[i,j]);
        c[i,j]:=a[i,j];
      end;
     write('b [',i,']=');
     readln(b[i]);
     d[i]:=b[i];
   end;
 //3blok
  for k:=1 to (n-1) do
   begin
     //4 blok
     if a[k,k]=0 then
      begin
         k1:=k;
         repeat
          k1:=k1+1 ;
         until (a[k1,k]<>0) or (k1>n);
         if a[k1,k]=0 then
          begin
            writeln('Vedushii elementi ravni nuly');
            halt;
          end;
         kn:=k1;
         for j:=1 to n do
          begin
            r:=a[k,j];
            a[k,j]:=a[kn,j];
            a[kn,j]:=r;
          end;
          r:=b[k];
          b[k]:=b[kn];
          b[kn]:=r;
      end;
          //5 blok
     b[k]:=b[k]/a[k,k];
     for i:=(k+1) to n do
       b[i]:=b[i]-a[i,k]*b[k];
     for j:=(k+1) to n do
      begin
        a[k,j]:=a[k,j]/a[k,k];
        for i:=(k+1) to n do
          a[i,j]:=a[i,j]-a[i,k]*a[k,j];
      end;
   end;
  //end 3 blok
  x[n]:=b[n]/a[n,n];
  // 7 blok

  for i:=(n-1) downto 1 do
   begin
     for j:=i+1 to n do
       b[i]:=b[i]-x[j]*a[i,j] ;
     x[i]:=b[i];
   end;

   // 8 blok
   for i:=1 to n do
     if x[i]<0 then writeln ('nomer otricatelnogo kornia =',i);
   for j:=1 to n do writeln('x[',j,']=',x[j]:10:4);
   // 9 blok
   for i:=1 to n do
    begin
      f[i]:=-d[i];
      for j:=1 to n do
        f[i]:=f[i]+c[i,j]*x[j];
      writeln('F=',f[i]:10:4);
    end;
readkey;
end.

Очередной высер стажера при написании учетного решения в 1С

alexoy, 18 Октября 2011

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

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

+148

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

program analize_methods;
uses dos,crt;
const amax=10000;
type ar=array [1..amax] of integer;
ar3=array [1..3] of ar;
var a:ar3;b:^ar3;
time:array [1..2,1..3] of real;
hour,min,sec,sec100:word;
r,r1,r2:real;
ns,i,k:integer;
f:text;

{ЊҐв®¤ б®авЁа®ўЄЁ vyborom)}
procedure vybor(var m:ar);
var i,j,x,p:integer;
begin
for i:=1 to amax-1 do
begin
p:=i;
x:=m[i];
for j:=i+1 to amax do
if x>m[j] then
begin
p:=j;
x:=m[j];
end;
m[p]:=m[i];
m[i]:=x;
end;
end;

{ б®авЁа®ўЄ  ўбв ўЄ®© }
procedure Inser(var item:ar; count:integer);
var
i,x,j: integer;
begin
for i := 2 to count do
begin
x := item[i];
j := i-1;
while (x<item[j]) and (j>0) do
begin
item[j+1] := item[j];
j := j-1;
end;
item[j+1] := x;
end;
end;  { Є®Ґж б®авЁа®ўЄЁ ўбв ўЄ®© }

Это человек на собеседовании написал. Задача была - реализовать асинхронный ввод в 1С

alexoy, 17 Октября 2011

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

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

+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

procedure tform1.cek_setting;
begin
 { RUTIN CEK FILE CONFIG }
  { Cek File Buzz.cfg }
 status := '';
 ceklagu('C:\Windows\buzz.cfg');
 status := cek_lagu;
 if status = 'sukses' then
 begin
  listbox2.Items.LoadFromFile('C:\Windows\buzz.cfg');
  load_setting;
  save_setting;
 end else
 begin
  default_setting;
  load_setting;
  save_setting;
 end;
  { Cek File Buzz.dat }
 status := '';
 ceklagu('C:\Windows\buzz.dat');
 status := cek_lagu;
 if status = 'sukses' then
 begin
  listbox3.Items.LoadFromFile('C:\Windows\buzz.dat');
  convert_files;
 end else
  listbox3.Items.SaveToFile('c:\Windows\buzz.dat');
 { Cek File Buzz.sld }
 status := '';
 ceklagu('C:\Windows\buzz.sld');
 status := cek_lagu;
 if status = 'sukses' then
 begin
  listbox4.Items.LoadFromFile('C:\Windows\buzz.sld');
 end else
  listbox4.Items.SaveToFile('C:\Windows\buzz.sld');
end;

https://github.com/achri/Buzzwave/blob/master/Unit1.pas
Там такого завались, achriнеть можно.

d_dev, 17 Октября 2011

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

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

+106

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
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93

procedure Tform1.mix;
begin
 randomize;
 a[1]:=random(16)+1;
 btn[1].Caption:=inttostr(a[1]);
begin
repeat
 a[2]:=random(16)+1
until
 a[2]<>a[1];
 btn[2].Caption:=inttostr(a[2]);
begin
repeat
 a[3]:=random(16)+1
until
 (a[3]<>a[2]) and (a[3]<>a[1]);
 btn[3].Caption:=inttostr(a[3]);
begin
repeat
 a[4]:=random(16)+1
until
 (a[4]<>a[2]) and (a[4]<>a[1]) and (a[4]<>a[3]);
 btn[4].Caption:=inttostr(a[4]);
begin
repeat
 a[5]:=random(16)+1
until
 (a[5]<>a[2]) and (a[5]<>a[1]) and (a[5]<>a[3]) and (a[5]<>a[4]);
 btn[5].Caption:=inttostr(a[5]);
begin
repeat
 a[6]:=random(16)+1
until
 (a[6]<>a[1]) and (a[6]<>a[2]) and (a[6]<>a[3]) and (a[6]<>a[4])
 and (a[6]<>a[5]);
 btn[6].Caption:=inttostr(a[6]);
begin
repeat
 a[7]:=random(16)+1
until
 (a[7]<>a[1]) and (a[7]<>a[2]) and (a[7]<>a[3]) and
 (a[7]<>a[4]) and (a[7]<>a[5]) and (a[7]<>a[6]);
 btn[7].Caption:=inttostr(a[7]);
begin
repeat
 a[8]:=random(16)+1
until
 (a[8]<>a[1]) and (a[8]<>a[2]) and (a[8]<>a[3]) and
 (a[8]<>a[4]) and (a[8]<>a[5]) and (a[8]<>a[6]) and (a[8]<>a[7]);
 btn[8].Caption:=inttostr(a[8]);
begin
repeat
 a[9]:=random(16)+1
until
 (a[9]<>a[1]) and (a[9]<>a[2]) and (a[9]<>a[3]) and (a[9]<>a[4]) and
 (a[9]<>a[5]) and (a[9]<>a[6]) and (a[9]<>a[7]) and (a[9]<>a[8]);
 btn[9].Caption:=inttostr(a[9]);
...
...
...
begin
repeat
 a[14]:=random(16)+1
until
 (a[14]<>a[1]) and (a[14]<>a[2]) and (a[14]<>a[3])
 and (a[14]<>a[4]) and (a[14]<>a[6]) and
 (a[14]<>a[7]) and (a[14]<>a[5]) and (a[14]<>a[9])
 and (a[14]<>a[8]) and (a[14]<>a[10]) and
 (a[14]<>a[11]) and (a[14]<>a[12]) and (a[14]<>a[13]);
 btn[14].Caption:=inttostr(a[14]);
begin
repeat
 a[15]:=random(16)+1
until
 (a[15]<>a[1]) and (a[15]<>a[2]) and (a[15]<>a[3]) and
 (a[15]<>a[4]) and (a[15]<>a[6]) and (a[15]<>a[7]) and
 (a[15]<>a[5]) and (a[15]<>a[9]) and (a[15]<>a[8]) and
 (a[15]<>a[10]) and (a[15]<>a[11]) and (a[15]<>a[12])
 and (a[15]<>a[13]) and (a[15]<>a[14]);
 btn[15].Caption:=inttostr(a[15]);
begin
repeat
 a[16]:=random(16)+1
until
 (a[16]<>a[1]) and (a[16]<>a[2]) and (a[16]<>a[3]) and
 (a[16]<>a[4]) and (a[16]<>a[6]) and (a[16]<>a[7]) and
 (a[16]<>a[5]) and (a[16]<>a[9]) and (a[16]<>a[8]) and
 (a[16]<>a[10]) and (a[16]<>a[11]) and (a[16]<>a[12])
 and (a[16]<>a[13]) and (a[16]<>a[14]) and (a[16]<>a[15]);
 btn[16].Caption:=inttostr(a[16]);
 timer3.Enabled:=true;
end; end; end; end; end; end; end; end; end;
end; end; end; end; end; end; end;

Это у меня однокурсник писал пятнашки(данная процедура заполняет массив неповторяющимися числами от одного пятнадцати), и не лень же ему было...

suc-daniil, 14 Октября 2011

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

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

+122

1
2
3
4
5
6
7
8

case m of
 1: yy=x[0]+x[1]*i;
 2: yy=x[0]+x[1]*i+x[2]*i*i;
 3: yy=x[0]+x[1]*i+x[2]*i*i+x[3]*i*i*i;
 4: yy=x[0]+x[1]*i+x[2]*i*i+x[3]*i*i*i+x[4]*i*i*i*i;
 5: yy=x[0]+x[1]*i+x[2]*i*i+x[3]*i*i*i+x[4]*i*i*i*i+x[5]*i*i*i*i*i;
 6: yy=x[0]+x[1]*i+x[2]*i*i+x[3]*i*i*i+x[4]*i*i*i*i+x[5]*i*i*i*i*i+x[6]*i*i*i*i*i*i
end;

Увидел у одногруппницы в лабе по численным методам (3й курс) вот такое... Интересный подход к степени)))

darktemplar257, 10 Октября 2011

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

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

+89

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

unit uIsPalindrome; 
  
interface
  
function IsPalindrome(const aString: string): Boolean; 
  
implementation
  
uses
       Spring.Collections 
     , {$IF CompilerVersion >= 230}System.{$IFEND}SysUtils 
     ; 
  
function CleanString(const aString: string): string; 
var
  C: char; 
begin
  // Remove all non-alpha chars and make all lower case 
  // Spaces don't matter, so let's count only letters 
  Result := ''; 
  for C in LowerCase(aString) do
  begin
    if CharInSet(C, ['a'..'z', 'A'..'Z']) then
    begin
      Result := Result + C; 
    end; 
  end; 
end; 
  
function IsPalindrome(const aString: string): Boolean; 
var
  Stack: IStack<Char>; 
  C: Char; 
  NoSpaces: string; 
  Temp: string; 
begin
  NoSpaces :=  CleanString(aString); 
  
  Stack := TCollections.CreateStack<Char>; 
  for C in NoSpaces do
  begin
    Stack.Push(C); 
  end; 
  Temp := ''; 
  repeat
    Temp := Temp + Stack.Pop; 
  until Stack.Count = 0; 
  Result := Temp = NoSpaces; 
end; 
  
end.

true java style...

d_dev, 10 Октября 2011

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

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

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

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

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

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

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

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

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

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

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

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