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

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

+110

1
2
3
4
5
6
7
8

DirName:=OpenDialog1.FileName;
    i:=Length(Dirname);
    While (i>0) and(Dirname[i]<>'\') do
    begin
      i:=i-1;
    end;
    If Dirname[i]='\' then Dirname:=Copy(Dirname,1,i-1);
    Edit1.Text:=DirName;

Для определения директории, выбирается в ней файл, абсолютный путь к которому вырезается до первого найденного слеша

replay, 10 Апреля 2011

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

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

+146

1
2

Говно код
form1.open

суперский код правда не работает

megaruliz, 07 Апреля 2011

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

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

+105

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

function TForm1.CheckGameO: String;
begin
 Result := '';
 If (A1.Tag = 2) and (A2.Tag = 2) then
  Begin
   Result := 'A3';
   If not CheckPos(Result) then Exit;
  End;

 If (A1.Tag = 2) and (A3.Tag = 2) then
  Begin
   Result := 'A2';
   If not CheckPos(Result) then Exit;
  End;

 If (A1.Tag = 2) and (C3.Tag = 2) then
  Begin
   Result := 'B2';
   If not CheckPos(Result) then Exit;
  End;

 If (A1.Tag = 2) and (B2.Tag = 2) then
  Begin
   Result := 'C3';
  If not CheckPos(Result) then Exit;
  End;

 If (A1.Tag = 2) and (B1.Tag = 2) then
  Begin
   Result := 'C1';
   If not CheckPos(Result) then Exit;
  End;

 If (A1.Tag = 2) and (C1.Tag = 2) then
  Begin
   Result := 'B1';
   If not CheckPos(Result) then Exit;
  End;

 If (B2.Tag = 2) and (C3.Tag = 2) then
  Begin
   Result := 'A1';
   If not CheckPos(Result) then Exit;
  End;

 If (B2.Tag = 2) and (A2.Tag = 2) then
  Begin
   Result := 'C2';
   If not CheckPos(Result) then Exit;
  End;

 If (B2.Tag = 2) and (C2.Tag = 2) then
  Begin
   Result := 'A2';
   If not CheckPos(Result) then Exit;
  End;

 If (B2.Tag = 2) and (C1.Tag = 2) then
  Begin
   Result := 'A3';
   If not CheckPos(Result) then Exit;
  End;

 If (B2.Tag = 2) and (A3.Tag = 2) then
  Begin
   Result := 'C1';
   If not CheckPos(Result) then Exit;
  End;

 If (B2.Tag = 2) and (B1.Tag = 2) then
  Begin
   Result := 'B3';
   If not CheckPos(Result) then Exit;
  End;

 If (B2.Tag = 2) and (B3.Tag = 2) then
  Begin
   Result := 'B1';
   If not CheckPos(Result) then Exit;
  End;

 If (C3.Tag = 2) and (A3.Tag = 2) then
  Begin
   Result := 'B3';
   If not CheckPos(Result) then Exit;
  End;

 If (C3.Tag = 2) and (B3.Tag = 2) then
  Begin
   Result := 'A3';
   If not CheckPos(Result) then Exit;
  End;

 If (C3.Tag = 2) and (C2.Tag = 2) then
  Begin
   Result := 'C1';
   If not CheckPos(Result) then Exit;
  End;

...

Кто угадает для чего это предназначалось получит печенье.

Govnocoder#0xFF, 06 Апреля 2011

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

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

+99

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

begin
  repeat
    if WSAStartup($101, Data) = SOCKET_ERROR then begin
      Writeln('Ошибка в WSAStrtup ' , WSAGetLastError);
      Break;
    end;

    repeat
      SetLength(Name, 256);
      if GetHostName(@Name[1], 256) = SOCKET_ERROR then begin
        WriteLn('Ошибка в GetHostName ', WSAGetLastError);
        Break;
      end;

      HE := GetHostByName(@Name[1]);
      if HE = nil then begin
        WriteLn('Ошибка в GetHostByName ', WSAGetLastError);
        Break;
      end;

      Write('Your inner IP:     ');
      WriteLn(inet_ntoa(PInAddr(HE.h_addr_list^)^));

      Write('Your inner name:   ');
      WriteLn(HE.h_name);

      repeat
        MainSocket := Socket(AF_Inet,Sock_Stream,0);
        if MainSocket = SOCKET_ERROR then begin
          Writeln('Ошибка в Socket ' , WSAGetLastError);
          Break;
        end;
        //
        CloseSocket(MainSocket);
      until false;
    until false;
    WSACleanUp;
  until false;
end.

Код, проверяющий все ошибки - он такой, да?

TarasB, 06 Апреля 2011

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

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

+100

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

Procedure TForm1.Button1Click(Sender: TObject);
Const
  NormText : string = 'АБВГДЕЁЖЗЫИЙКЛМНОПРСТУФХЦЧШЩЬЪЭЮЯ ';
  ObeznogText : string = 'А6ВrДЕЁЖ3ЫNµКЛМН0ПРС†YФXЦ4ШЩЬЪЗЮR ';
Var
  sText, sBeznogText : String;
  i : Integer;
BEGIN
 sText := Memo1.Text;
 sText := AnsiUpperCase(sText);
 sBeznogText := '';
 For i := 1 to Length(sText) do
  Begin
   sBeznogText := sBeznogText + (Copy(ObeznogText, Pos(sText[i], NormText), 1));
   If sText[i] = ' ' then
    bEgin
     Randomize;
     Case Random(5) of
      1: begin
          sBeznogText := sBeznogText + 'ДОСМОТ? ';
         End;
      3: begin
          sBeznogText := sBeznogText + 'РYКN ';
         end;
      5: begin
          sBeznogText := sBeznogText + 'БЕЗНОГ? ';
         end;
     End;
    eNd;
  End;
 Memo1.Text := sBeznogText;
END;

Автоматическое обезноживание текста. Сплойлер: БЕ3НОГNМ

Govnocoder#0xFF, 03 Апреля 2011

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

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

+103

01
02
03
04
05
06
07
08
09
10

// Будет св. время - рефакторить данный кусок.
   typeArray[0] := (Char(Ord(Value[1])- 1)) + IntToStr(StrToInt(Value[2]) - 1);
   typeArray[1] := (Char(Ord(Value[1]) - 1)) + Value[2];
   typeArray[2] := (Char(Ord(Value[1]) - 1)) + IntToStr(StrToInt(Value[2]) + 1);
   typeArray[3] := Value[1] + IntToStr(StrToInt(Value[2]) - 1);
   typeArray[4] := Value[1] + IntToStr(StrToInt(Value[2]) + 1);
   typeArray[5] := (Char(Ord(Value[1]) + 1)) + IntToStr(StrToInt(Value[2]) - 1);
   typeArray[6] := (Char(Ord(Value[1]) + 1)) + Value[2];
   typeArray[7] := (Char(Ord(Value[1]) + 1)) + IntToStr(StrToInt(Value[2]) + 1);
//-------!!!!!!!-----------

Таки у погромистов тоже бывает полшестого!

Govnocoder#0xFF, 02 Апреля 2011

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

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

+90

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

Uses CRT;
const
     a=10;
     b=21;
     c=30;
Var
   max: integer;
Begin
     if (a>b) then
              if (a>c) then
                 begin
                   max:=a;
                 end
              else max:=c;
     if (b>a)then
             if (b>c)then
                      max:=b
             else
               max:=c;
Writeln(max);
if (max mod 5 = 0 ) then
   writeln ('Кратное')
else writeln('некратное');
   
End.

Juris_Kabanis, 30 Марта 2011

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

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

+91

1
2
3
4

procedure TForm.ButtoClick(Sender: TObject);{не вздумай нажимать на эту конопку, уебок!! тогда проект не будет падать!!}
begin
    {blah blah blah}
end;

нашел такой вот коммент в обработчике события 0_о

TheHamstertamer, 20 Марта 2011

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

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

+99

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

var
  i,c,b,f:integer;
  str:string;
procedure TForm1.codir;
begin
b:=1;
f:=1;
c:=length(edit1.Text);
str:=edit1.Text;
repeat
i:=ord(str[f]);
case i of
0:inc(i);
1:inc(i);
2:inc(i);
3:inc(i);
4:inc(i);
5:inc(i);
6:inc(i);
7:inc(i);
8:inc(i);
9:i:=0;
end;

Delete(str, b, 1);
Insert(inttostr(i),str,b);
inc(b);
inc(f);
until b=c;
edit2.Text:=str;
end;

bugmenot, 19 Марта 2011

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

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

+119

01
02
03
04
05
06
07
08
09
10
11

Function F1(z: Byte): Real;  {Функция возведения (-1) в степень "к"}

  Begin

    If z=1

      Then F1:=-1

      Else F1:=F1(z-1)*-1;

  End;

Нашел в лабораторной по вычмату 2-х годичной давности)

1_and_0, 15 Марта 2011