Список говнокодов пользователя inkanus-gray

Всего: 48

PHP / Говнокод #14668

+146

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

<?php
define('STOCK_URL', 'http://govnokod.ru/comments');
define('REFERER_URL', 'http://govnokod.ru/');
define('AUTH_COOKIES', 'a:2:{s:9:"PHPSESSID";s:26:"k719c8rqcm85dptista7b7rck7";s:4:"auth";s:32:"0ce5a7d54092aa07e37b88ffbe098135";}');
define('MODERATED_TEXT', '[color=red][i]Слава «Беркуту»![/i][/color]');
define('DEFAULT_UA', 'Opera/9.80 (Windows NT 6.0) Presto/2.12.388 Version/12.16');
define('POST_HEADERS', "X-Requested-With: XMLHttpRequest\r\nContent-Type: application/x-www-form-urlencoded\r\n");
define('PONY1', "//ol[@class='posts hatom']/li/h2/a");
define('PONY2', "//form/div/input[@name='_csrf_token']");
define('PONY3', "//li[@class='hcomment']/div/a[@class='edit-comment-link']");

function myCookies() {
	$map_cookies = function($k, $v) {return $k . '='. $v;};
	return implode('; ', array_map($map_cookies, array_keys(unserialize(AUTH_COOKIES)), unserialize(AUTH_COOKIES)));
}

function huyarim($url, $referer, $mask, $attr) {
	$context_options = stream_context_create(array('http' => array(
	  'method' => 'GET',
	  'user_agent' => DEFAULT_UA,
	  'header' => 'Referer: '. $referer . "\r\n" . 'Cookie: ' . myCookies()
	)));
	$links = array();
	$file = @file_get_contents($url, false, $context_options);
	if ($file) {
	  $old_libxml_error = libxml_use_internal_errors(true);
	  $dom = new DOMDocument;
 	  $dom->loadHTML($file);
	  libxml_use_internal_errors($old_libxml_error);
 	  $domxpath = new DOMXPath($dom);
 	  $filtered = $domxpath->query($mask);
	  foreach ($filtered as $item) {
		$links[] = $item->getAttribute($attr);
	  }
	}  
	return $links;
}

function getList() {return huyarim(STOCK_URL, REFERER_URL, PONY1, 'href');}
function getCsrf($url) {$tokens = huyarim($url, STOCK_URL, PONY2, 'value'); return $tokens[0];}
function getComments($url) {return huyarim($url, STOCK_URL, PONY3, 'href');}

function doPost($url, $referer, $token) {
	$postdata = http_build_query(array(
	  '_csrf_token' => $token,
	  'text' => MODERATED_TEXT,
	  'commentSubmit' => 'Отправить комментарий [Ctrl+Enter]',
	  'ajax' => 'true'
 	));
	$context_options = stream_context_create(array('http' => array(
	  'protocol_version' => 1.1,
	  'method' => 'POST',
	  'user_agent' => DEFAULT_UA,
	  'header' => POST_HEADERS . 'Referer: '. $referer . "\r\n" . 'Cookie: ' . myCookies(),
	  'content' => $postdata
	)));
	return file_get_contents($url, false, $context_options);
}

$links = getList();
foreach($links as $link) {
	$token = getCsrf($link);
	$comments = getComments($link);
	foreach($comments as $comment) {
		if (false !== doPost($comment, $link, $token)) {
			echo $comment . ' OK' . PHP_EOL;
		}
	}
}

CURL и PECL_HTTP не нужны. Да, и ООП тоже не нужно.

inkanus-gray, 19 Февраля 2014

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

JavaScript / Говнокод #14076

+154

1
2
3
4
5
6
7

function FindProxyForURL(url, host) {
  if (shExpMatch(host, "*.govnokod.ru")) {
      return "PROXY 178.63.104.146:80";
  }
  
  return "DIRECT";
}

Навеяно прочтением статьи http://en.wikipedia.org/wiki/Proxy_auto-config

inkanus-gray, 30 Октября 2013

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

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

+97

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

{$APPTYPE CONSOLE} {$IFDEF FPC}{$MODE DELPHI}{$ENDIF}
uses SysUtils, Classes, IniFiles, Variants;

type TGetToken = function(var p: pointer): LongInt;
procedure ParseData(var p: pointer; isKey: boolean); forward;
procedure AdvanceIndex(var i: LongInt); forward;

function GetIntegerToken(var p: pointer): LongInt;
var value: LongInt = 0;
    negative: boolean;
begin
  Inc(p);
  negative := PByte(p)^ = ord('-');
  if negative then Inc(p);
  repeat
    value := value * 10 + LongInt(PByte(p)^ - $30);
    Inc(p)
  until PChar(p)^ = 'e';
  Inc(p);
  if negative then value := - value;
  Result := value
end;

function GetListToken(var p: pointer): LongInt;
var index: Integer = 0;
begin
  Inc(p);
  while PChar(p)^ <> 'e' do begin
    AdvanceIndex(index);
    ParseData(p, false);
  end;
  Inc(p);
  Result := -1
end;

function GetDictToken(var p: pointer): LongInt;
begin
  Inc(p);
  while PChar(p)^ <> 'e' do begin
    ParseData(p, true);
    ParseData(p, false);
  end;
  Inc(p);
  Result := -1
end;

function ParseError(var p: pointer): LongInt;
begin
  Writeln('TYIIINTE CBET');
  Result := -1;
  Halt(Result)
end;

const FuncTable: array[0..3] of TGetToken = (ParseError, GetDictToken, GetIntegerToken, GetListToken);

function GetStringToken(var p: pointer): string;
var value: ShortString;
    length: LongInt = 0;
begin
  repeat
    length := length * 10 + LongInt(PByte(p)^ - $30);
    Inc(p)
  until PChar(p)^ = ':';
  if length in [1..255] then begin
    PByte(p)^ := length;
    Move(p^, value, length+1);
    Result := value;
  end else Result := 'BINARY DATA';
  Inc(p, length + 1);
end;

var sl: TStringList;
    outf: TIniFile;

procedure AdvanceIndex(var i: LongInt);
begin
  sl.Add(IntToStr(i));
  Inc(i);
end;

type TSaveData = procedure(value: Variant);



procedure SaveData(value: Variant);

var 

  key: string = '';

  i: LongInt;

begin

  for i := 0 to sl.Count - 1 do key := key + '.' + sl[i];

  Delete(key, 1, 1);

  outf.WriteString('Torrent', key, VarToStr(value));

  if sl.Count > 0 then sl.Delete(sl.Count - 1);

end;



procedure PushKey(value: Variant);

begin

  sl.Add(value)

end;



procedure PopKey(value: Variant);

begin

  if sl.Count > 0 then sl.Delete(sl.Count - 1);

end;



procedure NOP(value: Variant);

begin

end;



const SaveDataTable: array[0..3] of TSaveData = (SaveData, PushKey, PopKey, NOP);



procedure ParseData(var p: pointer; isKey: boolean);

var

  OpCode: ShortInt;

  value: Variant;

begin

  OpCode := PByte(p)^;

  if OpCode >= $60 then              value := FuncTable[OpCode shr 2 and 3](p)

  else if Opcode in [$30..$39] then  value := GetStringToken(p)

  else ParseError(p);



  SaveDataTable[ord(isKey) + 2*ord(chr(OpCode) in ['d', 'l'])](value);

end;



var f: TFileStream;

    s: LongInt;

    p, cp: pointer;

begin

  if ParamCount <> 1 then Writeln('Usage: ', ParamStr(0), ' filename.torrent')

  else

    try

      f := TFileStream.Create(ParamStr(1), fmOpenRead);

      s:= f.Size;

      GetMem(p, s + 1);

      f.ReadBuffer(p^, s);

      cp := p;

      outf := TIniFile.Create(ChangeFileExt(ParamStr(1), '.ini'));

      sl := TStringList.Create;

      ParseData(cp, false);

    finally

      if sl <> nil then sl.Destroy();

      if outf <> nil then outf.Destroy();

      if p <> nil then FreeMem(p);

      if f <> nil then f.Destroy()

    end

end.

Парсер torrent-файлов и сохранялка в INI-файл (пока без сумм фрагментов). Опа-лаба-стайл, писано левой ногой анскильного питуха.

inkanus-gray, 09 Июля 2013

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

Assembler / Говнокод #13242

+108

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

; Assign standard procedure (PChar)

AssignFileC:

	DB	0BAH			;MOV DX,immed

; Assign standard procedure (String)

AssignFile:

	XOR	DX,DX
	MOV	BX,SP
	PUSH	DS
	LES	DI,SS:[BX+8]
	LDS	SI,SS:[BX+4]
	CLD
	XOR	AX,AX
	STOSW
	MOV	AX,fmClosed
	STOSW
	XOR	AX,AX
	MOV	CX,(fName-fBufSize)/2
	REP	STOSW
    IF WindowsVersion
	PUSH	ES
	PUSH	DI
	PUSH	ES
	PUSH	DI
    ENDIF
	MOV	CX,79
	OR	DX,DX
	JNE	@@1
	LODSB
	CMP	CL,AL
	JBE	@@1
	MOV	CL,AL
	JCXZ	@@2
@@1:	LODSB
	OR	AL,AL
	JE	@@2
	STOSB
	LOOP	@@1
@@2:	XOR	AL,AL
	STOSB
    IF WindowsVersion
	CALL	AnsiToOem
    ENDIF
	POP	DS
	RETF	8

Угадайте с первых строк автора и как выполнится инструкция DB 0BAH; XOR DX, DX.

inkanus-gray, 26 Июня 2013

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

SQL / Говнокод #12953

−164

1

SELECT LAST_INSERT_ID() FROM comments;

Подозреваю, что баян, но найти в чистом виде здесь не смог. Номинант на звание самого короткого анекдота на SQL.

inkanus-gray, 29 Апреля 2013

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

PHP / Говнокод #12436

+42

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

function test($method)
{
  $picfile = 'pic1.png';
  $bgfile = 'output.png';
  $background = 'pic2.png';
  $foreground = 'pic3.png';

  if ($method == 'Imagick') {
    $img = new Imagick($picfile);

    $mask = new Imagick($background);
    $img->compositeImage($mask, imagick::COMPOSITE_COPYOPACITY, 0, 0);
    $mask->destroy();

    $overlay = new Imagick($foreground);
    $img->compositeImage($overlay, imagick::COMPOSITE_OVER, 0, 0);
    $overlay->destroy();

    $img->setImageFormat('png');
    file_put_contents($bgfile, $img->getImageBlob()); // $img->writeImage($bgfile) работает медленнее
    $img->destroy();
  } else if ($method == 'Wand') {
    $img = NewMagickWand();
    MagickReadImage($img, $picfile);

    $mask = NewMagickWand();
    MagickReadImage($mask, $background);
    MagickCompositeImage($img, $mask, MW_CopyOpacityCompositeOp, 0, 0);
    DestroyMagickWand($mask);

    $overlay = NewMagickWand();
    MagickReadImage($overlay, $foreground);
    MagickCompositeImage($img, $overlay, MW_OverlayCompositeOp , 0, 0);
    DestroyMagickWand($overlay);

    MagickSetImageFormat($img, 'png');
    file_put_contents($bgfile, MagickGetImagesBlob($img)); // ditto
    DestroyMagickWand($img);
  } else {
    $cmdline = 'convert -compose copy-opacity ' . $picfile . ' ' . $background . ' -composite';
    $cmdline .= ' -compose src-over ' . $foreground . ' -composite ' . $bgfile;
    exec($cmdline);
  }
}

$methods = array('Imagick', 'Wand', 'Command line');
foreach ($methods as $m) {
  $start_time = microtime(true);
  for ($i = 0; $i < 4; $i++) {
    test($m);
  }
  $elapsed_time = microtime(true) - $start_time;
  echo 'Method: ' . $m . '; elapsed ' . strval($elapsed_time) . PHP_EOL;
}

Результаты выполнения на локальной машине:
Method: Imagick; elapsed 0.45...
Method: Wand; elapsed 0.82...
Method: Command line; elapsed 0.87...
Результаты выполнения на VPS:
Method: Imagick; elapsed 79.64...
Method: Wand; elapsed 151.64...
Method: Command line; elapsed 46.49...

Что-то тут не так...

inkanus-gray, 17 Января 2013

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

PHP / Говнокод #10038

+93

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

class Auth_Yadis_ParanoidHTTPFetcher extends Auth_Yadis_HTTPFetcher {
    function get($url, $extra_headers = null)
    {
    /* неcущественное пропущено */
            if (defined('CURLOPT_NOSIGNAL')) {
                curl_setopt($c, CURLOPT_NOSIGNAL, true);
            }

            if (!$this->allowedURL($url)) {
                Auth_OpenID::log("Fetching URL not allowed: %s",
                                 $url);
                return null;
            }

            curl_setopt($c, CURLOPT_WRITEFUNCTION,
                        array($this, "_writeData"));
            curl_setopt($c, CURLOPT_HEADERFUNCTION,
                        array($this, "_writeHeader"));

            if ($extra_headers) {
                curl_setopt($c, CURLOPT_HTTPHEADER, $extra_headers);
            }

            $cv = curl_version();
            if(is_array($cv)) {
              $curl_user_agent = 'curl/'.$cv['version'];
            } else {
              $curl_user_agent = $cv;
            }
            curl_setopt($c, CURLOPT_USERAGENT,
                        Auth_OpenID_USER_AGENT.' '.$curl_user_agent);
            curl_setopt($c, CURLOPT_TIMEOUT, $off);
            curl_setopt($c, CURLOPT_URL, $url);

            if (defined('Auth_OpenID_VERIFY_HOST')) {
                // set SSL verification options only if Auth_OpenID_VERIFY_HOST
                // is explicitly set, otherwise use system default.
                if (Auth_OpenID_VERIFY_HOST) {
                    curl_setopt($c, CURLOPT_SSL_VERIFYPEER, true);
                    curl_setopt($c, CURLOPT_SSL_VERIFYHOST, 2);
                    if (defined('Auth_OpenID_CAINFO')) {
                        curl_setopt($c, CURLOPT_CAINFO, Auth_OpenID_CAINFO);
                    }
                } else {
                    curl_setopt($c, CURLOPT_SSL_VERIFYPEER, false);
                }
            }

            curl_exec($c);
    /* неинтересное пропущено */
    }
    
    function post($url, $body, $extra_headers = null)
    {
        if (!$this->canFetchURL($url)) {
            return null;
        }

        $this->reset();

        $c = curl_init();

        if (defined('CURLOPT_NOSIGNAL')) {
            curl_setopt($c, CURLOPT_NOSIGNAL, true);
        }

        curl_setopt($c, CURLOPT_POST, true);
        curl_setopt($c, CURLOPT_POSTFIELDS, $body);
        curl_setopt($c, CURLOPT_TIMEOUT, $this->timeout);
        curl_setopt($c, CURLOPT_URL, $url);
        curl_setopt($c, CURLOPT_WRITEFUNCTION,
                    array($this, "_writeData"));

        if (defined('Auth_OpenID_VERIFY_HOST')) {
            // set SSL verification options only if Auth_OpenID_VERIFY_HOST
            // is explicitly set, otherwise use system default.
            if (Auth_OpenID_VERIFY_HOST) {
                curl_setopt($c, CURLOPT_SSL_VERIFYPEER, true);
                curl_setopt($c, CURLOPT_SSL_VERIFYHOST, 2);
                if (defined('Auth_OpenID_CAINFO')) {
                    curl_setopt($c, CURLOPT_CAINFO, Auth_OpenID_CAINFO);
                }
            } else {
                curl_setopt($c, CURLOPT_SSL_VERIFYPEER, false);
            }
        }

        curl_exec($c);
/* to be continued */

Фрагмент едва ли не самой популярной библиотеки OpenID, а именно клиентской части: http://janrain.com/openid-enabled/
Всё бы было хорошо, но залогиниться, используя лайвджорналовский опенайдишник, не получается. По форумам поползли слухи, что ЖЖ не полностью поддерживает протокол OpenID (хотя протокол разработал Фицпатрик, один из создателей LiveJournal); что он метод POST не поддерживает, поэтому его нужно менять на GET; предлагались совершенно безумные хаки, которые на самом деле не работают...

А ларчик просто открывался. Для поддержки ЖЖ достаточно в приведённый код добавить пару строк. Открыть спойлер или кто-нибудь угадает?

inkanus-gray, 25 Апреля 2012

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

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

+102

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

const n = 50;
type vec = array [1..n*4] of system.word;
function vprod(const a, b: vec): Cardinal;
  var i: longInt;
  begin
    result := 0;
    for i := 1 to high(vec) do inc(result, a[i] * b[i]);
  end;
function vprod_asm1(const a, b: vec): Cardinal; assembler;
  asm
     push ebx
     push ecx
     push edx
     push esi
     push edi
     xor ebx, ebx
     mov ecx, n*4
     mov esi, a
     mov edi, b
     xor eax, eax
     cld
  @@l:
     mov   ax, word ptr [esi]
     lea   esi, [esi+2]
     mul   word ptr [edi]
     lea   edi, [edi+2]
     shl   edx, 16
     mov   dx, ax
     add   ebx, edx
     dec   ecx
     jne   @@l
     mov   eax, ebx
     pop edi
     pop esi
     pop edx
     pop ecx
     pop ebx
  end;
function vprod_asm2(const a, b: vec): Cardinal; assembler;
  asm
    push ebx
    push ecx
    push edx
    push esi
    push edi
    xor ebx, ebx
    mov ecx, n*4
    mov esi, a
    mov edi, b
    xor eax, eax
    cld
  @@l:
    lodsw
    movzx   edx, WORD PTR [edi]
    imul    edx
    lea     edi, [edi+2]
    add     ebx, eax
    loop  @@l
    mov   eax, ebx
    pop edi
    pop esi
    pop edx
    pop ecx
    pop ebx
  end;
function vprod_mmx (const a, b: vec): Cardinal; assembler;
  var muls: record l, h: Cardinal end;
  asm
    push ebx
    push ecx
    push esi
    push edi
    mov ecx, n
    mov esi, a
    mov edi, b
    xor eax, eax
    lea     ebx, muls
  @@l:
    db $0F,$6F,$06  // movq    mm0, [esi]
    db $0F,$F5,$07  // pmaddwd mm0, [edi]
    lea     esi, [esi+8]
    db $0F,$7F,$03  // movq    [ebx], mm0
    lea     edi, [edi+8]
    add     eax, [ebx]
    add     eax, [ebx+4]
    loop    @@l
    db $0F,$77 // emms
    pop edi
    pop esi
    pop ecx
    pop ebx
  end;

По просьбам трудящихся публикую модифицированную версию примера MMXTEST.PAS из комплекта компилятора TMT Pascal. Программа находит скалярное произведение двух векторов. Далее должен быть основной блок с фрагментами типа for i := 1 to 100000 do vprod(a, b); , которые я не стал публиковать ввиду ограничений. Функция vprod_asm1 — почти оригинальный код TMT, функция vprod_asm2 — мой оптимизированный вариант. Результаты запуска на двух машинах (таймер получал по RDTSC):
AMD K6-2-333 МГц, FSB 66 МГц.

Delphi7:
Pascal = 0.550 sec.
Asm x86 (original) = 1.034 sec.
Asm x86 (optimized) = 0.490 sec.
Asm MMX = 0.130 sec.
С директивой $O- первый результат 0.853 sec.
Замена loop на dec ecx + jne увеличивает результаты на 0,015 c.

FPC:
Pascal = 1.387 sec.
Asm x86 (original) = 1.199 sec.
Asm x86 (optimized) = 0.510 sec.
Asm MMX = 0.124 sec.

TMT:
Pascal = 0.914 sec.
Asm x86 (original) = 1.037 sec.
Asm x86 (optimized) = 0.494 sec.
Asm MMX = 0.126 sec.

VP:
Pascal = 0.520 sec.
Asm x86 (original) = 1.033 sec.
Asm x86 (optimized) = 0.493 sec.
Asm MMX = 0.146 sec.
С директивами $Q+,R+ первый результат 1.032 sec.
С директивой $Speed- первый результат 0.731 sec.

------------------------------
Celeron 1,86 ГГц, FSB 533 МГц.

Delphi7:
Pascal = 0.025 sec.
Asm x86 (original) = 0.091 sec.
Asm x86 (optimized) = 0.082 sec.
Asm MMX = 0.044 sec.

TMT:
Pascal = 0.109 sec.
Asm x86 (original) = 0.087 sec.
Asm x86 (optimized) = 0.079 sec.
Asm MMX = 0.042 sec.

inkanus-gray, 25 Сентября 2011

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

PHP / Говнокод #7139

+163

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

Example #3 preg_replace_callback() using recursive structure to handle encapsulated BB code
<?php
$input = "plain [indent] deep [indent] deeper [/indent] deep [/indent] plain";

function parseTagsRecursive($input)
{

    $regex = '#\[indent]((?:[^[]|\[(?!/?indent])|(?R))+)\[/indent]#';

    if (is_array($input)) {
        $input = '<div style="margin-left: 10px">'.$input[1].'</div>';
    }

    return preg_replace_callback($regex, 'parseTagsRecursive', $input);
}

$output = parseTagsRecursive($input);

echo $output;
?>

Не знаю, баян или нет. Поиском не смог найти preg_replace_callback на этом сайте.
В таком недлинном коде есть очень аппетитное дерьмецо (кроме языка). Если в качестве $input взять строку подлиннее, то интерпретатор, как Чак Норрис, сосчитает до бесконечности. Исправляется добавлением одного символа к коду.

inkanus-gray, 03 Июля 2011

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

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

+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

Procedure MakeChain(x: real; var a: array of word); (* Процедура раскладывает вещественное число в цепную дробь *)
  var 
    i: byte;
  begin
    i:=0;
    Repeat
      a[i]:=Int(x); x:=1/(x-a[i]); i:=i+1
    Until (abs(1/x) < epsilon) or (Int(x) = 0) (* NB! *)
  end;
Procedure MakeFrac(a: array of word; var AN, BN: word); (* Процедура собирает обыкновенную дробь из цепной дроби *)
  var
    i: byte; AP, BP: word; temp: word;
  begin
    AN:=1; AP:=0; BN:=a[1]; BP:=1; i:=2;
    Repeat
      temp:=AN; AN:=AN*a[i]+AP; AP:=temp;
      temp:=BN; BN:=BN*a[i]+BP; BP:=temp;
      i:=i+1
    Until a[i] = 0 (* NB! *)
  end;
Function PowerInt(x: real; p: longint): real; (* возведение числа в целую степень *)
  var
    R: real;
  begin
    R:=1; if p<0 then x:=1/x; p:=abs(p);
    Repeat
      if p and 1 = 1 then R:=R*x;
      p:=p shr 1;
      if p<>0 then x:=sqr(x)
    Until p=0;
    PowerInt:=R
  end;
Function Power(x: real; p: real): real;
  var
    y: real;
    z: array[0..16000 div sizeof(word)] of word;
    a, b: word;
  begin
    y:=PowerInt(x, Trunc(p)) * exp(Frac(p) * ln(abs(x)));
    if x<0 then
      begin
        MakeChain(Frac(p), z);
        MakeFrac(z, a, b);
        if Odd(b) then
          begin
            if Odd(a) then y:=-y (* если числитель и знаменатель показателя степени нечётные, меняем знак результата *)
          end
        else
          begin
            (* NB! В случае чётного знаменателя показателя степени результат комплексный. Забьём на это *)
          end	
      end;
    Power:=y
  end;

Инновационный алгоритм, написанный мной лет 12 тому назад, позволяющий возводить отрицательные числа в дробную степень.
Жанру сайта вполне соответствует, то есть не без говнокода.

inkanus-gray, 23 Декабря 2010

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

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