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

    0

    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 ProcessTerminate(dwPID:Cardinal):Boolean;
    var
     hProcess:THandle;
    begin
     Result:=false;
     if GetLastError()<> ERROR_SUCCESS  then exit;
     hProcess := OpenProcess(PROCESS_TERMINATE, FALSE, dwPID);
     if hProcess =0  then exit;
     if not TerminateProcess(hProcess, DWORD(-1))then exit;
     CloseHandle( hProcess );
     if GetLastError() <>  ERROR_SUCCESS then exit;
     Result:=true;
    end;

    Никогда - никогда, никогда, никогда - НЕ ПИШИТЕ код по ночам.

    CTEPTOP, 20 Февраля 2017

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

    +1

    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
    procedure TForm1.btn1Click(Sender: TObject);
    
    var
      s, i: Byte;
      prg: Byte;
      fs: Tfilestream; JPEG: TJPEGImage;  Bitmap: TBitmap;  oldindex: Byte;
      iCounterPerSec: TLargeInteger;  
      C1, C2: TLargeInteger;
    label
      ss;
    begin
    
      pb1.Position := 0;
      ComboBox1.Enabled := False;
      DateTimePicker2.Enabled := False;
      DateTimePicker1.Enabled := False;
      Button3.Enabled := False;
      Button1.Enabled := False;
      SpeedButton1.Enabled := False;
      chk1.Enabled := False;
      chk2.Enabled := False;
      btn1.Enabled := False;
      txt := 'Подготовка отчёта, подождите... ~ ?';
      oldindex := ComboBox1.ItemIndex;
    
      for i := 0 to ComboBox1.Items.Count do
      begin
        QueryPerformanceFrequency(iCounterPerSec);
        QueryPerformanceCounter(C1);
        ComboBox1.ItemIndex := i;
        Button1.Click;
        inc(prg);
        pb1.Position := prg;
        if AnsiRightStr(Combobox1.Text, 6) <> 'стакан' then
        begin
          Chart1.SaveToBitmapFile(Path + 'Report\~temp.tmp');
          JPEG := TJPEGImage.Create;
          Bitmap := TBitmap.Create;
    
          try
            Bitmap.LoadFromFile(path + 'Report\~temp.tmp');
            Bitmap.Canvas.LineTo(0, 0);
            Bitmap.Canvas.Font.Name := 'Courier New';
            Bitmap.Canvas.Font.Size := 10;
            Bitmap.Canvas.TextOut(25, 5, '  Дата и время выдачи: ' + datetostr(date)
              + ' ' + timetostr(time) + ' |');
            JPEG.Assign(Bitmap);
            JPEG.CompressionQuality := 85;
            JPEG.Compress;
            Image1.Picture.Assign(JPEG);
    
          finally
            JPEG.Free;
            Bitmap.Free;
          end;
          DeleteFile(path + 'Report\~temp.tmp');
        end;
    
        if AnsiRightStr(Combobox1.Text, 6) <> 'стакан' then
          Image1.Picture.SaveToFile(path + 'Report\' + Combobox1.Text + '.jpg');
        Application.HandleMessage;
        if i > 0 then
          goto ss;
        QueryPerformanceCounter(C2);
        txt := 'Подготовка отчёта, подождите... ~ ' +
          IntToStr(strtoint(FormatFloat('0', (C2 - C1) / iCounterPerSec)) * 60 div
            60)
          + ' мин';
        ss:
        pb1.Visible := True;
      end;
      prg := 0;
      ComboBox1.ItemIndex := oldindex;
      Button1.Click;
      ComboBox1.Enabled := True;
      DateTimePicker2.Enabled := True;
      DateTimePicker1.Enabled := True;
      Button3.Enabled := True;
      Button1.Enabled := True;
      SpeedButton1.Enabled := True;
      chk1.Enabled := True;
      chk2.Enabled := True;
      btn1.Enabled := True;
      txt := 'Построение графика...';
    end;

    Программа просмотра архива температурных датчиков. Работает неплохо, со своими обязанностями справляется.
    Полный исходный код проекта с откомпилированным екзешником и базой можно взять здесь: https://yadi.sk/d/lM7TrPJ33EFeDJ

    65536bytesfree, 19 Февраля 2017

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

    +1

    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
    {Автор Зорков Игорь - zorkovigor@mail.ru}
    
    procedure TForm1.RefreshInfo;
    var
      i, ProcessCount: Integer;
      Processes: TProcesses;
      CPU, CPUIdle: Extended;
    begin
      TickCountOld:= GetTickCount - TickCount;
      TickCount:= GetTickCount;
      ProcessCount:= GetProcesses(Processes);
      NewPIDList.Clear;
      for i:= 0 to ProcessCount - 1 do
        NewPIDList.Add(IntToStr(Processes[i].PID));
      if (NewPIDList.Text <> PIDList.Text) then
      begin
        if NewPIDList.Count > 0 then
        begin
          for i:= 0 to NewPIDList.Count - 1 do
          begin
            if PIDList.IndexOf(NewPIDList.Strings[i]) = -1 then
            begin
              SetLength(ProcessInfo, Length(ProcessInfo) + 1);
              ProcessInfo[ProcessInfoList.Count]:= TProcessInfo.Create;
              ProcessInfo[ProcessInfoList.Count].Process:= Processes[i].Process;
              ProcessInfo[ProcessInfoList.Count].PID:= Processes[i].PID;
              CPU:= Int64(Processes[i].KernelTime.dwLowDateTime or (Processes[i].KernelTime.dwHighDateTime shr 32)) + Int64(Processes[i].UserTime.dwLowDateTime or (Processes[i].UserTime.dwHighDateTime shr 32));
              ProcessInfo[ProcessInfoList.Count].CPU:= CPU;
              ProcessInfo[ProcessInfoList.Count].CPUDelta:= CPU;
              if bRefreshFirstTime then
                ProcessInfo[ProcessInfoList.Count].New:= 2
              else
                ProcessInfo[ProcessInfoList.Count].New:= 0;
              ProcessInfo[ProcessInfoList.Count].Terminated:= 20;
              ProcessInfoList.AddObject(NewPIDList.Strings[i], ProcessInfo[ProcessInfoList.Count]);
            end;
          end;
        end;
    
        if PIDList.Count > 0 then
        begin
          for i:= 0 to PIDList.Count - 1 do
          begin
            if NewPIDList.IndexOf(PIDList.Strings[i]) = -1 then
            begin
              if ProcessInfoList.IndexOf(PIDList.Strings[i]) <> -1 then
              begin
                if (ProcessInfoList.Objects[ProcessInfoList.IndexOf(PIDList.Strings[i])] as TProcessInfo).Terminated = 20 then
                  (ProcessInfoList.Objects[ProcessInfoList.IndexOf(PIDList.Strings[i])] as TProcessInfo).Terminated:= 0;
              end;
            end;
          end;
        end;
    
        PIDList.Assign(NewPIDList);
      end;
    
      CPUIdle:= 0;
      for i:= 0 to ProcessCount - 1 do
      begin
        CPU:= Int64(Processes[i].KernelTime.dwLowDateTime or (Processes[i].KernelTime.dwHighDateTime)) + Int64(Processes[i].UserTime.dwLowDateTime or (Processes[i].UserTime.dwHighDateTime));
        (ProcessInfoList.Objects[ProcessInfoList.IndexOf(IntToStr(Processes[i].PID))] as TProcessInfo).CPUDelta:= CPU - (ProcessInfoList.Objects[ProcessInfoList.IndexOf(IntToStr(Processes[i].PID))] as TProcessInfo).CPU;
        (ProcessInfoList.Objects[ProcessInfoList.IndexOf(IntToStr(Processes[i].PID))] as TProcessInfo).CPU:= CPU;
        if Processes[i].PID <> 0 then
          CPUIdle:= CPUIdle + (ProcessInfoList.Objects[ProcessInfoList.IndexOf(IntToStr(Processes[i].PID))] as TProcessInfo).CPUDelta;
      end;
      if CPUIdle > 0 then
        (ProcessInfoList.Objects[ProcessInfoList.IndexOf('0')] as TProcessInfo).CPUDelta:= CPUIdle
      else
        (ProcessInfoList.Objects[ProcessInfoList.IndexOf('0')] as TProcessInfo).CPUDelta:= 100;

    Зачем юзать переменные? Это, блять, грех. Бог покарает. Обратите внимание, как этот долбоёб приводит типы, и сколько раз обращается к объекту по его индексу.

    Автор, возьми меч из папье-маше и отсеки себе руки по локоть. По локоть, блядь!..

    rotretS, 16 Февраля 2017

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

    +5

    1. 1
    Access violation at address 00403AC2 in module 'delphi32.exe'. Read at address 00000041.

    Borland_Delphi_7, 03 Февраля 2017

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

    +1

    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
    type
    TReadCoils = array [0..3] of word;
    
    CONST crctab: ARRAY[0..255] OF WORD = (
        $0000, $C0C1, $C181, $0140, $C301, $03C0, $0280, $C241,
        $C601, $06C0, $0780, $C741, $0500, $C5C1, $C481, $0440,
        $CC01, $0CC0, $0D80, $CD41, $0F00, $CFC1, $CE81, $0E40,
        $0A00, $CAC1, $CB81, $0B40, $C901, $09C0, $0880, $C841,
        $D801, $18C0, $1980, $D941, $1B00, $DBC1, $DA81, $1A40,
        $1E00, $DEC1, $DF81, $1F40, $DD01, $1DC0, $1C80, $DC41,
        $1400, $D4C1, $D581, $1540, $D701, $17C0, $1680, $D641,
        $D201, $12C0, $1380, $D341, $1100, $D1C1, $D081, $1040,
        $F001, $30C0, $3180, $F141, $3300, $F3C1, $F281, $3240,
        $3600, $F6C1, $F781, $3740, $F501, $35C0, $3480, $F441,
        $3C00, $FCC1, $FD81, $3D40, $FF01, $3FC0, $3E80, $FE41,
        $FA01, $3AC0, $3B80, $FB41, $3900, $F9C1, $F881, $3840,
        $2800, $E8C1, $E981, $2940, $EB01, $2BC0, $2A80, $EA41,
        $EE01, $2EC0, $2F80, $EF41, $2D00, $EDC1, $EC81, $2C40,
        $E401, $24C0, $2580, $E541, $2700, $E7C1, $E681, $2640,
        $2200, $E2C1, $E381, $2340, $E101, $21C0, $2080, $E041,
        $A001, $60C0, $6180, $A141, $6300, $A3C1, $A281, $6240,
        $6600, $A6C1, $A781, $6740, $A501, $65C0, $6480, $A441,
        $6C00, $ACC1, $AD81, $6D40, $AF01, $6FC0, $6E80, $AE41,
        $AA01, $6AC0, $6B80, $AB41, $6900, $A9C1, $A881, $6840,
        $7800, $B8C1, $B981, $7940, $BB01, $7BC0, $7A80, $BA41,
        $BE01, $7EC0, $7F80, $BF41, $7D00, $BDC1, $BC81, $7C40,
        $B401, $74C0, $7580, $B541, $7700, $B7C1, $B681, $7640,
        $7200, $B2C1, $B381, $7340, $B101, $71C0, $7080, $B041,
        $5000, $90C1, $9181, $5140, $9301, $53C0, $5280, $9241,
        $9601, $56C0, $5780, $9741, $5500, $95C1, $9481, $5440,
        $9C01, $5CC0, $5D80, $9D41, $5F00, $9FC1, $9E81, $5E40,
        $5A00, $9AC1, $9B81, $5B40, $9901, $59C0, $5880, $9841,
        $8801, $48C0, $4980, $8941, $4B00, $8BC1, $8A81, $4A40,
        $4E00, $8EC1, $8F81, $4F40, $8D01, $4DC0, $4C80, $8C41,
        $4400, $84C1, $8581, $4540, $8701, $47C0, $4680, $8641,
        $8201, $42C0, $4380, $8341, $4100, $81C1, $8081, $4040 );
    
     //ôóíêöèÿ íàõîæäåíèÿ êîíòðîëüíîé ñóììû
    function crc16(twoSym:array of Word; size:word):Word;
    var
     i:Integer;
     crc:Word;
    begin
      crc:=$FFFF;
    
      for i:=0 to ((size div 2) -1) do
    
      begin
        crc:=  (crc shr 8) xor CrcTab[(crc and $FF) xor twoSym[i]];
      end;
       Result:=(crc shr 8) or (crc shl 8);
    end;
    function ReadCoils(DeviceAddress: byte; StartingAddress:word; QuantityCoils : word): TReadCoils;
      var
    
        Datagramm: Array[0..3] of Word;
         ToPort: Array[0..5] of word;
    begin
        Datagramm[0]:=TwoBytesToWord(DeviceAddress,$3);
        Datagramm[1]:=TwoBytesToWord(hi(StartingAddress),lo(StartingAddress));
        Datagramm[2]:=TwoBytesToWord(hi(QuantityCoils),lo(QuantityCoils));
         ToPort[0]:=hi(datagramm[0]);
         ToPort[1]:=lo(datagramm[0]);
         ToPort[2]:=hi(datagramm[1]);
         ToPort[3]:=lo(datagramm[1]);
         ToPort[4]:=hi(datagramm[2]);
         ToPort[5]:=lo(datagramm[2]);
         Datagramm[3]:=crc16(toport,12);
    end;

    Вот такими костылями заставляем вычисляться CRC-16 для Modbus в Readcoils

    untitled_001, 23 Января 2017

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

    −3

    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
    type
      TheCurrency = class(TObject)
            id: Integer;
            name: String;
      end;
    
      TheWHouse = class(TObject)
            id: Integer;
            name: String;
      end;
    
      TheProvider = class(TObject)
            id: Integer;
            name: String;
      end;
    
      TheNds = class(TObject)
            nds: Double;
      end;

    tucvbif, 16 Января 2017

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

    0

    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
    lst:=proclist.Selected;
      if assigned(lst) then
      begin
        tp:=tmyproc(lst.SubItems.Objects[0]);
        S:=tp.exename;
        P:=tp.PID;
      end
      else
      begin
        S:='';
        P:=0;
      end;
      ID:=-1;
      proclist.Items.BeginUpdate;
      try
      //////////////////////////////////////////////////////////
      if prlist.Count > 0 then
      while proclist.Items.Count > prlist.Count do
      begin
        lst:=proclist.Items[proclist.Items.Count-1];
        lst.Delete;
      end;
    
      while proclist.Items.Count < prlist.Count do
      with proclist.Items.Add do
      begin
        caption:='';
        subitems.Add('');
        subitems.add('');
        subitems.add('');
        subitems.add('');
        subitems.add('');
        subitems.add('');
      end;
     /////////////////////////////////////////////////////////
      for i:=0 to prlist.Count -1 do
      begin
        tp:=(prlist.Objects[i] as tmyproc);
        with proclist.items[i] do
        begin
          if tp.isHidden then
          begin
            Inc(HidProcs);
            ImageIndex:=8;
          end
          else
          ImageIndex:=7;
          if (s <> emptystr) and (p=tp.pid) and (s=tp.exename) then
          ID:=Index;
          Caption:=tp.ExeName;
          with Subitems do
          begin
            Objects[0].Free;
            Objects[0]:=tp;
            Strings[0]:=tp.ModulePath;
          end;
          subitems.Strings[1]:=IntToStr(tp.PID);

    Ваш ListView всё ещё съезжает при обновлении? Тогда мы идём к Вам.

    rotretS, 15 Января 2017

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

    0

    1. 1
    Знаете ли Вы, что в FreePascal блоки try..finally/except не работают в контексте DLL?

    Dr_Stertor, 10 Января 2017

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

    +1

    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
    program XMLParser;
     
    {$APPTYPE CONSOLE}
     
    {$R *.res}
     
    uses
      System.SysUtils,
      Xml.XMLDoc, XMLIntf;
     
    var XMLDocument1 : TXMLDocument;
        Node : IXMLNode;
     
    begin
    XMLDocument1:=TXMLDocument.Create('Путь до файла\Text1.XML');
    XMLDocument1.LoadFromFile('Путь до файла\Text1.XML');
    XMLDocument1.Active := true;
    Node.GetAttribute(WideString('x'));
    WriteLn;
    XMLDocument1.Active := false;
    end.

    Путь до файла. бгг

    chizztectep, 10 Января 2017

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

    0

    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
    if not DoubleBuffered then
        begin
          BufferDC := CreateCompatibleDC(DC);
          // CreateCompatibleDC(DC) return 0 if Drawing takes place to MemDC(buffer):
          // return <> 0 => need to double buffer || return = 0 => no need to double buffer
          if BufferDC <> 0 then
          begin
            // Using the cache if possible
            if FIsCachedBuffer or FIsFullSizeBuffer then
            begin
              // Create cache if need
              if CacheBitmap = 0 then
              begin
                BufferBitMap := CreateCompatibleBitmap(DC, ClientWidth, ClientHeight);
                // Assign to cache if need
                if FIsCachedBuffer then
                  CacheBitmap := BufferBitMap;
              end
              else
                BufferBitMap := CacheBitmap;
    
              // Assign region for minimal overdraw
              Region := CreateRectRgnIndirect(UpdateRect);//0, 0, UpdateRect.Width, UpdateRect.Height);
              SelectClipRgn(BufferDC, Region);
            end
            else
              // Create buffer
              BufferBitMap := CreateCompatibleBitmap(DC, RectWidth(UpdateRect), RectHeight(UpdateRect));
            // Select buffer bitmap
            SelectObject(BufferDC, BufferBitMap);
            // [change coord], if need
            // Moving update region to the (0,0) point
            if not(FIsCachedBuffer or FIsFullSizeBuffer) then
            begin
              GetViewportOrgEx(BufferDC, SaveViewport);
              SetViewportOrgEx(BufferDC, -UpdateRect.Left + SaveViewport.X, -UpdateRect.Top + SaveViewport.Y, nil);
            end;
          end
          else
            BufferDC := DC;
        end
        else
          BufferDC := DC;
    //.......

    https://habrahabr.ru/post/318876/

    gost, 06 Января 2017

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