1. Pascal / Говнокод #15803

    +81

    1. 01
    2. 02
    3. 03
    4. 04
    5. 05
    6. 06
    7. 07
    8. 08
    9. 09
    10. 10
    11. 11
    12. 12
    13. 13
    14. 14
    15. 15
    16. 16
    17. 17
    18. 18
    19. 19
    20. 20
    21. 21
    22. 22
    23. 23
    24. 24
    procedure SetCurrentThreadName(const AName: String);
    type
      TThreadNameInfo = record
          RecType: LongWord;
          Name: PChar;
          ThreadID: LongWord;
          Flags: LongWord;
        end;
    var
      LThreadNameInfo: TThreadNameInfo;
    begin
      with LThreadNameInfo do
      begin
        RecType := $1000;
        Name := PChar(AName);
        ThreadID := $FFFFFFFF; // -1 - текущий поток; также сюда можно вставить ID другого потока
        Flags := 0;
      end;
      try
        RaiseException($406D1388, 0, SizeOf(LThreadNameInfo) div SizeOf(LongWord),
          PDWord(@LThreadNameInfo));
      except
      end;
    end;

    Попытка создать именованный поток.
    Не хак. (http://msdn.microsoft.com/en-us/library/xcb2z8hs%28VS.71%29.aspx)

    brutushafens, 20 Апреля 2014

    Комментарии (6)
  2. Pascal / Говнокод #15801

    +84

    1. 01
    2. 02
    3. 03
    4. 04
    5. 05
    6. 06
    7. 07
    8. 08
    9. 09
    10. 10
    11. 11
    12. 12
    13. 13
    14. 14
    15. 15
    16. 16
    17. 17
    18. 18
    19. 19
    20. 20
    21. 21
    22. 22
    23. 23
    24. 24
    25. 25
    26. 26
    27. 27
    28. 28
    29. 29
    30. 30
    31. 31
    32. 32
    33. 33
    34. 34
    35. 35
    36. 36
    37. 37
    38. 38
    39. 39
    40. 40
    41. 41
    {*********** PosEx ***********}
    function Posex(const substr,str:string; const startloc:integer):integer;
    {Search for "substr" in "str" starting at "startloc" return 0 or the start
     postion where "substr" was found}
    var
      i, j,k,ssLen, sLen, stop:integer;
      a:char;
    begin
      result:=0;
      ssLen:=length(substr);
      slen:=length(str);
      stop:=slen-sslen+1; {highest feasible start location for substring}
      if (ssLen=0) or (sslen>sLen) then exit;
      a:=substr[1];  {1st letter of substr}
      i:=startloc; {start search location}
      while (i<=stop) and (result=0) do
      begin
        while (i<=stop) and (a<>str[i]) do inc(i); {find the 1st letter}
        if i<=stop then
        begin
          if sslen=1 then  result:=i {It was a 1 character search, so we're done}
          else
          begin
            j:=2;
            k:=i-1; {back "K" up by 1 so that we can use K+j as the index to the string}
            while (j<=sslen) do
            begin {compare the rest of the substring}
              if (substr[j]<>str[k+j]) then break
              else inc(j); {The letter matched, go to the next+
                       {When we pass the substring end, "while" loop will terminate}
            end;
            if (j>sslen) then
            begin
              result:=i;
              exit;
            end
            else inc(i); {that search failed, look for the next 1st letter match}
          end;
        end;
      end;
    end;

    Несколько вложенных циклов - это НЕ может работать быстро.
    Для сравнения - функция PosEx из StrUtils.pas

    function PosEx(const SubStr, S: string; Offset: Cardinal = 1): Integer;
    var
    I,X: Integer;
    Len, LenSubStr: Integer;
    begin
    if Offset = 1 then
    Result := Pos(SubStr, S)
    else
    begin
    I := Offset;
    LenSubStr := Length(SubStr);
    Len := Length(S) - LenSubStr + 1;
    while I <= Len do
    begin
    if S[i] = SubStr[1] then
    begin
    X := 1;
    while (X < LenSubStr) and (S[I + X] = SubStr[X + 1]) do
    Inc(X);
    if (X = LenSubStr) then
    begin
    Result := I;
    exit;
    end;
    end;
    Inc(I);
    end;
    Result := 0;
    end;
    end;


    А вот что пишет автор:
    The Delphi "Pos" function searches for a
    substring within a string. Later versions of
    Delphi also include a "PosEx" function
    which
    starts the search at a given position so
    multiple calls can return all occurrences.

    This program tests DFF versions of these
    two
    functions. Pos was rewritten to provide a
    base
    of code for PosEx. And PosEx wll provide
    the
    missing function for versions of Delphi
    before
    Delphi 7.

    As an unexpected bonus, it appears that the
    DFF versions of Pos and Posex are slightly
    quicker than the D7 versions.

    brutushafens, 20 Апреля 2014

    Комментарии (3)
  3. Pascal / Говнокод #15761

    +80

    1. 01
    2. 02
    3. 03
    4. 04
    5. 05
    6. 06
    7. 07
    8. 08
    9. 09
    10. 10
    11. 11
    12. 12
    13. 13
    14. 14
    15. 15
    16. 16
    17. 17
    18. 18
    19. 19
    20. 20
    21. 21
    22. 22
    23. 23
    24. 24
    25. 25
    26. 26
    27. 27
    28. 28
    29. 29
    30. 30
    31. 31
    32. 32
    33. 33
    34. 34
    35. 35
    36. 36
    37. 37
    38. 38
    39. 39
    40. 40
    41. 41
    42. 42
    43. 43
    44. 44
    45. 45
    46. 46
    47. 47
    48. 48
    49. 49
    50. 50
    51. 51
    52. 52
    53. 53
    54. 54
    55. 55
    56. 56
    57. 57
    58. 58
    59. 59
    60. 60
    61. 61
    62. 62
    63. 63
    64. 64
    65. 65
    66. 66
    67. 67
    68. 68
    69. 69
    70. 70
    71. 71
    72. 72
    73. 73
    74. 74
    75. 75
    76. 76
    77. 77
    78. 78
    79. 79
    80. 80
    81. 81
    82. 82
    83. 83
    84. 84
    85. 85
    86. 86
    87. 87
    88. 88
    89. 89
    90. 90
    91. 91
    92. 92
    93. 93
    94. 94
    95. 95
    96. 96
    97. 97
    function thttp.Get(URI: string): string;
    var
      newlocation:string;
      redirect:integer;
      contenttype:string;
      i:integer;
      contentencoding:string;
      test:string;
      host:string;
    begin
      redirect:=0;
      headers.clear;
      document.clear;
    
      uri:=stringreplace(uri,'\','/',[rfreplaceall]);
    
      // building the host///
      if request.host <> '' then
      headers.Add(format('Host:%s',[request.host]))
      else
      begin
        i:=pos('://',uri);
        if i>0 then
        begin
          host:=copy(uri,i+3,maxint);
          i:=pos('/',host);
          if i>0 then
          host:=copy(host,1,i-1);
          request.host:=host;
        end
        else
        begin
          i:=pos('/',uri);
          if i>0 then host:=copy(uri,1,i-1)
          else
          host:=uri;
          request.host:=host;
        end;
      end;
    
      if request.referer <> '' then
      headers.Add(format('Referer:%s',[request.referer]));
    
      if request.useragent <> '' then
      headers.Add(format('User-Agent:%s',[request.useragent]));
    
      if request.AcceptEncoding <> '' then
      headers.Add(format('Accept-Encoding:%s',[request.AcceptEncoding]));
    
      if request.contenttype <> '' then
      headers.Add('Content-Type:'+request.contenttype);
    
      if request.connection <> '' then
      headers.add('Connection:'+request.connection);
    
      HTTPMethod('GET',uri);
    
      if allowredirects=true then
      begin
        while (resultcode>=300) and (resultcode<400) do
        begin
          if (maxredirects <> -1) and (redirect > self.MaxRedirects) then break;
          document.clear;
          newlocation:=trim(Headers.Values['Location']);
          if newlocation='' then break;
          if (rightstr(request.host,1) <> '/') and (copy(newlocation,1,1) <> '/') then
          newlocation:='/'+newlocation;
          headers.clear;
          document.clear;
          HTTPMethod('GET',host+newlocation);
          host:=trim(headers.Values['host']);
          if host <> '' then
          request.host:=host;
          inc(redirect);
        end;
      end;
      contenttype:=Headers.Values['Content-Type'];
      contentencoding:=Headers.Values['Content-Encoding'];
      request.contentencoding:=contentencoding;
      request.contenttype:=contenttype;
      if pos('gzip',ansilowercase(contentencoding))>0 then
      begin
        mstream.clear;
        try
          GZDecompressStream(Document, MStream);
          document.Clear;
          document.LoadFromStream(mstream);
          document.Position:=0;
        except
        end;
      end;
      result:=memorystreamtostring(Document);
      if pos('charset=utf-8',ansilowercase(contenttype))>0 then
      test:=utf8toansi(result);
      if test <> '' then
      result:=test;
    end;

    У Булгакова есть цикл рассказов "Записки на манжетах".
    Мой цикл называется "Записки на туалетной бумаге салфетках".

    Итак, "Записки на салфетках. Как я обертывал Synapse".

    brutushafens, 16 Апреля 2014

    Комментарии (3)
  4. Pascal / Говнокод #15729

    +83

    1. 01
    2. 02
    3. 03
    4. 04
    5. 05
    6. 06
    7. 07
    8. 08
    9. 09
    10. 10
    11. 11
    12. 12
    13. 13
    14. 14
    15. 15
    16. 16
    17. 17
    18. 18
    19. 19
    20. 20
    21. 21
    22. 22
    23. 23
    24. 24
    25. 25
    26. 26
    27. 27
    28. 28
    29. 29
    30. 30
    31. 31
    32. 32
    33. 33
    34. 34
    35. 35
    initialization
      //done this way so we can have a separate stack just for FPC under Unix systems
      GStackClass :=
        {$IFDEF USE_VCL_POSIX}
        TIdStackVCLPosix
        {$ELSE}
          {$IFDEF UNIX}
            {$IFDEF KYLIXCOMPAT}
            TIdStackLibc
            {$ENDIF}
            {$IFDEF USE_BASEUNIX}
            TIdStackUnix
            {$ENDIF}
          {$ENDIF}
          {$IFDEF WINDOWS}
          TIdStackWindows
          {$ENDIF}
          {$IFDEF DOTNET}
          TIdStackDotNet
          {$ENDIF}
        {$ENDIF}
      ;
      GStackCriticalSection := TIdCriticalSection.Create;
      {$IFNDEF DOTNET}
        {$IFDEF REGISTER_EXPECTED_MEMORY_LEAK}
      IndyRegisterExpectedMemoryLeak(GStackCriticalSection);
        {$ENDIF}
      {$ENDIF}
    finalization
      // Dont Free. If shutdown is from another Init section, it can cause GPF when stack
      // tries to access it. App will kill it off anyways, so just let it leak
      {$IFDEF FREE_ON_FINAL}
      FreeAndNil(GStackCriticalSection);
      {$ENDIF}
    end.

    Выдержка из IdStack.pas. Без комментариев.

    Предыcтория.
    fastmm постоянно сообщал об утечках памяти в моих программах, использующих Indy: решил разобраться.
    Оказалось, что ошибки возникали при использовании IdStack, по умолчанию этот модуль используют почти все компоненты из палитры.

    brutushafens, 11 Апреля 2014

    Комментарии (17)
  5. Pascal / Говнокод #15658

    +133

    1. 01
    2. 02
    3. 03
    4. 04
    5. 05
    6. 06
    7. 07
    8. 08
    9. 09
    10. 10
    11. 11
    12. 12
    13. 13
    14. 14
    15. 15
    16. 16
    17. 17
    18. 18
    19. 19
    20. 20
    21. 21
    22. 22
    23. 23
    24. 24
    25. 25
    26. 26
    27. 27
    procedure tproxythread.execute;
    var
      doc: IHtmlDocument2;
      temp,parsed:string;
      v:olevariant;
      i:integer;
    begin
      coinitialize(nil);
      try
        for i:=0 to links.count -1 do
        begin
          temp:=http.LoadContent(links[i]);
          Doc:=coHTMLDocument.Create as IHTMLDocument2;
          V:=VarArrayCreate([0,0], varVariant);
          V[0]:=temp;
          Doc.Write(PSafeArray(TVarData(v).VArray));
          reg.InputString:=doc.body.outerText;
          if reg.Exec then
          repeat
            parsed:= reg.Match [0];
            proxy.add(parsed);
          until not reg.ExecNext;
        end;
      finally
        couninitialize;
      end;
    end;

    Вы все еще парсите webbrowser-ом? Тогда мы идем к вам!..

    Stertor, 03 Апреля 2014

    Комментарии (6)
  6. Pascal / Говнокод #15627

    +81

    1. 01
    2. 02
    3. 03
    4. 04
    5. 05
    6. 06
    7. 07
    8. 08
    9. 09
    10. 10
    11. 11
    12. 12
    13. 13
    14. 14
    15. 15
    16. 16
    17. 17
    18. 18
    19. 19
    20. 20
    21. 21
    22. 22
    23. 23
    24. 24
    25. 25
    26. 26
    27. 27
    28. 28
    29. 29
    30. 30
    31. 31
    32. 32
    33. 33
    program matr;
    uses
       crt;
    var
        mas:array [1..100] of integer;
        i,n,imin,imax,min,max,razn:integer;
    begin
    clrscr;
    imax:=1;
    imin:=1;
    randomize;
    write('Введите количество элементов: ');
    readln(n);
    for i:=1 to n do
     begin
      mas[i]:=random(10)-5;
      write(mas[i]:4);
      if mas[i]>mas[imax] then
      begin
      imax:=i;
      end
      else
      if (mas[i]<mas[imin]) then
      begin
      imin:=i;
      end;
      end;
    writeln;
    writeln('MAX[',imax,']:=',mas[imax]);
    writeln('MIN[',imin,']:=',mas[imin]);
    razn:=mas[imax]+mas[imin];
    writeln('Сумма MAX и MIN:=',razn);
     end.

    Написано by "ТАМБОВСКИЙ ВОЛК. Профессионал".
    Знатное говнецо нынче пишут "профессионалы".
    http://www.programmersforum.ru/showthread.php?t=98747

    gost, 31 Марта 2014

    Комментарии (37)
  7. Pascal / Говнокод #15626

    +78

    1. 01
    2. 02
    3. 03
    4. 04
    5. 05
    6. 06
    7. 07
    8. 08
    9. 09
    10. 10
    11. 11
    12. 12
    13. 13
    14. 14
    15. 15
    16. 16
    DynArray = [1..2] of real;
    var
    A : ^DinArray;
    n, i : word;
    BEGIN
    write('Укажите размер массива:');
    readln(n);
    GetMem(A,n*6);
    . . .
    {$R-}
    for i:=1 to n do
    A[i]:=random;
    . . . {любые действия с элементами масссива}
    {$R+}
    FreeMem(A,n*6)
    END.

    Просто феерический говнокод на "Pascal".
    http://logi.cc/dinamicheskaya-pamyat-primer-23/

    gost, 31 Марта 2014

    Комментарии (3)
  8. Pascal / Говнокод #15625

    +88

    1. 01
    2. 02
    3. 03
    4. 04
    5. 05
    6. 06
    7. 07
    8. 08
    9. 09
    10. 10
    11. 11
    12. 12
    13. 13
    14. 14
    15. 15
    16. 16
    17. 17
    18. 18
    19. 19
    20. 20
    21. 21
    var 
      s: string := '1 2 4 8 16 32 64 128 256 512';
      sum: integer;
      num,p: integer;
      numstr: string;
    begin
      sum := 0;
      while s.Length>0 do
      begin
        while s[1]=' ' do // Удаление лидирующих пробелов
          Delete(s,1,1);
        p := Pos(' ',s); // Поиск следующего пробела
        if p=0 then      // Если он не найден, то до конца строки находится последнее число
          p := s.Length;
        numstr := Copy(s,1,p);
        Delete(s,1,p);
        num := StrToInt(numstr);
        sum += num;
      end;
      writeln('Сумма чисел строки равна ',sum);
    end.

    "Pascal" не умеет в split?
    http://pascalabc.net/wiki/index.php/Строки_и_символы._Тексты_программ

    gost, 31 Марта 2014

    Комментарии (34)
  9. Pascal / Говнокод #15577

    +96

    1. 01
    2. 02
    3. 03
    4. 04
    5. 05
    6. 06
    7. 07
    8. 08
    9. 09
    10. 10
    11. 11
    12. 12
    13. 13
    14. 14
    15. 15
    16. 16
    17. 17
    18. 18
    19. 19
    {$APPTYPE CONSOLE}
    uses SysUtils;
    function Add(const x: Integer; i: Integer): Integer; overload;
      begin
        Result := x + i
      end;
    
    function Add(const x: PChar; i: Integer): PChar; overload;
      var
        x1: Integer absolute x;
      begin
        Integer(Result) := x1 + i
      end;
    
    
    const s: PChar = 'KoKoKoBormondos';
    begin
      Writeln (StrLen(Add(s, 5)))
    end.

    http://govnokod.ru/15510#comment221692

    gost, 26 Марта 2014

    Комментарии (12)
  10. Pascal / Говнокод #15558

    +86

    1. 01
    2. 02
    3. 03
    4. 04
    5. 05
    6. 06
    7. 07
    8. 08
    9. 09
    10. 10
    11. 11
    12. 12
    13. 13
    function RealToStr(X: Real; Count: Integer): String;//Count - количество цифр после запятой
    var S: String;
        N: Integer;
    begin
      S:=FloatToStr(X); //после запятой - длинная последовательность цифр
    //DecimalSeparator - константа, содержащая истинный разделитель целой и дробной частей числа
     N:=Pos(DecimalSeparator, S); //позиция запятой в строке
    //вычисляем длину строки с нужным количеством знаков после запятой:
      if N=0//если в строке нет запятой - это целое число, и
        then N:=Length(S)//тогда просто выводим это число
        else N:=N+Count;//иначе вычисляем длину строки
      Result:=Copy(S, 1, N);//копируем часть строки в результат
    end;

    Говно на говне сидит и говном погоняет.
    http://www.delphi-manual.ru/work-with-strings.php

    gost, 23 Марта 2014

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