Pascal — Говнокод.ру

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

+91

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

procedure TForm1.Button3Click(Sender: TObject);
var
  i, j, n, c, Day1, Month1, Year1: word;
begin
  Memo1.Clear;
  Try
    Day1 := StrToInt(Edit7.Text);
    Month1 := StrToInt(Edit8.Text);
    Year1 := StrToInt(Edit9.Text);
  Except
    ShowMessage('Введите нынешнюю дату!');
  end;

  { Сортировка по дате и цене товара. Ввыод результата сортировки на экран }
  for i := 1 to Nzap do
    With Sklad[i] do
    begin
      if Sklad[i].Cost >= 1000000 then
      begin
        if abs(Year1 - Sklad[i].Year) >= 2 then
          Memo1.Lines.Add(Nm + ' ' + 'Цена:' + IntToStr(Cost) + 'руб.' + ' ' +
            'Кол-во:' + IntToStr(Quantity) + ' ' + 'шт.' + ' ' + 'День-' +
            IntToStr(Day) + ' ' + 'Мес.-' + IntToStr(Month) + ' ' + 'Год-' +
            IntToStr(Year))
        else
        begin
          if abs(Month1 - Sklad[i].Month) >= 2 then
            Memo1.Lines.Add(Nm + ' ' + 'Цена:' + IntToStr(Cost) + 'руб.' + ' ' +
              'Кол-во:' + IntToStr(Quantity) + ' ' + 'шт.' + ' ' + 'День-' +
              IntToStr(Day) + ' ' + 'Мес.-' + IntToStr(Month) + ' ' + 'Год-' +
              IntToStr(Year))
          else
          begin
            if (Day1 - Sklad[i].Day = 0) and (Month1 <> Sklad[i].Month) and
              (Year1 <> Sklad[i].Year) then
              Memo1.Lines.Add(Nm + ' ' + 'Цена:' + IntToStr(Cost) + 'руб.' + ' '
                + 'Кол-во:' + IntToStr(Quantity) + ' ' + 'шт.' + ' ' + 'День-' +
                IntToStr(Day) + ' ' + 'Мес.-' + IntToStr(Month) + ' ' + 'Год-' +
                IntToStr(Year));
          end;
        end;
      end;
    end;
end;

Ищем товар лежащий на складе больше месяца и имеющий цену больше миллиона рублей...

Toha, 25 Декабря 2014

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

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

+88

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

procedure sr(var q, w: string; j, k: integer);
begin
  for j := 1 to 100 do
  begin
    if ord(q[j]) - ord(w[j]) > 0 then begin for k := 1 to pos(' ', q) do write(q[k]);exit; end
    else if ord(q[j]) - ord(w[j]) < 0 then begin for k := 1 to pos(' ', w) do write(w[k]);exit; end;
  end;
  for k := 1 to pos(' ', w) do write(w[k]);
end;
 
procedure sr2(var q, w, e, r: string; j, k, p: integer);
begin
  for j := 1 to 101 do
  begin
    if ord(q[j]) - ord(w[j]) > 0 then begin r := q;break; end
    else if ord(q[j]) - ord(w[j]) < 0 then begin r := w;break;end;
    inc(p);
  end;
  if p>100 then r:=w;
  for j := 1 to 100 do
  begin
    IF E[J]=' ' Then break;
    if ord(e[j]) - ord(r[j]) > 0 then begin for k := 1 to pos(' ', e) do write(e[k]);exit; end
    else if ord(e[j]) - ord(r[j]) < 0 then begin for k := 1 to pos(' ', r) do write(r[k]);exit; end;
  end;
  for k := 1 to pos(' ', r) do write(r[k]);
end;
 
var
  st, a, b, c, rd: string;
  i, s: integer;
 
begin
  assign(input, 'input.txt'); reset(input);
  assign(output, 'output.txt'); rewrite(output);
  read(st);
  for i := 1 to 102
  do
  begin
    a := a + ' ';
    b := b + ' ';
    c := c + ' ';
  end;
  for i := 1 to length(st) do
    if st[i] = ' ' then inc(s)
    else
      case s of
        0: a[i] := st[i];
        1: b[i - pos(' ', a)] := st[i];
        2: c[i - pos(' ', a) - pos(' ', b)] := st[i];
      end;
  if (a=b) and (b=c) then for i := 1 to pos(' ', a) do write(a[i])
  else if (pos(' ', a) > pos(' ', b)) and (pos(' ', a) > pos(' ', c)) then for i := 1 to pos(' ', a) do write(a[i])
  else if (pos(' ', b) > pos(' ', a)) and (pos(' ', b) > pos(' ', c)) then for i := 1 to pos(' ', b) do write(b[i])
  else if (pos(' ', c) > pos(' ', b)) and (pos(' ', c) > pos(' ', a)) then for i := 1 to pos(' ', c) do write(c[i])
  else if (pos(' ', a) = pos(' ', b)) and (pos(' ', b) = pos(' ', c)) then sr2(a, b, c, rd, 0, 0, 0)
  else if pos(' ', a) = pos(' ', b) then sr(a, b, 0, 0)
  else if pos(' ', c) = pos(' ', b) then sr(c, b, 0, 0)
  else if pos(' ', a) = pos(' ', c) then sr(a, c, 0, 0);
end.

Выбор максимума из 3 целых длинных чисел

AndreyZ, 17 Декабря 2014

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

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

+86

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

const n=10;

type
     xfl = record x: double; fl: longint; end;
  ar_xfl = array[1..2*n] of xfl;
var
  i: longint;
  x,y,r: double;
  a: ar_xfl;
  f: text;


procedure qsort(var a: ar_xfl; lo,hi: longint);
    procedure sort(l,r: longint);
    var
      i,j,k: longint;
      tmp: xfl;
    begin
      i:=l;
      j:=r;
      k:=(l+r) div 2;
      repeat
        while a[i].x<a[k].x do inc(i);
        while a[k].x<a[j].x do dec(j);
        if i<=j then
          begin
            tmp:=a[i];
            a[i]:=a[j];
            a[j]:=tmp;
            inc(i);
            dec(j);
          end;
      until i>j;
      if l<j then sort(l,j);
      if i<r then sort(i,r);
    end;
begin
sort(lo,hi);
end;

За такие названия переменных надо руки завязывать узлом. Да и помимо этого..

Cynicrus, 05 Декабря 2014

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

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

+90

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

Procedure ArrDataToRawImage(Ptr: PRGB32; Size: TPoint; out RawImage: TRawImage);
Begin
RawImage.Init; { Calls raw.Description.Init as well }
RawImage.Description.PaletteColorCount:=0;
RawImage.Description.MaskBitsPerPixel:=0;
RawImage.Description.Width := Size.X;
RawImage.Description.Height:= Size.Y;
RawImage.Description.Format := ricfRGBA;
RawImage.Description.ByteOrder := riboLSBFirst;
RawImage.Description.BitOrder:= riboBitsInOrder; // should be fine
RawImage.Description.Depth:=24;
RawImage.Description.BitsPerPixel:=32;
RawImage.Description.LineOrder:=riloTopToBottom;
RawImage.Description.LineEnd := rileDWordBoundary;
RawImage.Description.RedPrec := 8;
RawImage.Description.GreenPrec:= 8;
RawImage.Description.BluePrec:= 8;
RawImage.Description.AlphaPrec:=0;
RawImage.Description.RedShift:=16;
RawImage.Description.GreenShift:=8;
RawImage.Description.BlueShift:=0;
RawImage.DataSize := RawImage.Description.Width * RawImage.Description.Height
* (RawImage.Description.bitsperpixel shr 3);
RawImage.Data := PByte(Ptr);
End;

with ... do? Не. не слышал.

Cynicrus, 01 Декабря 2014

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

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

+90

001
002
003
004
005
006
007
008
009
010
011
012
013
014
015
016
017
018
019
020
021
022
023
024
025
026
027
028
029
030
031
032
033
034
035
036
037
038
039
040
041
042
043
044
045
046
047
048
049
050
051
052
053
054
055
056
057
058
059
060
061
062
063
064
065
066
067
068
069
070
071
072
073
074
075
076
077
078
079
080
081
082
083
084
085
086
087
088
089
090
091
092
093
094
095
096
097
098
099
100

function TMFinder.FindDTMs(DTM: TMDTM; out Points: TPointArray; x1, y1, x2, y2, maxToFind: Integer): Boolean;
var
  Len: integer;
  DPoints: PMDTMPoint;
  b: array of array of Integer;
  ch: array of array of integer;
  W, H: integer;
  MA: TBox;
  MaxX, MaxY: integer;
  xx, yy: integer;
  i, xxx, yyy: Integer;
  StartX, StartY, EndX, EndY: integer;
  cd: TPRGB32Array;
  PtrData: TRetData;
  pc: Integer = 0;
  Found: boolean;
  goodPoints: array of Boolean;
  col_arr, tol_arr: array of Integer;
  ctsinfoarray: TCTSInfoArray;
  compare: TCTSCompareFunction;
label
  theEnd;
begin
  MA := ValidMainPointBox(DTM, x1, y1, x2, y2);
  Len := dtm.Count;
  DPoints := dtm.PPoints;
  setlength(goodPoints, Len);
  for i := 0 to Len - 1 do
    goodPoints[i] := not DPoints[i].bp;
  W := x2 - x1;
  H := y2 - y1;
  setlength(b, (W + 1));
  setlength(ch, (W + 1));
  for i := 0 to W do
  begin
    setlength(ch[i], (H + 1));
    FillChar(ch[i][0], SizeOf(Integer) * (H + 1), 0);
    setlength(b[i], (H + 1));
    FillChar(b[i][0], SizeOf(Integer) * (H + 1), 0);
  end;
  PtrData := TClient(Client).IOManager.ReturnData(x1, y1, W + 1, H + 1);
  SetLength(col_arr, Len);
  SetLength(tol_arr, Len);
  for i := 0 to Len - 1 do
  begin
    col_arr[i] := DPoints[i].c;
    tol_arr[i] := DPoints[i].t;
  end;
  ctsinfoarray := Create_CTSInfoArray(col_arr, tol_arr);
  compare := Get_CTSCompare(Self.CTS);
  cd := CalculateRowPtrs(PtrData, h + 1);
  MA.x1 := MA.x1 - x1;
  MA.y1 := MA.y1 - y1;
  MA.x2 := MA.x2 - x1;
  MA.y2 := MA.y2 - y1;
  MaxX := x2 - x1;
  MaxY := y2 - y1;
  for yy := MA.y1 to MA.y2 do
    for xx := MA.x1 to MA.x2 do
    begin
      for i := 0 to Len - 1 do
      begin
        Found := false;
        StartX := max(0, xx - DPoints[i].asz + DPoints[i].x);
        StartY := max(0, yy - DPoints[i].asz + DPoints[i].y);
        EndX := Min(MaxX, xx + DPoints[i].asz + DPoints[i].x);
        EndY := Min(MaxY, yy + DPoints[i].asz + DPoints[i].y);
        for xxx := StartX to EndX do
        begin
          for yyy := StartY to EndY do
          begin
            if ch[xxx][yyy] and (1 shl i) = 0 then
            begin
              ch[xxx][yyy] := ch[xxx][yyy] or (1 shl i);
              if compare(ctsinfoarray[i], @ cd[yyy][xxx]) then
                b[xxx][yyy] := b[xxx][yyy] or (1 shl i);
            end;
            if (b[xxx][yyy] and (1 shl i) <> 0) then
            begin
              if GoodPoints[i] then
              begin
                Found := true;
                break;
              end
              else
                goto AnotherLoopEnd;
            end;
          end;
          if Found then
            Break;
        end;
        if (not found) and (GoodPoints[i]) then
          goto AnotherLoopEnd;
      end;
      ClientTPA[pc] := Point(xx + x1, yy + y1);
      Inc(pc);
      if (pc = maxToFind) then
        goto theEnd;
    end;
  TheEnd: Free_CTSInfoArray(ctsinfoarray);

Охх...читать такое - можно и мозг повредить.

Cynicrus, 01 Декабря 2014

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

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

+80

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

procedure TInventory.removeItem(userid: integer; invid: integer;amount: integer = 1);
var
  MyRes: TInvItemArray;
  CurrItem: TInvItem;
  I,len: integer;
begin
  if (amount <= 0) then
    exit;
  if (amount = 1) then
    begin
     db.removeItemFromUserInventory(GetItems(GetIndexByInvId(invid)),userid);
     FInventoryList.Remove(GetIndexByInvId(invid));
    end else
    begin
      if (amount >= finventorylist.Size) then
        exit;
      MyRes:=GetResources(invid);
      len:=length(myres);
      if (len = 0) then
        exit;
      if (amount > len) then
        exit;
      for i:=0 to len - 1 do
       begin
         curritem:=MyRes[i];
         db.removeItemFromUserInventory(GetItems(GetIndexByInvId(curritem.InvId)),userid);
         FInventoryList.Remove(GetIndexByInvId(curritem.invid));
       end;
     Setlength(myres,0);
    end;

end;

function TInventory.GetResources(invid: integer): TInvItemArray;
function ToResult(var Return: TInvItemArray; const Item: TInvItem): Integer;
begin
  Result := Length(Return);
  SetLength(Return, Result + 1);
  Return[Result] := Item;
end;
var
  item,sameitem: TInvItem;
  Resource: TItem;
  i: integer;
begin
  SetLength(result,0);
  item:=GetItem(invid);
  if (item = nil) then
    exit;
  if (item.item <> nil) then
    begin
     // if (item.itemю = 30) then
     //   begin
          for i:=0 to FInventoryList.Size - 1 do
           begin
             sameitem:=TInvItem(FInventoryList.Items[i]);
              if (sameitem = nil) then
                continue;
             resource:=sameitem.item;
              if (resource = nil) then
                continue;
              if (item.item.itemid = resource.itemid) then
                ToResult(result,sameitem);
           end;
       // end;
    end;
end;

По сути - удалить объект из списка. OMG!

Cynicrus, 29 Ноября 2014

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

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

+88

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

function TCalc.getRewardItems(items : AnsiString; countItems : integer; userId : Integer; from:integer) : ISuperObject;
var tmpFirstOdds : integer;
    strLines, extrLines : TStringList;
    strItems, strOdds, strOdds2: TIntegerList;
    i, j, tmpCountItems : integer;
    tmpOddsItems, sum : Integer;
    str: ansistring;
begin
  Result := nil;

  // parse items line [id1,odd1],[id2,odd2],[id3,odd3]
  strLines := TStringList.Create;
  extrLines := TStringList.Create;
  strItems := TIntegerList.Create;
  strOdds := TIntegerList.Create;
  ExtractStrings(['[', ']'],[','], PChar(items), strLines);
  for i := 0 to strLines.Count - 1 do
  begin
    ExtractStrings([','],[' '], PChar(strLines[i]), extrLines);
    strItems.Add(StrToInt(extrLines[0]));
    strOdds.Add(StrToInt(extrLines[1]));
    extrLines.Clear;
  end;

  // calculate odds [a,b,c,d] as [a,a+b,a+b+c,a+b+c+d]
  sum := 0;
  strOdds2 := TIntegerList.Create;
  for i := 0 to strOdds.Count-1 do
  begin
    sum := sum + strOdds.Items[i];
    strOdds2.Add(sum);
  end;

  // select items
  str := '';
  for i := 0 to countItems - 1 do
  begin
    tmpFirstOdds := Random(101); // 0-100
    for j := 0 to strOdds2.Count-1 do
    begin
      if tmpFirstOdds < strOdds2.Items[j] then
      begin
        str := str + IntToStr(strItems[j]) + ',';
        break;
      end;
    end;
  end;
  str := '['+Copy(str,1,Length(str)-1)+']';
  // from monster
  if from=0 then Result := so('{"part":"battle","func":"itemsdropped","data":'+str+'}');
  // from chest
  if from=1 then Result := so('{"part":"battle","func":"itemsdroppedchest","data":'+str+'}');
  strLines.Free;
  extrLines.Free;
  strItems.Free;
  strOdds.Free;
  strOdds2.Free;
end;

У меня чуть глаза не вытекли от такого решения. Код по идее сообщает клиенту, что выпало из монстра после победы над ним.

Cynicrus, 24 Ноября 2014

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

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

+94

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

function TMyDb.getUserItemsINTOMarkt(userid: Int64; marktid: String): SOString;
var
  Query : TZQuery;
begin
 Result := '';
 try
 lock;
 Query := TZQuery.Create(nil);
 if not isConnected() then
        connect();
   Query.Connection := SQLCon;
      Query.SQL.TEXT:='SELECT mi.markt_id, mi.price, mi.item_id,ui.used_limit,'+
                           'ui.max_limit,ui.inv_id,ui.inv_min_damage, ui.inv_max_damage,'+
                           'ui.inv_options,ui.inv_bonuses,ui.inv_mods,ui.modifed,'+
                           'i.name FROM bkheroes.markt_items mi '+
                           'JOIN user_inventory ui ON mi.user_id='+IntToStr(userid)+' AND '+
                           'mi.user_inv_id=ui.inv_id AND mi.markt_id='''+marktid+
                          ''' AND ui.userSellItem=''yes'' JOIN items i ON i.id=mi.item_id';

   if SQLCon.Connected = True then
  begin
    Query.Open;
    if Query.RecordCount > 0 then
    begin
      while not Query.EOF do
      begin
          Result := Result+'{"marktid":'+Query.FieldByName('markt_id').AsString+
                    ',"inv_id":'+Query.FieldByName('inv_id').AsString+
                    ',"price":'+Query.FieldByName('price').AsString+
                    ',"itemid":'+Query.FieldByName('item_id').AsString+
                    ',"used_limit":'+Query.FieldByName('used_limit').AsString+
                    ',"max_limit":'+Query.FieldByName('max_limit').AsString+
                    ',"min_damage":'+Query.FieldByName('inv_min_damage').AsString+
                    ',"max_damage":'+Query.FieldByName('inv_max_damage').AsString+
                    ',"options":'+explodeParams(query.FieldByName('inv_options').AsString,',',':').AsString+
                    ',"bonuses":'+explodeParams(Query.FieldByName('inv_bonuses').AsString,',',':').AsString+
                    ',"mods":'+explodeParams(Query.FieldByName('inv_mods').AsString,',',':').AsString+
                    ',"modifed":"'+Query.FieldByName('modifed').AsString+
                    '","name":"'+Query.FieldByName('name').AsString+'"},';
          query.Next;
      end;
    end;
  Result:='{"marktid":'+marktid+',"items":['+Copy(Result,1,Length(Result)-1)+']}';
  end;
  TLogger.GeneralLog('getUserItemsINTOMarkt: '+Result,'TMyDBUnit',ltTrace);
  finally
  Query.Close;
  Query.Free;
  unlock;
  end;
end;

О боже! Как можено такое писать за деньги? Да вообще, как можно писать такое??

Cynicrus, 24 Ноября 2014

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

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

+87

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

class function TTransfer.getCreditStateOFCreditPoints(creditPoints:Int64):Integer;
begin
  Result := 0;
  if (creditPoints>=0) AND (creditPoints <200) then
     begin
          Result := 1;
          exit;
     end;
  if (creditPoints>=200) AND (creditPoints <600) then
     begin
          Result := 2;
          exit;
     end;
  if (creditPoints>=600) AND (creditPoints <1200) then
     begin
          Result := 3;
          exit;
     end;
  if (creditPoints>=1200) AND (creditPoints <2000) then
     begin
          Result := 4;
          exit;
     end;
  if (creditPoints>=2000) AND (creditPoints <3700) then
     begin
          Result := 5;
          exit;
     end;
  if (creditPoints>=3700) AND (creditPoints <7000) then
     begin
          Result := 6;
          exit;
     end;
  if (creditPoints>=7000) AND (creditPoints <15000) then
     begin
          Result := 7;
          exit;
     end;
  if (creditPoints>=15000) AND (creditPoints <25000) then
     begin
          Result := 8;
          exit;
     end;
  if (creditPoints>=25000) AND (creditPoints < 100000) then
     begin
          Result := 9;
          exit;
     end;
  if (creditPoints>=100000) then
     begin
          Result := 10;
          exit;
     end;
end;

Типа Ы-нтерпрайз код. Где таких делают только.

Cynicrus, 24 Ноября 2014

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

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

+140

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

type func = function (x : real) : real;
const
	eps = 0.0000003;
	pi = 3.14159265358979;
function Integral (f : func; a, b : real) : real;
var center : real;
begin
	center := (a + b) / 2;
	if abs(b - a) < eps then
		Integral := f(center) * (b - a)
	else Integral := Integral(f, a, center) + 
		Integral(f, center, b);
end;
function myFunc(x : real) : real;
begin
	myFunc := cos(x) / x;
end;
begin
	writeln(Integral(myFunc, pi/2, pi));
	readln;
end.

Толи я дурачек, толи автор кода - школьник....

ShadowXX, 02 Ноября 2014

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

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

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

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

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

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

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

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

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

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

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

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