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

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

−8

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

Program print_numbers_twice;

Procedure give(p: pptrint);
begin
	if pptrint(p^) <> nil then begin
		give(pptrint(p^));
		writeln((p-1)^)
	end
end;

Procedure take;
var n: ptrint;
begin
	if not SeekEof then begin
		read(n);
		take
	end else begin
		n := (pptrint(@n)+1)^;
		give(pptrint(n));
		give(pptrint(n))
	end
end;

Begin
	take
End.

На входе программа получает неизвестное заранее количество целых чисел, разделенных пробельными символами, а затем выводит их два раза в том же порядке по одному числу в строке.

Очень простая и короткая программа. Я думаю, вам не составит труда понять, как она работает. Пишите в комментариях!

Threadwalker, 22 Декабря 2021

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

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

−2

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

// Подгрузка аватаров пользователей.
    Bmp:=TBitMap.Create; // Нет более изящного спооба узнать тип изображения, не колупаясь в заголовках. Расширение файлов картинок зачастую фиктивное.
    try                  // Зная, что ава может быть только двух типов - jpg и png, я решил пойти конём.
      Bmp.PixelFormat:=pf32Bit;
      Bmp.Width:=16;
      Bmp.Height:=16;
      ImgConv:=True;
      Png:=TPngObject.Create;
      try
        try
          Comm.RawAvatar.Position:=0;
          Png.LoadFromStream(Comm.RawAvatar);
          Bmp.Canvas.StretchDraw(Bmp.Canvas.ClipRect, Png);
        except
          ImgConv:=False;     // Ошибка конвертирования. Не совпал формат - идем дальше, пробуем jpg...
        end;
      finally
        Png.Free;             // нет смысла раскручивать стек, ибо исключение в любом случае отловится try..except
      end;
      if not ImgConv then
      begin
        Jpg:=TJPEGImage.Create;
        try
          try
            Comm.RawAvatar.Position:=0;
            Jpg.LoadFromStream(Comm.RawAvatar);
            Bmp.Canvas.StretchDraw(Bmp.Canvas.ClipRect, Jpg);
          except
          end;
        finally
          Jpg.Free;
        end;
      end;
      CommentList.Items[I].ImageIndex:=Images.AddMasked(Bmp, clWhite);
    finally
      Bmp.Free;
    end;
  end;

"Тут всюду густая вонь, то жаркая и приятная, то теплая и противная, но одинаково волнующая, особая, пароходная, мешающаяся с морской свежестью"

@ Бунин.

Теперь минусатор умеет подгружать авы.
https://dropmefiles.com/USQKW

Support, 05 Ноября 2021

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

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

−1

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

function ReplaceHTMLSpec(First, Last, RepTo, RepEd:string):string;
var
  I, P, St:Integer;
  SS, Temp:string;
begin
  Temp:='';
  ST:=0;
  while True do
  begin
    P:=Pos(First, Result);
    if P = 0 then Break;
    SS:=Copy(Result, ST, P-1)+RepTo;
    Temp:=Temp+SS;
    ST:=P+Length(First);
    Result:=Copy(Result, ST, MaxInt);
    P:=Pos(Last, Result);
    if P > 0 then
    begin
      SS:=Copy(Result, 1, P-1)+RepEd;
      Temp:=Temp+SS;
      ST:=P+Length(Last);
      SS:=Copy(Result,ST, MaxInt);
      Temp:=Temp+SS;
    end;
    Result:=Temp;
  end;
end;

function DecorateText(S:string):string;
const
  Arr:array[0..3] of string=('<br>','&quot;','&lt;','&gt;');
var
  I, P, St:Integer;
  SS, Temp:string;
begin
  Result:=S;
  for I:=0 to 3 do
  Result:=StringReplace(Result, Arr[I], '',[rfreplaceall]);
  Result:=StringReplace(Result,'<br />',#13#10,[rfreplaceall]);
  Result:=StringReplace(Result,'<i>','[i]',[rfreplaceall]);
  Result:=StringReplace(Result,'</i>','[/i]',[rfreplaceall]);
  Result:=StringReplace(Result,'<b>','[b]',[rfreplaceall]);
  Result:=StringReplace(Result,'</b>','[/b]',[rfreplaceall]);
  Temp:='';
  ST:=0;
 { while True do
  begin
    P:=Pos('<span style="font-size:10px;">', Result);
    if P = 0 then Break;
    SS:=Copy(Result, ST, P-1)+'[size=10]';
    Temp:=Temp+SS;
    ST:=P+Length('<span style="font-size:10px;">');
    Result:=Copy(Result, ST, MaxInt);
    P:=Pos('</span>', Result);
    if P > 0 then
    begin
      SS:=Copy(Result, 1, P-1)+'[/size]';
      Temp:=Temp+SS;
      ST:=P+Length('</span>');
      SS:=Copy(Result,ST, MaxInt);
      Temp:=Temp+SS;
      Result:=Temp;
    end;
  end;   }

  Result:=ReplaceHTMLSpec('<span style="color:white;">','</span>','[color=white]','[/color]');
  Result:=ReplaceHTMLSpec('<span style="color:red;">','</span>','[color=red]','[/color]');
  Result:=ReplaceHTMLSpec('<span style="color:blue;">','</span>','[color=blue]','[/color]');
  Result:=ReplaceHTMLSpec('<span style="color:green;">','</span>','[color=green]','[/color]');
  Result:=ReplaceHTMLSpec('<pre><code class="">','</code></pre>','[code]','[/code]');
  Result:=ReplaceHTMLSpec('<span style="font-size:10px;">','</span>','[size=10]','[/size]');
  Result:=ReplaceHTMLSpec('<span style="font-size:15px;">','</span>','[size=15]','[/size]');
  Result:=ReplaceHTMLSpec('<span style="font-size:20px;">','</span>','[size=20]','[/size]');
  Result:=ReplaceHTMLSpec('<span style="text-decoration:underline;">','</span>','[u]','[/u]');
  Result:=ReplaceHTMLSpec('<span style="text-decoration:line-through;">','</span>','[s]','[/s]');
  Result:=ReplaceHTMLSpec('<span style="text-decoration:blink;">','</span>','[blink]','[/blink]');
end;

Пахнет селёдкой. Ой блять, забыл подмыться.

Support, 16 Октября 2021

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

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

+1

1
2
3

Ой, девачьки, я 5 лет не заходило. Почему нет говнокодов на Дульфи? Я десять страниц промотал! Неужели все дульфисты впали 
в старческий маразм и не могут больше срать на этом недоязыке? Почему? Он же изначально создавался для даунов.
Что стало с Тарасом? Что стало с поняшей-ассемблеристом?

Только одфаги меня вспомнят.

DelphiGovno, 28 Сентября 2021

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

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

+4

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

#!/usr/bin/env instantfpc

program PrintCharTable;

const
	space = ' '; { }
	point = '.'; {.}
	caret = '^'; {^}
	vline = '|'; {│}
	hline = '-'; {─}
	cross = '+'; {┼}
	hex_0 = ord('0');
	hex_a = ord('A')-10;

function tohex(d: integer): char;
begin
	if d < 10 then
		tohex := chr(d+hex_0)
	else
		tohex := chr(d+hex_a)
end;

var
	i, j: integer;
	code: integer;

begin
	write(space, space, vline);
	for i := 0 to 15 do
		write(space, point, tohex(i));
	writeln;

	write(hline, hline, cross);
	for i := 0 to 15 do
		write(hline, hline, hline);
	writeln;
	
	for i := 0 to 15 do begin
		write(tohex(i), point, vline);
		for j := 0 to 15 do begin
			code := i * 16 + j;
			if code < 32 then
				write(space, caret, chr(code+64))
			else if code = 127 then
				write(space, caret, chr(code-64))
			else
				write(space, space, chr(code))
		end;
		writeln
	end
end.

{
$ ./print_ascii.pas | iconv -f koi8-r
  | .0 .1 .2 .3 .4 .5 .6 .7 .8 .9 .A .B .C .D .E .F
--+------------------------------------------------
0.| ^@ ^A ^B ^C ^D ^E ^F ^G ^H ^I ^J ^K ^L ^M ^N ^O
1.| ^P ^Q ^R ^S ^T ^U ^V ^W ^X ^Y ^Z ^[ ^\ ^] ^^ ^_
2.|     !  "  #  $  %  &  '  (  )  *  +  ,  -  .  /
3.|  0  1  2  3  4  5  6  7  8  9  :  ;  <  =  >  ?
4.|  @  A  B  C  D  E  F  G  H  I  J  K  L  M  N  O
5.|  P  Q  R  S  T  U  V  W  X  Y  Z  [  \  ]  ^  _
6.|  `  a  b  c  d  e  f  g  h  i  j  k  l  m  n  o
7.|  p  q  r  s  t  u  v  w  x  y  z  {  |  }  ~ ^?
8.|  ─  │  ┌  ┐  └  ┘  ├  ┤  ┬  ┴  ┼  ▀  ▄  █  ▌  ▐
9.|  ░  ▒  ▓  ⌠  ■  ∙  √  ≈  ≤  ≥     ⌡  °  ²  ·  ÷
A.|  ═  ║  ╒  ё  ╓  ╔  ╕  ╖  ╗  ╘  ╙  ╚  ╛  ╜  ╝  ╞
B.|  ╟  ╠  ╡  Ё  ╢  ╣  ╤  ╥  ╦  ╧  ╨  ╩  ╪  ╫  ╬  ©
C.|  ю  а  б  ц  д  е  ф  г  х  и  й  к  л  м  н  о
D.|  п  я  р  с  т  у  ж  в  ь  ы  з  ш  э  щ  ч  ъ
E.|  Ю  А  Б  Ц  Д  Е  Ф  Г  Х  И  Й  К  Л  М  Н  О
F.|  П  Я  Р  С  Т  У  Ж  В  Ь  Ы  З  Ш  Э  Щ  Ч  Ъ
}

Печатает таблицу нужной кодировки. Пример использования в комменте после end.

Threadwalker, 20 Июля 2021

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

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

+1

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

program square;

var sep, input: string;
  i, j, n, m : integer;
  

begin
  write('sep:');
  readln(sep);
  
  write('str:');
  readln(input);
  
  for i:=1 to length(input) do write(input[i], ' ');
  writeln();
  for i:=2 to length(input)-1 do begin
    write(input[i]);
    for j:=1 to length(input)*2-3 do write (sep);
    writeln(input[length(input) - i + 1]);
  end;
  for i:=0 to length(input)-1 do 
    write(input[length(input)-i], ' ');
end.

Написала на скучной лекции программку на телефоне, чтобы распечатывать

Х У Й

У   У

Й У Х

и прочие интересности UwU

Пользуйтесь на здоровье, лицензия GNU GPL V3!

KoWe4Ka_l7porpaMMep, 28 Марта 2021

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

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

0

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

type
.....
TSyncParamsPasser = class
   PassedJSON:String;
   constructor Create(RJS:String);
   procedure ProcessExternalCmd;
  end;
.....
.....
procedure TForm1.TCPServerExecute(AContext: TIdContext);
begin
.....
   SyncParamsPasser:=TSyncParamsPasser.Create(CustomData);
   TIdSync.SynchronizeMethod(SyncParamsPasser.ProcessExternalCmd);
   FreeAndNil(SyncParamsPasser);
.....
end;
.....
constructor TSyncParamsPasser.Create(RJS:String);
begin
 PassedJSON:=RJS;
end;

procedure TSyncParamsPasser.ProcessExternalCmd;
var
 JSON:TJSONObject;
begin
 JSON:=TJSONObject.ParseJSONValue(PassedJSON) as TJSONObject;
.....

Событие OnExecute компонента TCPServer вызывается из рабочего потока, в котором обрабатывается входящее подключение.

Способ передачи параметров в процедуру, выполняющуюся внутри Synchronize, с помощью класса.
Говно или сойдёт?

SmseR, 16 Марта 2021

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

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

−2

1
2
3
4
5

procedure ProgramRestart(Sender: TObject);
begin
   Application.Terminate;
   ShellExecute(0,'open',Application.ExeName,'','',SW_NORMAL); // ))
end;

Неделю когда-то пытался понять почему этот код не работает: "Я же программу вырубил? - вырубил... Я же ее запускаю? - запускаю... А че она не запускается?)))..."

vovka3003, 13 Января 2021

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

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

−1

1
2
3
4
5

// добавляем новые ссылки
  for i := 0 to ATags.Count - 1 do
  begin
    // так мне кажется лучше
    Application.ProcessMessages;

кому или чему лучше кроме тебя, автор ?

xoodoo, 15 Октября 2020

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

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

0

001
002
003
004
005
006
007
008
009
010
011
012
013
014
015
016
017
018
019
020
021
022
023
024
025
026
027
028
029
030
031
032
033
034
035
036
037
038
039
040
041
042
043
044
045
046
047
048
049
050
051
052
053
054
055
056
057
058
059
060
061
062
063
064
065
066
067
068
069
070
071
072
073
074
075
076
077
078
079
080
081
082
083
084
085
086
087
088
089
090
091
092
093
094
095
096
097
098
099
100

procedure TWorker.handleAdminClient(socket: TTCPBlockSocket; json: ISuperObject);
var
  msg: ansistring;
  request: SOString;
  //s: ISuperObject;
  res: ISuperObject;
begin
  res := json['data'];
  msg := json['func'].AsString;

  if msg = 'deletemarket' then
     begin
       database.deleteMarket(res.GetS('id'));
       msg:='getmarkets';
     end;
  if msg = 'addmarket' then
     begin
      database.addMarket(res.GetS('mapid'),res.GetS('name'),res.GetS('type_id'));
      msg:='getmarkets';
     end;
  if msg = 'setmarketitems' then
     begin
        database.setMarktItems(res.GetS('id'),res.GetA('items'));
        TSocketSender.sendStr(socket, '{"type":"' + msg + '","data":{"id":' + res.GetS('id') + '}}');
        exit;
     end;
  if msg = 'updatemarket' then
     begin
        database.updateMarkt(res.GetS('id'),res.GetS('name'),res.GetS('enabled'));
        TSocketSender.sendStr(socket, '{"type":"' + msg + '","data":{"id":' + res.GetS('id') + '}}');
        exit;
     end;
  if msg = 'getmarktitems' then
     begin
       request := database.getMarktItems(res.GetS('id'));
       TSocketSender.sendStr(socket, '{ "type" : "' + msg + '" , "data" : ' + request + '}');
       exit;
     end;

  if msg = 'getmarkets' then
     begin
       request := database.getMarkets();
       TSocketSender.sendStr(socket, '{ "type" : "' + msg + '" , "data" : ' + request + '}');
       exit;
     end;

  if msg = 'getmarkettypes' then
     begin
       request := database.getMarketTypes();
       TSocketSender.sendStr(socket, '{ "type" : "' + msg + '" , "data" : ' + request + '}');
       exit;
     end;
  if msg = 'getitems' then
  begin
    request := database.getAdminItems();
    TSocketSender.sendStr(socket, '{ "type" : "' + msg + '" , "data" : ' + request + '}');
    exit;
  end;
  if msg = 'getitemstypes' then
  begin
    request := database.getAdminItemsTypes();
    TSocketSender.sendStr(socket, '{ "type" : "' + msg + '" , "data" : ' + request + '}');
    exit;
  end;
  if msg = 'getitem' then
  begin
    request := database.getItem(res['itemid'].AsInteger).getJSON.AsString;
    TSocketSender.sendStr(socket, '{ "type" : "' + msg + '" , "data" : ' + request + '}');
    exit;
  end;
  if msg = 'additem' then
  begin
    request := database.addItem(res);
    TSocketSender.sendStr(socket, '{ "type" : "' + msg + '" , "data" : ' + request + '}');
    exit;
  end;
  if msg = 'setitem' then
  begin
    database.setItem(res);
    exit;
  end;
  if msg = 'getavatar' then
  begin
    getAvatar(socket);
    exit;
  end;
  if msg = 'acceptavatar' then
  begin
    acceptAvatar(res);
    exit;
  end;
  if msg = 'declineavatar' then
  begin
    declineAvatar(res);
    exit;
  end;
  if msg = 'admindata' then
  begin
    sendAdminData(socket);
    exit;

Ужаснитесь.

Cynicrus, 03 Июля 2020