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

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

+106

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

function ReplaceUrl(txt: WideString): WideString;
var
  i, j: integer;
  tmp, Url: WideString;
begin
  Result := '';
  I := 1;
  while I <= Length(txt) do
  begin
    tmp := '';
    if WideSameText(tmp + txt[i]+txt[i+1]+txt[i+2]+txt[i+3]+txt[i+4]+txt[i+5]+txt[i+6], 'http://') or
       WideSameText(tmp + txt[i]+txt[i+1]+txt[i+2]+txt[i+3]+txt[i+4]+txt[i+5]+txt[i+6], 'ed2k://') or
       WideSameText(tmp + txt[i]+txt[i+1]+txt[i+2]+txt[i+3]+txt[i+4]+txt[i+5],          'ftp://') or
       WideSameText(tmp + txt[i]+txt[i+1]+txt[i+2]+txt[i+3],                            'www.') or
       WideSameText(tmp + txt[i]+txt[i+1]+txt[i+2]+txt[i+3]+txt[i+4]+txt[i+5]+txt[i+6]+txt[i+7], 'https://') then
    begin
      Url := '';
      for j := I to Length(txt) do
      begin
        if (txt[j] <> ' ') and (ord(txt[j]) < 255) then
          Url := Url + txt[J]
        else
          Break;
      end;
 
      Result := Result + Format(C_HTML_URL, [Url, Url]);
 
      I := J;
    end else
    begin
      Result := Result + txt[I];
 
      Inc(I);
    end;
  end;
 
end;

http://www.bvbcode.com/code/vhk2e8rb-1638045

63F45EF45RB65R6VR, 21 Августа 2012

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

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

+96

1
2
3
4

function InterlockedExchangePointer(var Target: Pointer; Value: Pointer): Pointer;
begin
  Result := Pointer(InterlockedExchange(Integer(Target), Integer(Value)));
end;

Windows.pas
facepalm.jpg
Delphi, такой Delphi.

HaskellGovno, 14 Августа 2012

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

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

+89

01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
20
21
22

procedure TClickerAdvertising.Start(Item: TTaskItem);
  procedure StartTask(AURL: string);
  procedure SearchInYandex(Keywords, Domen: string);
    procedure SendSearchRequest;
    procedure CheckSearchRequest;
    procedure SearchLinkAndClick;
      function FindLinkInList: IHTMLElement;
    procedure CheckValidateTransition;

  procedure MoveAndGoBack(Domen: string; MoveCount, MoveDelay: Integer);
    function GetRandomElement: IHTMLElement;

  procedure FindAdvertLinkAndClick(AdvertType: TAdvertType; var AdvertLink: string);
    procedure ClickFromLinkToAdvert;
    procedure ClickFromGoogleAds;

  procedure SendReport(AURL: string);
    function GetIP: string;
    
begin
//...
end;

А як, Ви, ставитись до вкладених процедур?

ADR, 14 Июля 2012

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

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

+99

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

// Получение имени выполняемого метода, вызывать можно только из Published-методов класса.
// Для обычных методов: FindClassMethodNames(ClassType()), для статических методов FindClassMethodNames(self).
{$optimization OFF}
function FindClassMethodNames(obj: TClass): string;
var _AdrPtr: Pointer;
begin
  asm
    mov eax, obj
    mov edx, dword ptr [esp + 272]
    push ebx
    push esi
    push edi
    push $7FFFFFFF
    xor edi, edi
    jmp @@haveVMT
   @@outer:
    mov eax, dword ptr [eax]
   @@haveVMT:
    mov esi, dword ptr [eax].vmtMethodTable
    test esi, esi
    je @@parent
    movzx ecx, word ptr [esi]
    add esi, 2
   @@inner:
    pop ebx
    push edx
    sub edx, dword ptr [esi + 2]
    jl @@no1
    cmp edx, ebx
    jg @@no1
    mov ebx, edx
    mov edx, dword ptr [esi + 2]
    mov edi, edx
   @@no1:
    pop edx
    push ebx
    movzx ebx, word ptr [esi]
    add esi, ebx
    dec ecx
    jnz @@inner
   @@parent:
    mov eax, dword ptr [eax].vmtParent
    test eax, eax
    jne @@outer
    mov _AdrPtr, edi
    pop edi
    pop esi
    pop ebx
  end;
  Result := obj.MethodName(_AdrPtr);
end;
{$optimization ON}

// пример использования
procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(FindClassMethodNames(ClassType()));
end;

А есть нормальный способ получить имя выполняемого метода, и строку кода заодно?

ctm, 11 Июля 2012

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

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

+102

01
02
03
04
05
06
07
08
09
10
11
12

procedure TForm1.Timer1Timer(Sender: TObject);
begin
        if ((Edit1.Text <> '') or (Edit4.Text <> '')) then
                begin
                Button1.Enabled:=true;
                end;

        if ((Edit1.Text = '') or (Edit4.Text = '')) then
                begin
                Button1.Enabled:=false;
                end;
end;

Таким образом настоящий ветеран говнокода защищает свое детище от "кривых" рук.

CyberKiller, 08 Июля 2012

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

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

+94

01
02
03
04
05
06
07
08
09
10
11
12
13

function Dist(dx, dy: integer): integer;  
begin
  //result := trunc(sqrt(sqr(dx)+sqr(dy)));
  dx := abs(dx);
  dy := abs(dy);
  if dx>dy then begin
    dy := dy shr 1 - dx shr 3;
    if dy >= 0 then result := dx+dy else result := dx;
  end else begin
    dx := dx shr 1 - dy shr 3;
    if dx >= 0 then result := dx+dy else result := dy;
  end;
end;

Ещё по теме приближённых расчётов в игровом движке.

TarasB, 02 Июля 2012

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

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

+99

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

program lab;
usescrt
var
a:array [1..20] of shortint;
s:byte;
g,b:real;
begin
clrscr
randomize;
for s:=1 to 20 do 	
begin 
a[s]:=random (40);
a[s]:=a[s]-20;
write (a [s]4);
end;
g:=0
for s:=1 to 20 do
if a[s]>0 , then g= g+a [s];
writelnc(summa pol ',g);
b:=0;
for s:=1 to 20 do
if a[s]<0 then b:=b+a[s];
writeln (srednee',b);
b:=(b)/20;
repeat until keypressed;
end.

http://rghost.ru/38741341

dos_, 01 Июля 2012

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

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

+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
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60

if (M[1]<>M[2]) and (M[1]<>M[3]) and (M[1]<>M[4]) and (M[1]<>M[5]) and (M[1]<>M[6]) then
begin
if (M[1]<>M[7]) and (M[1]<>M[8]) and (M[1]<>M[9]) and (M[1]<>M[10]) then
write('  ',M[1],'  ');
end;
 
if (M[2]<>M[1]) and (M[2]<>M[3]) and (M[2]<>M[4]) and (M[2]<>M[5]) and (M[2]<>M[6]) then
begin
if (M[2]<>M[7]) and (M[2]<>M[8]) and (M[2]<>M[9]) and (M[2]<>M[10]) then
write('  ',M[2],'  ');
end;
 
if (M[3]<>M[1]) and (M[3]<>M[2]) and (M[3]<>M[4]) and (M[3]<>M[5]) and (M[3]<>M[6]) then
begin
if (M[3]<>M[7]) and (M[3]<>M[8]) and (M[3]<>M[9]) and (M[3]<>M[10]) then
write('  ',M[3],'  ');
end;
 
if (M[4]<>M[1]) and (M[4]<>M[2]) and (M[4]<>M[3]) and (M[4]<>M[5]) and (M[4]<>M[6]) then
begin
if (M[4]<>M[7]) and (M[4]<>M[8]) and (M[4]<>M[9]) and (M[4]<>M[10]) then
write('  ',M[4],'  ');
end;
 
if (M[5]<>M[1]) and (M[5]<>M[2]) and (M[5]<>M[3]) and (M[5]<>M[4]) and (M[5]<>M[6]) then
begin
if (M[5]<>M[7]) and (M[5]<>M[8]) and (M[5]<>M[9]) and (M[5]<>M[10]) then
write('  ',M[5],'  ');
end;
 
if (M[6]<>M[1]) and (M[6]<>M[2]) and (M[6]<>M[3]) and (M[6]<>M[4]) and (M[6]<>M[5]) then
begin
if (M[6]<>M[7]) and (M[6]<>M[8]) and (M[6]<>M[9]) and (M[6]<>M[10]) then
write('  ',M[6],'  ');
end;
 
if (M[7]<>M[1]) and (M[7]<>M[2]) and (M[7]<>M[3]) and (M[7]<>M[4]) and (M[7]<>M[5]) then
begin
if (M[7]<>M[6]) and (M[7]<>M[8]) and (M[7]<>M[9]) and (M[7]<>M[10]) then
write('  ',M[7],'  ');
end;
readln;
 
if (M[8]<>M[1]) and (M[8]<>M[2]) and (M[8]<>M[3]) and (M[8]<>M[4]) and (M[8]<>M[5]) then
begin
if (M[8]<>M[6]) and (M[8]<>M[7]) and (M[8]<>M[9]) and (M[8]<>M[10]) then
write('  ',M[8],'  ');
end;
 
if (M[9]<>M[1]) and (M[9]<>M[2]) and (M[9]<>M[3]) and (M[9]<>M[4]) and (M[9]<>M[5]) then
begin
if (M[9]<>M[6]) and (M[9]<>M[7]) and (M[9]<>M[8]) and (M[8]<>M[10]) then
write('  ',M[9],'  ');
end;
 
if (M[10]<>M[1]) and (M[10]<>M[2]) and (M[10]<>M[3]) and (M[10]<>M[4]) and (M[10]<>M[5]) then
begin
if (M[10]<>M[6]) and (M[10]<>M[7]) and (M[10]<>M[8]) and (M[10]<>M[9]) then
write('  ',M[10],'  ');
end;

Циклы? Не, не слышал...

HighPredator, 19 Июня 2012

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

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

+95

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

function IntToHex(Num: Int64; Digits: Byte): String;
type
  DataInt = Array[0..7] of Byte;
var
  I:Byte;
  Data: ^DataInt;
begin
  Data := @Num;
  Result := '';
  for I := Trunc(Digits/2)-1 downto 0 do begin
    if SizeOf(DataInt) < I then
      Result := Result+'00'
    else begin
      case Data^[I] of
        0: Result := Result+'00';
        1: Result := Result+'01';
        2: Result := Result+'02';  
        { ........... }
        253: Result := Result+'FD'; 
        254: Result := Result+'FE';      
        255: Result := Result+'FF';
       end;
    end;
  end;
end;

Давно писал функцию для перевода числа в 16-ричное представление.
Причина - нужно было отдельную функцию без лишнего.
Вот такой вот жестокий быдло код :))

haker, 13 Июня 2012

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

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

+90

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

function Vincenty(Lat1, Lon1, Lat2, Lon2: Extended): Extended;
const  // Параметры эллипсоида:
a = 6378245.0;
f = 1 / 298.3;
b = (1 - f) * a;
EPS = 0.5E-30;
var
APARAM, BPARAM, CPARAM, OMEGA, TanU1, TanU2,
Lambda, LambdaPrev, SinL, CosL, USQR, U1, U2,
SinU1, CosU1, SinU2, CosU2, SinSQSigma, CosSigma,
TanSigma, Sigma, SinAlpha, Cos2SigmaM, DSigma : Extended;
begin
lon1 := lon1 * (PI / 180); 
lat1 := lat1 * (PI / 180);
lon2 := lon2 * (PI / 180); 
lat2 := lat2 * (PI / 180); //Пересчет значений координат в радианы

TanU1 := (1 - f) * Tan(lat1); 
TanU2 := (1 - f) * Tan(lat2);
U1 := ArcTan(TanU1);  
U2 := ArcTan(TanU2);
SinCos(U1, SinU1, CosU1); 
SinCos(U2, SinU2, CosU2);
OMEGA := lon2 - lon1; 
lambda := OMEGA;

repeat //Начало цикла итерации

LambdaPrev:= lambda;
SinCos(lambda, SinL, CosL);
SinSQSigma := (CosU2 * SinL * CosU2 * SinL) +
  (CosU1 * SinU2 - SinU1 * CosU2 * CosL) *
  (CosU1 * SinU2 - SinU1 * CosU2 * CosL);

CosSigma := SinU1 * SinU2 + CosU1 * CosU2 * CosL;
TanSigma:= Sqrt(SinSQSigma) / CosSigma;

if TanSigma > 0  then Sigma := ArcTan(TanSigma)
  else Sigma := ArcTan(TanSigma) + Pi;

if SinSQSigma = 0  then SinAlpha := 0
   else SinAlpha := CosU1 * CosU2 * SinL / Sqrt(SinSQSigma);

if (Cos(ArcSin(SinAlpha)) * Cos(ArcSin(SinAlpha))) = 0  then Cos2SigmaM := 0
  else Cos2SigmaM:= CosSigma - (2 * SinU1 * SinU2 / (Cos(ArcSin(SinAlpha)) * Cos(ArcSin(SinAlpha))));

CPARAM:= (f / 16) * Cos(ArcSin(SinAlpha)) * Cos(ArcSin(SinAlpha)) *
  (4 + f * (4 - 3 * Cos(ArcSin(SinAlpha)) * Cos(ArcSin(SinAlpha))));

lambda := OMEGA + (1 - CPARAM) * f * SinAlpha * (ArcCos(CosSigma) +
  CPARAM * Sin(ArcCos(CosSigma)) * (Cos2SigmaM + CPARAM * CosSigma *
  (-1 + 2 * Cos2SigmaM * Cos2SigmaM)));

until Abs(lambda - LambdaPrev) < EPS; // Конец цикла итерации

USQR:= Cos(ArcSin(SinAlpha)) * Cos(ArcSin(SinAlpha)) *(a * a - b * b) / (b * b);
APARAM := 1 + (USQR / 16384) * (4096 + USQR * (-768 + USQR * (320 - 175 * USQR)));

BPARAM := (USQR / 1024) * (256 + USQR * (-128 + USQR * (74 - 47 * USQR)));
DSigma := BPARAM * SQRT(SinSQSigma) * (Cos2SigmaM + BPARAM / 4 *
(CosSigma * (-1 + 2 * Cos2SigmaM * Cos2SigmaM) - BPARAM / 6 * Cos2SigmaM *
(-3 + 4 * SinSQSigma) * (-3 + 4 * Cos2SigmaM * Cos2SigmaM)));

Result := b * APARAM * (Sigma - DSigma);
end; 

{ ©Drkb::04255 }

Алгоритм расчёта километража между двумя точками на земной поверхности методом Винсенти, найден в drkb3.0. Там же весь этот ГК уместился в одной строчке:

distance=sqrt(pow((lon1 - lon2)*111*COS(lat2/57.295781), 2) + pow((lat1) - lat)*111, 2));

, чудноо... :)

Alegun, 09 Июня 2012

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

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