Нашли или выдавили из себя код, который нельзя назвать нормальным, на который без улыбки не взглянешь? Не торопитесь его удалять или рефакторить, — запостите его на говнокод.ру, посмеёмся вместе!
Всего: 162
+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
+141
function GetProcessUser(aPID: Cardinal; var aResult: string): Boolean;
type
PTOKEN_USER = ^TOKEN_USER;
_TOKEN_USER = record
User: TSidAndAttributes;
end;
TOKEN_USER = _TOKEN_USER;
var
cbBuf: Cardinal;
ptiUser: PTOKEN_USER;
snu: SID_NAME_USE;
hToken, hProcess: THandle;
UserSize, DomainSize: Cardinal;
bSuccess: Boolean;
sUser, sDomain: string;
begin
Result := False;
hProcess := OpenProcess(PROCESS_QUERY_INFORMATION, False, aPID);
if hProcess <> 0 then
begin
if OpenProcessToken(hProcess, TOKEN_QUERY, hToken) then
begin
bSuccess := GetTokenInformation(hToken, TokenUser, nil, 0, cbBuf);
ptiUser := nil;
while (not bSuccess) and (GetLastError = ERROR_INSUFFICIENT_BUFFER) do
begin
ReallocMem(ptiUser, cbBuf);
bSuccess := GetTokenInformation(hToken, TokenUser, ptiUser, cbBuf, cbBuf);
end;
CloseHandle(hToken);
if not bSuccess then
Убило название. Дальше можете не читать.
http://www.programmersforum.ru/showthread.php?t=242541
Stertor,
23 Августа 2013
+134
procedure TForm1.BitBtn1Click(Sender: TObject);
var
MText ,temp: string;
memorystream:tmemorystream;
link:string;
i:integer;
startpos,endpos:integer;
stag,etag:string;
c:integer;
begin
stop:=false;
try
memorystream:=tmemorystream.create;
stag:='target="_blank" href="#url?to=';
memorystream.clear;
try
idhttp1.Get('http://otvet.mail.ru/93516',memorystream);
except
end;
if idhttp1.connected=true then
idhttp1.Disconnect;
mtext:=memo1.text;//memorystreamtostring(memorystream);
memo1.lines.add(mtext);
// Выдает access violation
StartPos := 0;
endpos:=0;
while (true) do
begin
startPos := Posex(stag, MText,startpos+1);
endPos := PosEx(etag, MText, startPos);
if startpos>0 then
begin
temp := Copy(MText, startPos, endPos - startPos);
Memo2.lines.add(temp);
end
else
break;
end;
finally
end;
end;
Вонь стоит жуткая. Тому, кто первым найдет ошибку, поставлю пятерку)
Ы.з. Это мой сотый код, так что теперь я на все 100% с Вами) обнимаю вас всех.
Stertor,
23 Августа 2013
+130
Народ, вы где? Я реально соскучился.
Stertor,
22 Августа 2013
+87
*-*-*-*-*-*-*-*-*-*-*-*-*-*-зашифрованные прокси:*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
<TD id="address">
<script language=javascript>
<!--
proxy(3,'28','70','216','172',80);
proxy(4,'70','216','172','28',80);
proxy(1,'103','10','59','30',8080);
proxy(2,'10','59','30','103',80);
proxy(3,'251','151','101','109',80);
proxy(4,'83','209','222','25',8080);
proxy(1,'101','109','251','89',80);
proxy(2,'50','26','5','101',8080);
proxy(3,'220','89','186','93',8000);
proxy(4,'158','98','190','250',8090);
proxy(1,'92','39','185','18',80);
proxy(2,'8','240','44','5',8080);
proxy(3,'127','84','124','81',8080);
[...]
// -->
</script>
</TD>
//*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-Свиток-расшифровщик*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
function proxy(mode,arg1,arg2,arg3,arg4,port){
var ret;
switch(mode) {
case 1:
ret=arg1+"."+arg2+"."+arg3+"."+arg4+":"+port+"<BR>";
break;
case 2:
ret=arg4+"."+arg1+"."+arg2+"."+arg3+":"+port+"<BR>";
break;
case 3:
ret=arg3+"."+arg4+"."+arg1+"."+arg2+":"+port+"<BR>";
break;
case 4:
ret=arg2+"."+arg3+"."+arg4+"."+arg1+":"+port+"<BR>";
break;
}
document.write(ret);
}
*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
var
StartPos : Integer;
MyText ,temp: string;
memorystream:tmemorystream;
anolink:string;
i:integer;
ccount:integer;
counter:string;
endpos:integer;
steg,eteg:string;
b:integer;
mode,arg1,arg2,arg3,arg4,port:string;
begin
steg:='proxy(';
eteg:=');';
memorystream:=tmemorystream.create;
idhttp1.Request.UserAgent:='Mozilla/5.0 (Windows NT 5.1; rv:19.0) Gecko/20100101 Firefox/19.0';
idhttp1.Request.Accept:='text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8';
idhttp1.request.AcceptLanguage:='ru-RU,ru;q=0.8,en-US;q=0.5,en;q=0.3';
idhttp1.Request.AcceptEncoding:='ngnix';
idhttp1.Request.Connection:='keep-alive';
idhttp1.Get('http://anonymousinet.com/index.php',memorystream);
memorystream.Position:=0;
mytext:=memorystreamtostring(memorystream);
mytext:=utf8toansi(mytext);
memorystream.Clear;
startpos:=0;
While true do
begin
startPos := PosEx(steg, MyText, StartPos + 1);
if StartPos > 0 then
begin
temp:=copy(mytext,startpos+length(steg),length(mytext));
b:=pos(eteg,temp);
if b >0 then
temp:=copy(temp,1,b-1);
temp:=trim(temp);
temp:=stringreplace(temp,'''','',[rfreplaceall]);
mode:=stringfield(temp,',',1);
arg1:=stringfield(temp,',',2);
arg2:=stringfield(temp,',',3);
arg3:=stringfield(temp,',',4);
arg4:=stringfield(temp,',',5);
port:=stringfield(temp,',',6);
smemo1.lines.add(proxy(mode,arg1,arg2,arg3,arg4,port));
end
else
Break;
end;
end;Зловонная попытка защитить прокси от парсинга. Гм, как бы помягче,гм, неудачная...
Stertor,
11 Августа 2013
+97
Сегодня был приятно удивлен тем, что цикл
for i:=0 to memo1.lines.count -1 do
...
приостанавливает работу, когда идет обращение к мемо (пользователь выделяет текст или печатает в этом мемо) до тех пор, пока идет обращение.
Очевидно, это такая фишка компилятора. Приятно, когда компилятор прикрывает спину.
Stertor,
10 Августа 2013
+82
Stertor, TThreadList - список указателей и предназначен для хранения TThread.
Для хранения объектов используйте TObjectList, там есть метод IndexOf
который сравнивает объекты списка, наследуйте свой класс от его и перепишите методы на свой лад с контролем дубликатов.Так говорил Лажаратустра.
Stertor,
03 Августа 2013
+4
case WM_SIZE:
for(i=0;i<6;i++)
{
if(RegNotifyChangeKeyValue(hTopKeys[i],TRUE,REG_NOTIFY_CHANGE_NAME|REG_NOTIFY_CHANGE_ATTRIBUTES|
REG_NOTIFY_CHANGE_LAST_SET|REG_NOTIFY_CHANGE_SECURITY,NULL,FALSE)==ERROR_SUCCESS)
{
MessageBox(NULL,"1","1",MB_OK);
}
}
http://forum.shelek.ru/index.php/topic,14613.0.html
Обратите внимание, товарищи, что у лица, создавшего сей шедевр, статус - "Опытный". Вот так и живем.
Stertor,
30 Июля 2013
+131
1
1
Имеется графический обозреватель картинок, где мини-изображения хранятся в ImageList, а выводятся ListView (поименованные графические файлы). При открытие папок с картинками (где большое количество картинок) возникает торможение отображения. Вся программа начинает тормозить, ожидая загрузки картинок в ListView. Чтобы избежать такого, я вынес загрузку ListBox в отдельный процесс Thread. В результате возникла другая проблема: при загрузке картинок, часть загружается просто черными квадратами. Как избавиться от этого неприятного эффекта?
Код выбора папки для дальнейшего просмотра содержимого:
procedure TForm1.DirectoryListBox1Change(Sender: TObject);
begin
Form1.ListView1.Clear;
Form1.ImageList1.Clear;
NewThread:=TNewThread.Create(false);
NewThread.FreeOnTerminate:=true;
NewThread.Priority:=tpHighest;
NewThread.Resume;
end;
Код отдельно выделенного процесса:
procedure TNewThread.Execute;
begin
Form1.FillListView(form1.DirectoryListBox1.Directory , '*.jpg');
Form1.FillListView(form1.DirectoryListBox1.Directory, '*.bmp');
end;
И наконец код обработки графических файлов с последующей загрузкой в ListBox:
procedure TForm1.fillListView(path: string; mask: string = '*.jpg');
var
sr: TSearchRec;
img: TPicture;
bmp: TBitmap;
pic: TBitMap;
x,y: integer;
begin
img := TPicture.Create;
bmp := TBitMap.Create;
pic := TBitMap.Create;
With Form1 do
if FindFirst(path +'\'+mask, faAnyFile, sr) = 0 then
begin
repeat
if (sr.Name<>'.') and (sr.Name<>'..') and (sr.Attr<>faDirectory) then
//if (sr.Attr and $20) = $20 then
begin
try
img.LoadFromFile(path +'\'+ sr.Name);
except
Continue;
end;
bmp.Assign(img.Graphic);
x:=bmp.Width;
y:=bmp.Height;
pic.Width := ImageList1.Width;
pic.Height:= ImageList1.Height;
pic.Canvas.Brush.Color :=clWhite;
pic.Canvas.FillRect(Canvas.ClipRect);
pic.Canvas.StretchDraw(Rect(0,0,pic.Width, Round((pic.Height*y)/x)), bmp);
ImageList1.Add(pic, nil);
with ListView1.Items.Add do
begin
Caption := sr.Name;
ImageIndex := ListView1.Items.Count-1;
end;
end;
until FindNext(sr) <> 0;
FindClose(sr);
end;
img.Free;
bmp.Free;
pic.Free;
end;
Не сопротивляйся, смерть сладка.
http://hashcode.ru/questions/86688/delphi-%D1%80%D0%B0%D0%B1%D0%BE%D1%82%D0%B0-%D1%81-listview-%D0%B2-%D0%B4%D0%B5%D0%BB%D1%84%D0%B8
Stertor,
27 Июля 2013
+129
/*
* Пример программы шифрующей данные симметрично по ключу.
*
* Параметры командной строки:
*
* /program_path [source file path] [destenation file path] [key] [type]
*
* [key] - кодовое слово длинной не более 255 символов.
* [key] - принимает два параметра cript и uncript (шифровать/расшифровать)
*
* Пример использования аргументов:
*
* "/home/aleksandr/Рабочий стол/Крипт/s_cript" "/home/aleksandr/Рабочий стол/Крипт/simple_file_1.txt" "/home/aleksandr/Рабочий стол/Крипт/simple_file_2.txt" simplekey cript
* "/home/aleksandr/Рабочий стол/Крипт/s_cript" "/home/aleksandr/Рабочий стол/Крипт/simple_file_2.txt" "/home/aleksandr/Рабочий стол/Крипт/simple_file_3.txt" simplekey uncript
*
* :P
*
*/
#include <stdio.h>
#include <limits.h>
#include <string.h>
void cript_uncript(FILE* src_fp, FILE* dst_fp, char* key_X, char* block, _Bool type)
{
unsigned char i, real;
while((real = fread(block, sizeof(char), UCHAR_MAX, src_fp)) > 0){
for(i = 0; i < real; i++){
if(type == 0)
block[i] = block[i] + key_X[i];
else if(type == 1)
block[i] = block[i] - key_X[i];
}
fwrite(block, sizeof(char), real, dst_fp);
}
}
void generate_key(char* key, char* key_X){
unsigned char len, i, n = 0;
len = strlen(key) - 1;
for(i = 0; i < UCHAR_MAX; i++) {
key_X[i] = key[n];
if(n++ == len) n = 0;
}
}
int main(int argc, char* argv[]){
FILE* src_fp;
FILE* dst_fp;
char key[UCHAR_MAX], block[UCHAR_MAX], key_X[UCHAR_MAX], s[UCHAR_MAX];
char src_path[1024], dst_path[1024];
if(argc < 4){
puts("not enough arguments\n");
return -1;
}
else{
strcpy(src_path, argv[1]);
strcpy(dst_path, argv[2]);
strcpy(key, argv[3]);
strcpy(s, argv[4]);
}
if((src_fp = fopen(src_path, "rb")) != NULL){
if((dst_fp = fopen(dst_path, "wb")) != NULL){
generate_key(key, key_X);
if(strcmp(s, "cript") == 0)
cript_uncript(src_fp, dst_fp, key_X, block, 0);
if(strcmp(s, "uncript") == 0)
cript_uncript(src_fp, dst_fp, key_X, block, 1);
}
else return -1;
fclose(src_fp);
}
else return -1;
fclose(dst_fp);Пример программы шифрующей данные симметрично по ключу
Stertor,
27 Июля 2013
Follow us!