1. Pascal / Говнокод #23147

    0

    1. 01
    2. 02
    3. 03
    4. 04
    5. 05
    6. 06
    7. 07
    8. 08
    9. 09
    10. 10
    TServerThread = class(TThread)
      private
        procedure DoReadData;
      protected
        ThreadOwner: TIPCServer;
        procedure Execute; override;
        constructor Create(AThreadOwner: TIPCServer);
        destructor Destroy; override;
      public
      end;

    Мы кодили, кодили и наконец накодили!

    antipattern, 27 Июня 2017

    Комментарии (2)
  2. Pascal / Говнокод #23137

    0

    1. 01
    2. 02
    3. 03
    4. 04
    5. 05
    6. 06
    7. 07
    8. 08
    9. 09
    10. 10
    11. 11
    12. 12
    13. 13
    14. 14
    15. 15
    16. 16
    17. 17
    18. 18
    19. 19
    20. 20
    21. 21
    22. 22
    23. 23
    24. 24
    25. 25
    26. 26
    27. 27
    28. 28
    29. 29
    30. 30
    31. 31
    32. 32
    33. 33
    34. 34
    35. 35
    36. 36
    37. 37
    38. 38
    39. 39
    40. 40
    41. 41
    42. 42
    43. 43
    44. 44
    45. 45
    46. 46
    47. 47
    48. 48
    49. 49
    50. 50
    51. 51
    52. 52
    53. 53
    54. 54
    55. 55
    56. 56
    57. 57
    58. 58
    59. 59
    60. 60
    61. 61
    62. 62
    63. 63
    64. 64
    65. 65
    66. 66
    67. 67
    68. 68
    69. 69
    70. 70
    71. 71
    72. 72
    73. 73
    74. 74
    75. 75
    76. 76
    77. 77
    78. 78
    79. 79
    80. 80
    81. 81
    82. 82
    83. 83
    84. 84
    85. 85
    86. 86
    87. 87
    88. 88
    89. 89
    90. 90
    91. 91
    92. 92
    93. 93
    94. 94
    95. 95
    procedure TForm1.ProcListAdvancedCustomDrawItem(Sender: TCustomListView;
      Item: TListItem; State: TCustomDrawState; Stage: TCustomDrawStage;
      var DefaultDraw: Boolean);
    var
      TP:TprocessInfo;
      xColor: TColor;
      xRect: TRect;
      xBitmap: TBitmap;
      I, L, R: Integer;
    begin
      DefaultDraw:=False;
      TP:=TProcessInfo(Item.SubItems.Objects[0]);
      if (Item.Selected) then
      begin
        if Sender.Focused then
        begin
          if (FItemAtCursor <> -1) and (Item.Index = FItemAtCursor) then
            xColor:=clNavy
          else
            xColor:=$00C56A31;
        end
        else
          xColor:=$00D8E9EC
      end
      else
      begin
        if (TP.New<2) or (TP.Terminated<2) or (TP.Hidden) then
        begin
    
          if ShowDangerousProcesses then
          if TP.Hidden then
          xColor:=$00DBDBDB;
    
          if ShowNewProcesses then
          if TP.New <2 then
          xColor:=$001DEB2D;
    
          if ShowTerminatedProcesses then
          if TP.Terminated < 2 then
          xColor:=$001D2DEB;
        end
        else
    
        if (Item.Index mod 2 = 1) then
        xColor:=RGB(245,245,255)
        else
        xColor:=clWindow;
      end;
      Sender.Canvas.Brush.Color:=xColor;
      DefaultDraw:=True;
    
      if (Item.Selected) and Sender.Focused
      then Sender.Canvas.Font.Color:=clWindow
      else Sender.Canvas.Font.Color:=clWindowText;
      Sender.Canvas.FillRect(Item.DisplayRect(drLabel));
      DefaultDraw:=True;
    
      Exit; 
    
      xRect:=Item.DisplayRect(drLabel);
      Sender.Canvas.TextRect(xRect,xRect.Left+2,xRect.Top,Item.Caption);
    
      for I:=0 to TListView(Sender).Columns.Count-1 do
      begin
        if TListView(Sender).Columns[TListView(Sender).Columns[I].ID].Width<=0 then Continue;
        if (I=0) and (TListView(Sender).Columns[I].ID <> 0) then
        begin
          xRect.Left:=0;
          xRect.Right:=xRect.Left+TListView(Sender).Columns.Items[TListView(Sender).Columns[I].ID].Width-1;
          Sender.Canvas.FillRect(xRect);
          Sender.Canvas.TextRect(xRect,xRect.Left+2,xRect.Top,Item.SubItems[TListView(Sender).Columns[I].ID-1]);
        end
        else
        begin
        if I>0 then
        begin
          xRect.Left:=xRect.Right+1;
          xRect.Right:=xRect.Left+TListView(Sender).Columns.Items[TListView(Sender).Columns[I].ID].Width-1;
          Sender.Canvas.FillRect(xRect);
          if TListView(Sender).Columns[I].ID >0 then
          Sender.Canvas.TextRect(xRect,xRect.Left+5,xRect.Top,Item.SubItems[Pred(TListView(Sender).Columns[I].ID)])
          else
          begin
            L:=(Item.DisplayRect(drIcon).Right-Item.DisplayRect(drIcon).Left)+6;
          Sender.Canvas.TextRect(xRect,xRect.Left+L,xRect.Top, Item.Caption)
        end;
        end;
    
        end;
      end;
      Sender.Canvas.Brush.Color:=clWindow;
      Sender.Canvas.FillRect(Item.DisplayRect(drIcon));
      if Item.ImageIndex=-1 then Exit;
      xBitmap:=TBitmap.Create;
      TListView(Sender).SmallImages.GetBitmap(Item.ImageIndex,xBitmap);

    ListView - великий и ужасный! - в режиме OwnerDraw.
    Писал диспетчер процессов. Когда я разрешил прятать столбцы и включил свойство FullDrag, моя жизнь круто изменилась.

    antipattern, 19 Июня 2017

    Комментарии (3)
  3. Pascal / Говнокод #23106

    −1

    1. 1
    2. 2
    (багрепорт)
    http://www.alphaskins.com/forum/index.php?app=core&module=attach&section=attach&attach_rel_module=post&attach_id=8330Сергох Гончаров с AlphaSkins.com шалит )

    Сергох Гончаров с AlphaSkins.com шалит )

    antipattern, 06 Июня 2017

    Комментарии (0)
  4. Pascal / Говнокод #23100

    0

    1. 01
    2. 02
    3. 03
    4. 04
    5. 05
    6. 06
    7. 07
    8. 08
    9. 09
    10. 10
    11. 11
    12. 12
    13. 13
    14. 14
    15. 15
    16. 16
    17. 17
    18. 18
    19. 19
    20. 20
    21. 21
    22. 22
    23. 23
    24. 24
    25. 25
    26. 26
    27. 27
    28. 28
    29. 29
    30. 30
    31. 31
    32. 32
    33. 33
    34. 34
    35. 35
    36. 36
    37. 37
    38. 38
    39. 39
    40. 40
    41. 41
    42. 42
    43. 43
    44. 44
    function IsExecutablePacked(FileName: WideString): Boolean;
    var
    i: Cardinal;
    CompressionRatio: Double;
    Count: Cardinal;
    MathX: array [0 .. 255] of Integer;
    FileStream: TFileStream;
    Buffer: PAnsiChar;
    FileHandle: THandle;
    begin
    Result := False;
    try
    FileHandle := 0;
    FileHandle := CreateFileW(PWideChar(FileName), GENERIC_READ, FILE_SHARE_READ or FILE_SHARE_DELETE, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
    if (FileHandle <> 0) and FileExists(FileName) then
    begin
    try
    FileStream := TFileStream.Create(FileHandle);
    Count := FileStream.Seek(0, soFromEnd);
    try
    GetMem(Buffer, Count);
    FileStream.Seek(0, soFromBeginning);
    FileStream.Read(Buffer^, Count);
    CompressionRatio := 0;
    FillChar(MathX, Sizeof(MathX), 0);
    for i := 0 to Count - 1 do
    Inc(MathX[Windows.PByte(DWORD(Buffer) + (i))^]);
    for i := 0 to 255 do
    if MathX > 0 then
    CompressionRatio := CompressionRatio - Log2(MathX / Count) * MathX;
    finally
    FreeMem(Buffer, Count);
    end;
    CompressionRatio := (Count * 8) / CompressionRatio;
    CompressionRatio := 100 / CompressionRatio;
    if CompressionRatio > 97 then
    Result := True;
    finally
    FileStream.Free;
    end;
    end;
    finally
    end;
    end;

    "Ис Эксекутабле Пуцкед" - форматирование сохранено.

    antipattern, 04 Июня 2017

    Комментарии (0)
  5. Pascal / Говнокод #22991

    −1413

    1. 01
    2. 02
    3. 03
    4. 04
    5. 05
    6. 06
    7. 07
    8. 08
    9. 09
    10. 10
    11. 11
    12. 12
    13. 13
    14. 14
    15. 15
    16. 16
    17. 17
    18. 18
    19. 19
    20. 20
    21. 21
    22. 22
    23. 23
    24. 24
    25. 25
    26. 26
    27. 27
    28. 28
    29. 29
    30. 30
    31. 31
    32. 32
    33. 33
    34. 34
    35. 35
    36. 36
    37. 37
    38. 38
    39. 39
    function Unescape(const s: AnsiString): widestring;
    var
      i: Integer;
      j: Integer;
      c: Integer;
    begin
      // Make result at least large enough. This prevents too many reallocs
      SetLength(Result, Length(s));
      i := 1;
      j := 1;
      while i <= Length(s) do begin
        if s[i] = '\' then begin
          if i < Length(s) then begin
            // escaped backslash?
            if s[i + 1] = '\' then begin
              Result[j] := '\';
              inc(i, 2);
            end
            // convert hex number to WideChar
            else if (s[i + 1] = 'u') and (i + 1 + 4 <= Length(s))
                    and TryStrToInt('$' + string(Copy(s, i + 2, 4)), c) then begin
              inc(i, 6);
              Result[j] := WideChar(c);
            end else begin
              raise Exception.CreateFmt('Invalid code at position %d', [i]);
            end;
          end else begin
            raise Exception.Create('Unexpected end of string');
          end;
        end else begin
          Result[j] := WideChar(s[i]);
          inc(i);
        end;
        inc(j);
      end;
    
      // Trim result in case we reserved too much space
      SetLength(Result, j - 1);
    end;

    Это не вирус. Просто в Delphi 7 не завезли JSon.

    doctor_stertor, 07 Мая 2017

    Комментарии (21)
  6. Pascal / Говнокод #21288

    −77

    1. 1
    2. 2
    3. 3
    4. 4
    5. 5
    6. 6
    7. 7
    8. 8
    program LeakMem;
    
    uses sysutils;
    
    var
       str:string;
    
    ...

    В седьмой делфе утекает память.

    voodoodal16, 28 Сентября 2016

    Комментарии (92)
  7. Pascal / Говнокод #21129

    +8

    1. 01
    2. 02
    3. 03
    4. 04
    5. 05
    6. 06
    7. 07
    8. 08
    9. 09
    10. 10
    11. 11
    12. 12
    13. 13
    14. 14
    15. 15
    16. 16
    17. 17
    18. 18
    19. 19
    20. 20
    21. 21
    22. 22
    23. 23
    24. 24
    25. 25
    26. 26
    27. 27
    28. 28
    29. 29
    30. 30
    31. 31
    32. 32
    33. 33
    34. 34
    35. 35
    36. 36
    37. 37
    38. 38
    39. 39
    Program L_121;
    uses crt;
    Var N : integer;
    b,z : string;
    f1 : text;
    
    Begin
         assign(f1,'Единица измерения.txt');
         writeln('1 Соотношение конкретной единицы измерения длины');
         writeln('2 Соотношение единиц измерения длины');
         writeln('3 Обозначение единиц измерения длины');
         writeln('4 Назначение единиц измерения длины');
         read(N);clrscr;
         reset(f1);
         case N of
         
         1:begin
                write('Введите единицу измерения : ');
                read(b);clrscr;
                readln(f1,z);writeln(z);
                if b='миллиметр' then begin readln(f1,z);writeln(z); end;
                if b='сантиметр' then begin readln(f1,z);readln(f1,z);writeln(z); end;
                if b='дециметр'  then begin readln(f1,z);readln(f1,z);readln(f1,z);writeln(z);end;
                if b='метр'      then begin readln(f1,z);readln(f1,z);readln(f1,z);readln(f1,z);writeln(z);end;
                if b='километр'  then begin readln(f1,z);readln(f1,z);readln(f1,z);readln(f1,z);readln(f1,z);writeln(z); end;
           end;
         2:begin
                readln(f1,z);writeln(z);readln(f1,z);writeln(z);readln(f1,z);writeln(z);readln(f1,z);writeln(z);readln(f1,z);writeln(z);
           end;
         3:begin
                readln(f1,z);readln(f1,z);readln(f1,z);readln(f1,z);readln(f1,z);readln(f1,z);readln(f1,z);readln(f1,z);
                writeln(z);readln(f1,z);writeln(z);readln(f1,z);writeln(z);readln(f1,z);writeln(z);readln(f1,z);writeln(z);
           end;
         4:begin
                readln(f1,z);readln(f1,z);readln(f1,z);readln(f1,z);readln(f1,z);readln(f1,z);readln(f1,z);readln(f1,z);readln(f1,z);readln(f1,z);readln(f1,z);readln(f1,z);
                readln(f1,z);readln(f1,z);writeln(z);readln(f1,z);writeln(z);readln(f1,z);writeln(z);readln(f1,z);writeln(z);readln(f1,z);writeln(z);
           end;
         end;
    End.

    4 года назад я так писал код)

    Genome, 07 Сентября 2016

    Комментарии (20)
  8. Pascal / Говнокод #20875

    +1870

    1. 01
    2. 02
    3. 03
    4. 04
    5. 05
    6. 06
    7. 07
    8. 08
    9. 09
    10. 10
    11. 11
    12. 12
    13. 13
    14. 14
    15. 15
    16. 16
    17. 17
    18. 18
    19. 19
    20. 20
    21. 21
    22. 22
    23. 23
    24. 24
    25. 25
    26. 26
    function translate_a_name_of_the_winter_to_the_foreign_language(language: String): String;
      begin
        if      language = 'авестийский'    Result := 'zimō'
        else if language = 'белорусский'    Result := 'зіма'
        else if language = 'болгарский'     Result := 'зима'
        else if language = 'верхнелужицкий' Result := 'zyma'
        else if language = 'греческий'      Result := 'χειμώνας'
        else if language = 'древнепрусский' Result := 'semo'
        else if language = 'латинский'      Result := 'hiems'
        else if language = 'латышский'      Result := 'ziema'
        else if language = 'литовский'      Result := 'žiema'
        else if language = 'македонский'    Result := 'зима'
        else if language = 'нижнелужицкий'  Result := 'zyma'
        else if language = 'осетинский'     Result := 'зымӕг'
        else if language = 'польский'       Result := 'zima'
        else if language = 'русский'        Result := 'зима'
        else if language = 'санскрит'       Result := 'hima'
        else if language = 'сербский'       Result := 'зима'
        else if language = 'словацкий'      Result := 'zima'
        else if language = 'словенский'     Result := 'zima'
        else if language = 'талышский'      Result := 'зымыстон'
        else if language = 'таджикский'     Result := 'зимистон'
        else if language = 'украинский'     Result := 'зима'
        else if language = 'хорватский'     Result := 'zima'
        else if language = 'чешский'        Result := 'zima'
      end;

    Из одного очень серьёзного проекта.

    Amayak_Akopyan, 20 Августа 2016

    Комментарии (64)
  9. Pascal / Говнокод #18814

    +2

    1. 1
    2. 2
    3. 3
    4. 4
    5. 5
    6. 6
    7. 7
    8. 8
    9. 9
    case ((((parametr[3, 1] - parametr[1, 1]) / parametr[4, 2] = (parametr[3, 2] - parametr[1, 2]) / parametr[4, 2]) and ((parametr[3, 2] - parametr[1, 2]) / parametr[4, 2] = (parametr[3, 3] - parametr[1, 3]) / parametr[4, 3])) xor           
                ((parametr[4, 1] = 0) and (parametr[1, 1] = parametr[2, 1]) and (parametr[2, 1] = parametr[3, 1]) and ((parametr[3, 2] - parametr[1, 2]) / parametr[4, 2] = (parametr[3, 3] - parametr[1, 3]) / parametr[4, 3])) xor          
                 ((parametr[4, 2] = 0) and (parametr[1, 2] = parametr[2, 2]) and (parametr[2, 2] = parametr[3, 2]) and ((parametr[3, 1] - parametr[1, 1]) / parametr[4, 1] = (parametr[3, 3] - parametr[1, 3]) / parametr[4, 3])) xor                           
                    ((parametr[4, 3] = 0) and (parametr[1, 3] = parametr[2, 3]) and (parametr[2, 3] = parametr[3, 3]) and ((parametr[3, 1] - parametr[1, 1]) / parametr[4, 1] = (parametr[3, 2] - parametr[1, 2]) / parametr[4, 2])) xor             
                       ((parametr[4, 3] <> 0) and (parametr[4, 1] = 0) and (parametr[4, 2] = 0) and (parametr[3, 1] = parametr[2, 1]) and (parametr[3, 2] = parametr[2, 2])) xor                    
                          ((parametr[4, 2] <> 0) and (parametr[4, 1] = 0) and (parametr[4, 3] = 0) and (parametr[3, 1] = parametr[2, 1]) and (parametr[3, 3] = parametr[2, 3])) xor                       
                             ((parametr[4, 1] <> 0) and (parametr[4, 2] = 0) and (parametr[4, 3] = 0) and (parametr[3, 2] = parametr[2, 2]) and (parametr[3, 3] = parametr[2, 3])) xor                         
                                ((parametr[4, 1] = 0) and (parametr[4, 2] = 0) and (parametr[4, 3] = 0))) of true:
             writeln('Все точки лежат на одной прямой. Такой треугольник не существует.');

    Проверка треугольника в декартовой системе координат

    Meliodas, 04 Октября 2015

    Комментарии (10)
  10. Pascal / Говнокод #18756

    +5

    1. 1
    Commission:= Commission/100*StrToInt(Label8.Caption); //Вычисление комиссии

    Терминальщики :|

    Dego1n, 23 Сентября 2015

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