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

    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
    // реализация интерфейса IArguments2 для самодельного скриптового движка, aka vbs to exe
    
    unit Arguments;
    
    interface
    
    uses
      Windows, ComObj, ActiveX, Stub_TLB, SysUtils,WSHNamedArguments,WSHUnNamedArguments, CmdUtils;
    
    type
      TIarguments=class(TAutoObject, IArguments2, IEnumVariant)
          FAArgs:array of WideString;
          FWSHNamedArguments:TIWSHNamedArguments;
          FWSHUnNamedArguments:TIWSHUnNamedArguments;
          function Item(Index: Integer): WideString; safecall;
        function Count: Integer; safecall;
        function Get_length: Integer; safecall;
        function _NewEnum: IUnknown; safecall;
        property length: Integer read Get_length;
            function Get_Named: IWSHNamedArguments; safecall;
        function Get_Unnamed: IWSHUnnamedArguments; safecall;
        procedure ShowUsage; safecall;
        property Named: IWSHNamedArguments read Get_Named;
        property Unnamed: IWSHUnnamedArguments read Get_Unnamed;
            function Next(celt: LongWord; var rgvar : OleVariant;
          out pceltFetched: LongWord): HResult; stdcall;
        function Skip(celt: LongWord): HResult; stdcall;
        function Reset: HResult; stdcall;
        function Clone(out Enum: IEnumVariant): HResult; stdcall;
        public
        constructor Create;
        end;

    implementation

    uses ComServ;

    var
    FIndex:Integer=0;

    { TIarguments }

    function TIarguments._NewEnum: IUnknown;
    begin
    Result:=self;
    end;

    function TIarguments.Count: Integer;
    begin
    Result:=System.Length(FAArgs);
    end;

    function TIarguments.Get_length: Integer;
    begin
    Result:=Count;
    end;

    function TIarguments.Item(Index: Integer): WideString;
    begin
    if (Index >= System.Length(FAArgs)) then
    raise EOleSysError.Create('Range check error', HRESULT($800A0009),0)
    else
    Result:=FAArgs[Index]
    end;

    function TIarguments.Get_Named: IWSHNamedArguments;
    begin
    Result:=FWSHNamedArguments;
    end;

    function TIarguments.Get_Unnamed: IWSHUnnamedArguments;
    begin
    Result:=FWSHUnNamedArguments;
    end;

    procedure TIarguments.ShowUsage;
    begin
    OleError(E_NOTIMPL);
    end;

    constructor TIarguments.Create;
    var
    I,J, PCnt:Integer;
    S, CmdLine:string;
    begin
    inherited Create;
    FIndex:=0;
    FWSHNamedArguments:=TIWSHNamedArguments.Create;
    FWSHUnNamedArguments:=TIWSHUnNamedArguments.Create;
    PCnt:=ParamCount;
    SetLength(FAArgs, PCnt);
    for I:=1 to PCnt do
    begin
    J:=I-1;
    FAArgs[J]:=ParamStr(I);
    end;

    //Parsing named args.

    CmdLine:='';
    S:=GetCommandLine;
    PCnt:=iParamCount(PChar(S));
    if PCnt > 1 then
    begin
    for I:=1 to PCnt-1 do
    begin
    CmdLine:=CmdLine+iParamStr(PChar(S), I);
    if I < PCnt-1 then
    CmdLine:=CmdLine+' ';
    end;
    end;

    Support, 09 Июня 2022

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

    +1

    1. 1
    2. 2
    3. 3
    4. 4
    5. 5
    6. 6
    7. 7
    8. 8
    function rand:LongInt;
    {$IFOPT J-} {$J+} {$DEFINE NoJ} {$ENDIF}
    const next:LongInt=1;
    {$IFDEF NoJ} {$J-} {$UNDEF NoJ} {$ENDIF}
    begin
    next:=next*1103515245+12345;
    Result:=(next div 65536) mod 32768;
    end;

    Краткая инструкция как сделать static unsigned long int на Delphi.

    KOTOM, 31 Марта 2022

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

    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
    procedure TF_dvij.rg_sortClick(Sender: TObject);
    var k :Integer;
        s,str1,str2 :string;
        fl :boolean;
    begin
    if G.Columns[9].Visible then
    begin
      fl := Q_dvij.Active ;
      with Q_dvij do
      begin
        if fl then k := RecNo;
        if rg_sort.ItemIndex=0 then s:='order by obd,gr,exped,grot'
        else
        if rg_sort.ItemIndex=1 then s:='order by exped,gr,obd,grot'
        else
        if rg_sort.ItemIndex=2 then s:='order by gr,vp,exped,obd,grot'
        else
        if rg_sort.ItemIndex=3 then s:='order by id_korr,exped,obd,gr,grot'
        else
        if rg_sort.ItemIndex=4 then s:='order by grot,gr,exped,obd'
        else
          s:='order by strn,obd,gr,exped,grot';
          
        if rg_sort.ItemIndex=3 then
          begin
            str1 := 'select vp, id_korr,' ;           //100
            str2 := 'group by 1,2,3,4,5,6,7,8'          //192
          end
        else
          begin
            str1 := 'select vp, max(id_korr) as id_korr,' ;
            str2 := 'group by 1,3,4,5,6,7,8'
          end  ;
    
        Active:=false;
        SQL.Delete(100);
        SQL.Insert(100, str1 );
        SQL.Delete(192);
        SQL.Insert(192, str2 );
        SQL.Delete(262);
        SQL.Insert(262, s);
        Active:= fl;
        if fl then RecNo := k;
        G.Refresh;
      end;
    end;

    сортировОЧКА

    Baiumka, 29 Марта 2022

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

    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
    Dim a As Double
    	'обнуление видимой величины
    Private Sub Command1_Click()
        		Dim b As Double
        		Dim c As Double
      
        		b = Val(Replace(Text2.Text, ",", "."))
        		c = a - b
       		 Text3.Text = c
    End Sub
    
    Private Sub Form_Load()
    		'ввод числа 3FBF9ADD3746F67D 
         		a = 0.123456789012346 + 1E-16
        		Text1.Text = a
    End Sub

    Источник - https://www.softelectro.ru/ieee754.html

    j123123, 03 Февраля 2022

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

    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
    with ZeoDataModule.TmpZQuery do
      begin
        ZeoDataModule.TmpZQuery.Close;
        ZeoDataModule.TmpZQuery.SQL.Clear;
        //ZeoDataModule.TmpZQuery.SQL.Add(ZeoDataModule.zqryOstatki.SQL.Text);
        ZeoDataModule.TmpZQuery.SQL.Add(TZQuery(dbgrdh1.DataSource.DataSet).SQL.Text);
    //    ZeoDataModule.Add ('select  *,''0.00'' as str_cen from material.ostatki_by_skladid(:skladid,:dt) ');
        ZeoDataModule.TmpZQuery.SQL.Add (' and  tovarid in(');
        for i:=0 to OstatkiTovarList.Count-1 do
        begin
          ZeoDataModule.TmpZQuery.SQL.Add(ostatkiTovarList[i]);
          if i< OstatkiTovarList.Count-1 then
            ZeoDataModule.TmpZQuery.SQL.Add(',');
        end;
        ZeoDataModule.TmpZQuery.SQL.Add(')');
        ZeoDataModule.TmpZQuery.SQL.Add('order by nt');
        //-------
        zQ_sv:= DataModulePrint.frxDBDatasetOstatki.DataSet as TZQuery;   // zqryOstatki
        //--------
        ZeoDataModule.zqrySumBySS.Close;
    //    ZeoDataModule.zqrySumBySS.SQL.Add('select :dt,:skladid from material.globalvalues where 1=2'); //  пустой набор
        ZeoDataModule.zqrySumBySS.ParamByName('skladid').Value:=10000;  // несуществующий склад (пустой набор)
        ZeoDataModule.zqrySumBySS.Open;
    
        ZeoDataModule.TmpZQuery.ParamByName('skladid').Value:=zQ_sv.ParamByName('skladid').Value;
        ZeoDataModule.TmpZQuery.ParamByName('dt').AsDate:=zQ_sv.ParamByName('dt').AsDate;
        ZeoDataModule.TmpZQuery.Open;
    
        DataModulePrint.frxDBDatasetOstatki.DataSet := ZeoDataModule.TmpZQuery;
        DataModulePrint.frxDBDatasetSumBySS.DataSet := ZeoDataModule.zqrySumBySS;
        if TypeVed=USUAL_OST then
        begin
          if Material.TypeSkladId = 4 then
            DataModulePrint.ShowReport('ostatki.fr3')
          else
            DataModulePrint.ShowReport('ostatki.fr3')
        end
        else if TypeVed = NO_MOVE_OST then
          DataModulePrint.ShowReport('ostatki_no_move.fr3');
    
        ZeoDataModule.TmpZQuery.Close;
    
        DataModulePrint.frxDBDatasetOstatki.DataSet := zQ_sv;
        ZeoDataModule.zqrySumBySS.Close;
        ZeoDataModule.zqrySumBySS.ParamByName('skladid').Value:=Material.Skladid;
    //    ZeoDataModule.zqrySumBySS.SQL.Clear();
    //    ZeoDataModule.zqrySumBySS.SQL.Add(sqlSum_sv); 
        ZeoDataModule.zqrySumBySS.Open;
      end;

    ZeoDataModule.TmpZQuery.SQL.Add(TZQuery( dbgrdh1.DataSource.DataSet).SQL.Text); - особенно понравилось. Молчу про "with".

    Baiumka, 31 Января 2022

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

    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
    procedure TOstatkiForm.FormCreate(Sender: TObject);
    begin
      OstatkiTovarList:=TStringList.Create;
    
      btnShowToConvert.Enabled := False;
      grpToConvert.Visible := False;
    
      zqrToConvert.SQL.Text := 'select null::integer ostid,' + #13#10 +
                                      'null::integer tovarid,' + #13#10 +
                                      'null::bigint kt,' + #13#10 +
                                      'null::varchar nt,' + #13#10 +
                                      'null::numeric cen,' + #13#10 +
                                      'null::integer edizmerid,' + #13#10 +
                                      'null::varchar name_u,' + #13#10 +
                                      'null::date income_period,' + #13#10 +
                                      'null::varchar ss,' + #13#10 +
                                      'null::numeric ost_doc,' + #13#10 +
                                      'null::numeric gsum' + #13#10 +
                               'where 1=2';
    end;

    Без комментариев

    Baiumka, 12 Января 2022

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

    0

    1. 01
    2. 02
    3. 03
    4. 04
    5. 05
    6. 06
    7. 07
    8. 08
    9. 09
    10. 10
    if  (  (sd<>5)  )    and  //    (Material.ReadOnlySklad =false)      and
              (
                  (     Material.TypeSkladId <> 4    )  and
                  (
                 //    (Material.UserBuh = true )  or (Material.UserAdmin = true)     or
                         (Material.DisunionByOssSb=true )  or  ( credit_operation = true )
    
                  )
                )
               then

    Baiumka, 10 Января 2022

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

    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
    procedure TForm9.FormShow(Sender: TObject);
    var i_vx,o_dt,o_kt: real;
    begin
      Form9.Caption:='Èòîãî ïî æóðíàëó';
      r_:='select sum(sma) as ism from '+t_ss;
      with DM.ZQ_all do
      begin
        Close;
        SQL.Clear;
        SQL.Add(r_);
        SQL.Add('where ch=1 and gd*100+ms<:rgd*100+:rms');
        Params.ParamByName('rgd').Value :=t_gd;
        Params.ParamByName('rms').Value :=t_ms;
        Open;
        first;
        if Eof=true then i_vx:=0 else i_vx:=Fieldbyname('ism').asfloat;
    
        Close;
        SQL.Clear;
        SQL.Add(r_);
        SQL.Add('where ch=2 and gd*100+ms<:rgd*100+:rms');
        Params.ParamByName('rgd').Value :=t_gd;
        Params.ParamByName('rms').Value :=t_ms;
        Open;
    
        first;
        if not Eof=true then  i_vx:=i_vx - Fieldbyname('ism').asfloat;
        LEdit1.Text:=Format('%10.2f',[i_vx]);
        Close;
        SQL.Clear;
        SQL.Add(r_);
        SQL.Add('where ch=1 and gd*100+ms=:rgd*100+:rms');
        Params.ParamByName('rgd').Value :=t_gd;
        Params.ParamByName('rms').Value :=t_ms;
        Open;
        first;
        if Eof=true then o_dt:=0 else o_dt:=Fieldbyname('ism').asfloat;
        LEdit2.Text:=Format('%10.2f',[o_dt]);
        Close;
        SQL.Clear;
        SQL.Add(r_);
        SQL.Add('where ch=2 and gd*100+ms=:rgd*100+:rms');
        Params.ParamByName('rgd').Value :=t_gd;
        Params.ParamByName('rms').Value :=t_ms;
        Open;
        first;
        if Eof=true then o_kt:=0 else o_kt:=Fieldbyname('ism').asfloat;
        Close;
        LEdit3.Text:=Format('%10.2f',[o_kt]);
        LEdit4.Text:=Format('%10.2f',[i_vx+o_dt-o_kt]);
      end;
    
    end;

    Baiumka, 06 Января 2022

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

    −8

    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
    Program print_numbers_twice;
    
    Procedure give(p: pptrint);
    begin
    	if pptrint(p^) <> nil then begin
    		give(pptrint(p^));
    		writeln((p-1)^)
    	end
    end;
    
    Procedure take;
    var n: ptrint;
    begin
    	if not SeekEof then begin
    		read(n);
    		take
    	end else begin
    		n := (pptrint(@n)+1)^;
    		give(pptrint(n));
    		give(pptrint(n))
    	end
    end;
    
    Begin
    	take
    End.

    На входе программа получает неизвестное заранее количество целых чисел, разделенных пробельными символами, а затем выводит их два раза в том же порядке по одному числу в строке.

    Очень простая и короткая программа. Я думаю, вам не составит труда понять, как она работает. Пишите в комментариях!

    Threadwalker, 22 Декабря 2021

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

    −2

    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
    // Подгрузка аватаров пользователей.
        Bmp:=TBitMap.Create; // Нет более изящного спооба узнать тип изображения, не колупаясь в заголовках. Расширение файлов картинок зачастую фиктивное.
        try                  // Зная, что ава может быть только двух типов - jpg и png, я решил пойти конём.
          Bmp.PixelFormat:=pf32Bit;
          Bmp.Width:=16;
          Bmp.Height:=16;
          ImgConv:=True;
          Png:=TPngObject.Create;
          try
            try
              Comm.RawAvatar.Position:=0;
              Png.LoadFromStream(Comm.RawAvatar);
              Bmp.Canvas.StretchDraw(Bmp.Canvas.ClipRect, Png);
            except
              ImgConv:=False;     // Ошибка конвертирования. Не совпал формат - идем дальше, пробуем jpg...
            end;
          finally
            Png.Free;             // нет смысла раскручивать стек, ибо исключение в любом случае отловится try..except
          end;
          if not ImgConv then
          begin
            Jpg:=TJPEGImage.Create;
            try
              try
                Comm.RawAvatar.Position:=0;
                Jpg.LoadFromStream(Comm.RawAvatar);
                Bmp.Canvas.StretchDraw(Bmp.Canvas.ClipRect, Jpg);
              except
              end;
            finally
              Jpg.Free;
            end;
          end;
          CommentList.Items[I].ImageIndex:=Images.AddMasked(Bmp, clWhite);
        finally
          Bmp.Free;
        end;
      end;

    "Тут всюду густая вонь, то жаркая и приятная, то теплая и противная, но одинаково волнующая, особая, пароходная, мешающаяся с морской свежестью"

    @ Бунин.

    Теперь минусатор умеет подгружать авы.
    https://dropmefiles.com/USQKW

    Support, 05 Ноября 2021

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