1. Список говнокодов пользователя brutushafens

    Всего: 23

  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)