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

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

+141

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

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

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

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

+134

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

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

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

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

+110

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

// Двухклеточная прямая.
       ({D2A2}(Pixels[X+h,Y-1]=clWhite) and(Pixels[x+h,y-2]=clBlack) and(Pixels[x+h,y-3]=clBlack)     and{D2A2} (Pixels[x+h+1,y-1]=clWhite) and(Pixels[x+h+1,y-2]=clBlack) and(Pixels[x+h+1,y-3]=clWhite)  and{D2A2}(Pixels[x+h+2,y-2]=clWhite) and(Pixels[x+h+2,y-3]=clBlack) and(Pixels[x+h+2,y-4]=clWhite) and{D2A2}(Pixels[x+h+3,y-2]=clWhite) and(Pixels[x+h+3,y-3]=clBlack) and(Pixels[x+h+3,y-4]=clWhite)) or {D2A2}
    ({D2A2A-1}(Pixels[X+h,Y-1]=clWhite) and(Pixels[x+h,y-2]=clBlack) and(Pixels[x+h,y-3]=clWhite)     and{D2A2A-1}(Pixels[x+h+1,y-1]=clWhite) and(Pixels[x+h+1,y-2]=clBlack) and(Pixels[x+h+1,y-3]=clWhite)  and{D2A2A-1}(Pixels[x+h+2,y-2]=clWhite) and(Pixels[x+h+2,y-3]=clBlack) and(Pixels[x+h+2,y-4]=clBlack) and{D2A2A-1}(Pixels[x+h+3,y-2]=clWhite) and(Pixels[x+h+3,y-3]=clBlack) and(Pixels[x+h+3,y-4]=clWhite)) or {D2A2A-1}
       ({D2A3}(Pixels[X+h,Y-1]=clWhite) and(Pixels[x+h,y-2]=clBlack) and(Pixels[x+h,y-3]=clWhite)     and{D2A3}(Pixels[x+h+1,y-1]=clWhite) and(Pixels[x+h+1,y-2]=clBlack) and(Pixels[x+h+1,y-3]=clBlack)  and{D2A3}(Pixels[x+h+2,y-2]=clWhite) and(Pixels[x+h+2,y-3]=clBlack) and(Pixels[x+h+2,y-4]=clWhite) and{D2A3}(Pixels[x+h+3,y-2]=clWhite) and(Pixels[x+h+3,y-3]=clBlack) and(Pixels[x+h+3,y-4]=clWhite) and{D2A3}(Pixels[x+h+4,y-3]=clWhite) and(Pixels[x+h+4,y-4]=clBlack) and(Pixels[x+h+4,y-5]=clWhite)) or {D2A3}
       ({D2A4}(Pixels[X+h,Y-1]=clBlack) and(Pixels[x+h,y-2]=clBlack) and(Pixels[x+h,y-3]=clWhite)     and{D2A4}(Pixels[x+h+1,y-1]=clWhite) and(Pixels[x+h+1,y-2]=clBlack) and(Pixels[x+h+1,y-3]=clWhite)  and{D2A4}(Pixels[x+h+2,y-2]=clWhite) and(Pixels[x+h+2,y-3]=clBlack) and(Pixels[x+h+2,y-4]=clWhite) and{D2A4}(Pixels[x+h+3,y-2]=clWhite) and(Pixels[x+h+3,y-3]=clBlack) and(Pixels[x+h+3,y-4]=clWhite)) or {D2A4}
   ... Ещё 20 строк в таком стиле
       ({D2B2}(Pixels[X+h,Y-1]=clWhite) and(Pixels[x+h,y-2]=clWhite) and(Pixels[x+h,y-3]=clBlack)     and{D2B2}(Pixels[x+h+1,y-1]=clWhite) and(Pixels[x+h+1,y-2]=clBlack) and(Pixels[x+h+1,y-3]=clWhite)      and{D2B2}(Pixels[x+h+2,y-2]=clWhite) and(Pixels[x+h+2,y-3]=clBlack) and(Pixels[x+h+2,y-4]=clWhite)    and{D2B2}(Pixels[x+h+3,y-2]=clWhite) and(Pixels[x+h+3,y-3]=clBlack) and(Pixels[x+h+3,y-4]=clWhite)     and{D2B2}(Pixels[x+h+4,y-3]=clWhite) and(Pixels[x+h+4,y-4]=clBlack) and(Pixels[x+h+4,y-5]=clWhite)) or {D2B2}
       ({D2B3}(Pixels[X+h,Y-1]=clWhite) and(Pixels[x+h,y-2]=clWhite) and(Pixels[x+h,y-3]=clWhite)     and{D2B3}(Pixels[x+h+1,y-1]=clWhite) and(Pixels[x+h+1,y-2]=clBlack) and(Pixels[x+h+1,y-3]=clBlack)      and{D2B3}(Pixels[x+h+2,y-2]=clWhite) and(Pixels[x+h+2,y-3]=clBlack) and(Pixels[x+h+2,y-4]=clWhite)    and{D2B3}(Pixels[x+h+3,y-2]=clWhite) and(Pixels[x+h+3,y-3]=clBlack) and(Pixels[x+h+3,y-4]=clWhite)     and{D2B3}(Pixels[x+h+4,y-3]=clWhite) and(Pixels[x+h+4,y-4]=clBlack) and(Pixels[x+h+4,y-5]=clWhite)) or {D2B3}
       ({D2B4}(Pixels[X+h,Y-1]=clBlack) and(Pixels[x+h,y-2]=clWhite) and(Pixels[x+h,y-3]=clWhite)     and{D2B4}(Pixels[x+h+1,y-1]=clWhite) and(Pixels[x+h+1,y-2]=clBlack) and(Pixels[x+h+1,y-3]=clBlack)      and{D2B4}(Pixels[x+h+2,y-2]=clWhite) and(Pixels[x+h+2,y-3]=clBlack) and(Pixels[x+h+2,y-4]=clWhite)    and{D2B4}(Pixels[x+h+3,y-2]=clWhite) and(Pixels[x+h+3,y-3]=clBlack) and(Pixels[x+h+3,y-4]=clWhite)     and{D2B4}(Pixels[x+h+4,y-3]=clWhite) and(Pixels[x+h+4,y-4]=clBlack) and(Pixels[x+h+4,y-5]=clWhite)) {or} {D2B4}
         {(J1(Pixels[X+h,Y-1]=clWhite) and (Pixels[x+h,y]=clWhite) and (Pixels[x+h,y-2]=clBlack))} then // Проверка, если обрыв по x, начало следующей ступенрки.
         begin
          goto k8;
           end ;
            goto k3;//Если убрать эту строчку,то может фиксироваться вся линия исключая точку с дифектоми, т.к.
             end;   // если не отрабатывает сравнение пикселей по длине ступеньки и не отрабатывает по переходу на новую ступеньку, прог. прибавляет h и перемещает пиксель опроса в право.
 
    k8: if (CPlx-CPLxI=0) or (CPlx-CPlxI=1) or (CPlxI-CPlx=1)or(CPlxI-CPlx=CPlxI/2) or (CPlx-CPlxI=CPlx/2) or (CPlxI-CPlx=(CPlxI/2)-1) or (CPlx-CPlxI=(CPlx/2)-1) or ((CPlxI-CPlx>(CPlxI/2)-1) and (CPlxI-CPlx<(CPlxI/2)+1)) then
 
    begin
     a:=x+h;
     b:=y-1;
     count:=count+1; // Счет ступеник.
     goto k5;
      end;
 
      k3: OperEnd:=DateTimeToTimeStamp(Now);
 Total:=OperEnd.Time-OperBegin.Time;
 
 
   ListBox1.Items.Add(IntToStr(CPlx0)+' CPlx0');
   ListBox1.Items.Add(IntToStr(CPlxI)+' CPlxI');
   ListBox1.Items.Add(IntToStr(count)+' Ступеньки.');
   ListBox1.Items.Add(IntToStr(Total)+' MSec');
     end; // Конец прог.
       end;
         end.

Адовый пиздец с киберфорума.

http://www.cyberforum.ru/delphi-beginners/thread941698.html

murder, 23 Августа 2013

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

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

+130

1

Народ, вы где? Я реально соскучился.

Stertor, 22 Августа 2013

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

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

+87

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

*-*-*-*-*-*-*-*-*-*-*-*-*-*-зашифрованные прокси:*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
<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

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

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

+97

1
2
3
4
5
6
7

Сегодня был приятно удивлен тем, что цикл

for i:=0 to memo1.lines.count -1 do
...

приостанавливает работу, когда идет обращение к мемо (пользователь выделяет текст или печатает в этом мемо) до тех пор, пока идет обращение. 
Очевидно, это такая фишка компилятора. Приятно, когда компилятор прикрывает спину.

Stertor, 10 Августа 2013

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

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

+82

1
2
3

Stertor, TThreadList - список указателей и предназначен для хранения TThread. 
Для хранения объектов используйте TObjectList, там есть метод IndexOf 
который сравнивает объекты списка, наследуйте свой класс от его и перепишите методы на свой лад с контролем дубликатов.

Так говорил Лажаратустра.

Stertor, 03 Августа 2013

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

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

+131

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

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

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

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

+141

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

if x > 0 then 
begin
if y <= 0 then 
begin
if z <> 0 then 
begin
if x1 > 0 then 
begin
if y1 < 7 then 
begin
if z1 > 0 then 
begin
if z1 mod 5 = 0 then 
begin
if m <> 3 then 
begin
if n > 5 then 
begin
writeln('1');
end;
end;
end;
end;
end;
end;
end;
end;
end;

iNsectus, 21 Июля 2013

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

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

+88

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

program Project6;

{$APPTYPE CONSOLE}

uses SysUtils;

type TIntArr = array of integer;

function GetSingleArr (i: integer): TIntArr;
begin
  SetLength(Result, 1);
  Result[0] := i;
end;

var
  W: TIntArr;
  i : integer;
begin
  readln(i);
  if i=0 then begin
    W := GetSingleArr(5);
    WriteLn(W[0]);
  end;
  ReadLn;
end.

Delphi-7
[Warning] Project6.dpr(25): Variable 'W' might not have been initialized

Да какого хуя? Динмассив вообще по определению - чисто автоматический тип, как он может не инициализироваться?
И почему для других типов такая хрень не вылазит?

TarasB, 18 Июля 2013

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

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