Нашли или выдавили из себя код, который нельзя назвать нормальным, на который без улыбки не взглянешь? Не торопитесь его удалять или рефакторить, — запостите его на говнокод.ру, посмеёмся вместе!
+123
Судя по Вашим оценкам, образцы моего кода не так у ж и плохи. Это радует; но в таком случае, получается, что я ошибся форумом.
Если это действительно так, я спешу сменить амплуа г.кодера.
Непонаслышке зная, что бан тут получить практически нереально, я все таки сделаю отчаянную попытку:
Логин: [email protected]
Пароль: gcode116
Я желаю Вам всего самого наилучшего. С Вами было весело.
За сим, остаюсь, ваш Stertor. Списаться со мной можно по вышеуказанному адресу.
Stertor,
24 Июня 2013
+127
function GetBiosNumber: string;
begin
result := string(pchar(ptr($FEC71)));
end;Windows NT поддерживает прерывания!!! А Вы знали?
Stertor,
23 Июня 2013
+128
// используемые переменные
var
Dummy: integer = 0;
OldKbHook: HHook = 0;
implementation
function KbHook(code: Integer; wparam: Word; lparam: LongInt): LongInt; stdcall;
begin
if code < 0 then
Result := CallNextHookEx(oldKbHook, code, wparam, lparam)
else
Result := 1;
end;
// включение клавы
procedure TForm1.KeyBoardOn(Sender: TObject);
begin
if OldKbHook <> 0 then
begin
UnHookWindowshookEx(OldKbHook);
OldKbHook := 0;
end;
SystemParametersInfo(SPI_SETFASTTASKSWITCH, 0, 0, 0);
SystemParametersInfo(SPI_SCREENSAVERRUNNING, 0, 0, 0);
end;
// выключение клавы
procedure TForm1.KeyBoardOff(Sender: TObject);
begin
SystemParametersInfo(SPI_SETFASTTASKSWITCH, 1, @Dummy, 0);
SystemParametersInfo(SPI_SCREENSAVERRUNNING, 1, @Dummy, 0);
OldKbHook := SetWindowsHookEx(WH_KEYBOARD, @KbHook, HInstance, 0);
end;Попытка вырубить клаву, сев на нее.
Stertor,
23 Июня 2013
+127
Function DiskInDrive(ADriveLetter : Char) : Boolean;
var
SectorsPerCluster,
BytesPerSector,
NumberOfFreeClusters,
TotalNumberOfClusters : Cardinal;
begin
Result := GetDiskFreeSpace(PChar(ADriveLetter+':\'),
SectorsPerCluster,
BytesPerSector,
NumberOfFreeClusters,
TotalNumberOfClusters);
end;
// еще один шедевр:
var
SR : TSearchRec;
Res : integer;
OldErrMode : integer;
begin
// Запоминаем текущий режим обработки ошибок и устанавливаем SEM_FAILCRITICALERRORS
// Это необходимо для подавления появления окна с сообщение о том, что устройство не готово
OldErrMode = SetErrorMode(SEM_FAILCRITICALERRORS);
try
Res := FindFirst('a:\*.*', faAnyfile, SR);
FindClose(SR);
finally
SetErrorMode(OldErrMode)
end;
end;
С помощью этих процедур Олежик Зайцев на своем сайте предлагает определять доступность дисков, минуя сообщение WINDOWS "Диск не готов".
Без комментариев.
Stertor,
23 Июня 2013
+130
procedure TMyTr.Execute; // метод потока; эта процедура выполняется в отдельном потоке.
var
s,resp,ip,port:string;
cw,i:integer;
begin
http:=TIdHTTP.Create(nil);
cw:=getnumberproxy;
while cw<form1.Memo1.Lines.Count do
begin
s:=form1.Memo1.Lines[cw];
i := Pos(':',s);
IP := Copy(s,1,i-1);
PORT := Copy(s,i+1,Length(s));
try
http.ProxyParams.ProxyServer:=ip;
http.ProxyParams.ProxyPort:=StrToInt(port);
http.ReadTimeout:=Form1.SpinEdit2.Value*1000;
resp:=http.Get('http://ya.ru/');
if pos('ya.ru',resp)<>0 then
form1.Memo2.Lines.Add(ip+':'+port);
except
end;
cw:=getnumberproxy;
checked:=checked+1;
end;
http.Free;
end;Вот так живут Америка с Европой; что интересно, ни поток ни форма ни разу не заглючили.
Stertor,
23 Июня 2013
+129
function stringreplaceall(text, byt, mot: string): string;
var
plats: integer;
begin
while pos(byt, text) > 0 do
begin
plats := pos(byt, text);
delete(text, plats, Length(byt));
insert(mot, text, plats);
end;
Result := text;
end;Найди десять отличий с родной дельфийской StringReplace. (trollface)
Stertor,
23 Июня 2013
+107
function FindPathInPath(path1: string; path2: string): Boolean;
var
lst: TStringlist;
i, l: integer;
begin
lst := TStringlist.Create;
// ----------------------------------------------
path1 := stringreplaceall(path1, '/', '\');
path1 := stringreplaceall(path1, '\\', '\');
// ----------------------------------------------
path2 := stringreplaceall(path2, '\', '');
path2 := stringreplaceall(path2, '/', '');
path2 := stringreplaceall(path2, '"', '');
path2 := stringreplaceall(path2, '<', '');
path2 := stringreplaceall(path2, '>', '');
path2 := stringreplaceall(path2, '?', '');
path2 := stringreplaceall(path2, '|', '');
path2 := stringreplaceall(path2, ':', '');
path2 := stringreplaceall(path2, '*', '');
// ----------------------------------------------
for i := 2 to CountString(path1, '\') + 1 do
begin
lst.Add(StringField(path1, '\', i));
end;
for l := 0 to lst.Count - 1 do
begin
if lstrcmpi(pchar(lst[l]), pchar(path2)) = 0 then
begin
FindPathInPath := True;
break;
end;
end;
lst.Free;
FindPathInPath := false;
exit;
end;
Функция для поиска названий подпапок в файловых путях.
Трудно судить г..нокод ли это, но так как я все же использовал более изящное решение, то быть посему...
Stertor,
23 Июня 2013
+132
var
FormMeh: TFormMeh;
x,y,len:integer;
x2,y2:integer;
x3,y3:integer;
x0,y0, y20:integer;
xa , ya : integer;
v1 , v2 : integer;
x1,y1,ar,dar:integer;
anim:integer;Глобальные переменные отныне РАЗРЕШЕНЫ. Утверждаю, подпись моя.
Stertor,
23 Июня 2013
+76
function IPP (var i: integer): integer;
begin
Result := i;
Inc(i);
end;
TarasB,
21 Июня 2013
+99
Я в 2006 году учился работать на Дельфи.
var
Form1: TForm1; f:file of byte; rb,re:array[0..6,0..10] of byte;
rb1,re1:array[1..6] of byte;h:shortint;go:boolean;
tm:array[0..6,0..1,0..10] of record
h,m:byte;
end;
...
procedure prnt1;
var t:string;
begin
{Вывод времени уроков и перемен на форму. Начало 0,1. 11 уроков 2-23}
str(rb1[h],t);
form1.edit1.text:=t;
str(re1[h],t);
form1.edit2.text:=t;
str(rb[h,0],t);
form1.edit3.text:=t;
str(re[h,0],t);
form1.edit4.text:=t;
str(rb[h,1],t);
form1.edit5.text:=t;
...
form1.edit21.text:=t;
str(re[h,9],t);
form1.edit22.text:=t;
str(rb[h,10],t);
form1.edit23.text:=t;
end;
...
procedure prnt2;
var t1,t2,t3,t4:string;a1,a2,b1,b2,c,d:integer;
begin
{Вывод списка уроков из текстового файла на форму}
val(form1.edit1.text,a1,c);
val(form1.edit2.text,a2,c);
rb1[h]:=a1;
re1[h]:=a2;
{1 урок}
b1:=a1;
b2:=a2;
val(form1.edit3.text,d,c);
rb[h,0]:=d;
b2:=b2+d;
if b2>=60 then
begin
b1:=b1+1;
b2:=b2-60;
end;
str(a1,t1);
str(a2,t2);
if a2<10 then t2:='0'+t2;
str(b1,t3);
str(b2,t4);
if b2<10 then t4:='0'+t4;
tm[h,0,0].h:=a1;
tm[h,0,0].m:=a2;
tm[h,1,0].h:=b1;
tm[h,1,0].m:=b2;
form1.label15.Caption:=t1+':'+t2+' - '+t3+':'+t4;
val(form1.edit4.text,d,c);
re[h,0]:=d;
b2:=b2+d;
if b2>=60 then
begin
b1:=b1+1;
b2:=b2-60;
end;
{2 урок}
a1:=b1;
a2:=b2;
val(form1.edit5.text,d,c);
rb[h,1]:=d;
b2:=b2+d;
if b2>=60 then
begin
b1:=b1+1;
b2:=b2-60;
end;
str(a1,t1);
str(a2,t2);
и т.д. (так 11 уроков и перемен по 30 строк)
{Сохранение в базу данных под названием zvonok.ini :-) }
val(form1.edit1.text,rb1[h],d);
val(form1.edit2.text,re1[h],d);
val(form1.edit3.text,rb[h,0],d);
val(form1.edit4.text,re[h,0],d);
val(form1.edit5.text,rb[h,1],d);
val(form1.edit6.text,re[h,1],d);
val(form1.edit7.text,rb[h,2],d);
val(form1.edit8.text,re[h,2],d);
val(form1.edit9.text,rb[h,3],d);
val(form1.edit10.text,re[h,3],d);
и так до 11-го урокаПрограмма для подачи сигналов секретарю, что пора дать звонок на урок или на перемену.
sbs,
12 Июня 2013
Follow us!