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

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

+102

01
02
03
04
05
06
07
08
09
10
11
12
13
14
15

function FileIsBusy(AFileName: string): Boolean;
var
  F: Integer;
begin
  F := FileOpen(AFileName, fmShareExclusive);
  Result := F = -1;
  FileClose(F);
end;

function WaitFile(AFileName: string; ASpeepDelay: integer): Boolean;
begin
  while FileIsBusy(AFileName) do
    Sleep(ASpeepDelay);
  Result := True;
end;

пока юзверь ковыряется в Ворде, другой процесс мечтает овладеть файлом
"It is necessary to wait of end of editing Microsoft Office files.I use next conventional approach: file is editing While file is busy" (ингриш - питерского разлива)

это stackoverflow такими сниппетами переполнено

bugmenot, 10 Декабря 2010

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

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

+96

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
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89

procedure TForm1.Button2Click(Sender: TObject);
var stSQL: string;
i: integer;
begin

try
SQLConnection1.Params.Values['HostName']:=Server; // имя сервера
SQLConnection1.Params.Values['DataBase']:=MyBase ;
SQLConnection1.Params.Values['OS Authentication']:= 'True';
SQLConnection1.Open;
except
MessageDlg('Соединение с БД невозможно', mtError, [mbOK], 0);
exit;
end;

SQLQuery1.SQL.Add('IF EXISTS (SELECT * FROM sysobjects WHERE name ='+''''+'MyTable'+''''+') DELETE FROM MyTable;');
SQLQuery1.ExecSQL;
SQLQuery1.SQL.Clear;
SQLQuery1.SQL.Add('IF EXISTS (SELECT * FROM sysobjects WHERE name ='+''''+'MyTable'+''''+') DROP TABLE MyTable;');
SQLQuery1.ExecSQL;
SQLQuery1.SQL.Clear;
SQLQuery1.SQL.Add('CREATE TABLE MyTable (VZPROJ varchar(50), PARTITION varchar(50), '+
'MAKER varchar(50), STATE varchar(50), DATECRT varchar(50), DATEP varchar(50), '+
'DATEF varchar(50), DATETOCRD varchar(50), DATECRD varchar(50), DATEPLN varchar(50), '+
'DATEFIN varchar(50), DATECNCL varchar(50))');
SQLQuery1.ExecSQL;

cdsList.First;
for i:=1 to cdsList.RecordCount do
begin
stSQL:='INSERT INTO MyTable VALUES(';
if cdsList.FieldByName('VZPROJ').AsString<>'' then
stSQL:=stSQL+' '''+cdsList.FieldByName('VZPROJ').AsString+''','
else
stSQL:=stSQL+' NULL,';
if cdsList.FieldByName('PARTITION').AsString<>'' then
stSQL:=stSQL+' '''+cdsList.FieldByName('PARTITION').AsString+''','
else
stSQL:=stSQL+' NULL,';
if cdsList.FieldByName('MAKER').AsString<>'' then
stSQL:=stSQL+' '''+cdsList.FieldByName('MAKER').AsString+''','
else
stSQL:=stSQL+' NULL,';
if cdsList.FieldByName('STATE').AsString<>'' then
stSQL:=stSQL+' '''+cdsList.FieldByName('STATE').AsString+''','
else
stSQL:=stSQL+' NULL,';
if cdsList.FieldByName('DATECRT').AsString<>'' then
stSQL:=stSQL+' '''+cdsList.FieldByName('DATECRT').AsString+''','
else
stSQL:=stSQL+' NULL,';
if cdsList.FieldByName('DATEP').AsString<>'' then
stSQL:=stSQL+' '''+cdsList.FieldByName('DATEP').AsString+''','
else
stSQL:=stSQL+' NULL,';
if cdsList.FieldByName('DATEF').AsString<>'' then
stSQL:=stSQL+' '''+cdsList.FieldByName('DATEF').AsString+''','
else
stSQL:=stSQL+' NULL,';
if cdsList.FieldByName('DATETOCRD').AsString<>'' then
stSQL:=stSQL+' '''+cdsList.FieldByName('DATETOCRD').AsString+''','
else
stSQL:=stSQL+' NULL,';
if cdsList.FieldByName('DATECRD').AsString<>'' then
stSQL:=stSQL+' "'+cdsList.FieldByName('DATECRD').AsString+''','
else
stSQL:=stSQL+' NULL,';
if cdsList.FieldByName('DATEPLN').AsString<>'' then
stSQL:=stSQL+' '''+cdsList.FieldByName('DATEPLN').AsString+''','
else
stSQL:=stSQL+' NULL,';
if cdsList.FieldByName('DATEFIN').AsString<>'' then
stSQL:=stSQL+' '''+cdsList.FieldByName('DATEFIN').AsString+''','
else
stSQL:=stSQL+' NULL,';
if cdsList.FieldByName('DATECNCL').AsString<>'' then
stSQL:=stSQL+' '''+cdsList.FieldByName('DATECNCL').AsString+''''
else
stSQL:=stSQL+' NULL';

stSQL:=stSQL+');';

SQLQuery1.SQL.Clear;
SQLQuery1.SQL.Add(stSQL);
SQLQuery1.ExecSQL;
cdsList.Next;
end;

end;

дельфипаста с гарниром

bugmenot, 07 Декабря 2010

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

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

+145

01
02
03
04
05
06
07
08
09
10
11
12
13
14
15

program bag; var numbers, weight, price : array[1..100] of byte; 
fraction : array[1..100] of real; n, i, f, max, s, temp_i : byte; 
temp_r : real; begin writeln('Input number of goods and maximal 
weight: '); readln(n, max); writeln; randomize; for i := 1 to n do 
begin numbers[i] := i; weight[i] := random(254) + 1; write(weight[i],
' '); price[i] := random(254) + 1; write(price[i], ' '); fraction[i]
:= price[i] / weight[i]; writeln(fraction[i]:0:2); end; f := 1; 
while (f = 1) do begin f := 0; for i := 1 to n-1 do begin if (
fraction[i] < fraction[i + 1]) then begin if (price[i] < price[i + 1
]) then begin temp_r := fraction[i + 1]; fraction[i + 1] := fraction[
i]; fraction[i] := temp_r; temp_i := weight[i + 1]; weight[i + 1] := 
weight[i]; weight[i] := temp_i; temp_i := numbers[i + 1]; numbers[i +
1] := numbers[i]; numbers[i] := temp_i; f := 1; end; end; end; end; 
s := 0; i := 1; while (s + weight[i] <= max) do begin writeln(numbers
[i]); s := s + weight[i]; inc(i); end; readln; end.

Geany отформатировал код :)

bazhenovc, 02 Декабря 2010

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

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

+97

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
68

program Project42;

{$APPTYPE CONSOLE}

uses
  SysUtils, Math;

const
  Radix = 10;

function čòũŉť(N: Integer): Integer;
begin
  Result := 0;
  while N > 0 do
  begin
    N := N div Radix;
    Inc(Result);
  end;
end;

function count(N: Integer): Integer;
begin
//  Result := Ceil(LogN(Radix, N));     { slow! }
  Result := Ceil(Log10(N));
end;

function rdtsc: Int64;
asm
        rdtsc
end;

var
  I: Integer;
  t0: Int64;

const
  N = 100500;

begin
  try
    Assert((count(42) = čòũŉť(42)) and (count(100500) = čòũŉť(100500)));

    t0 := rdtsc;
    for I := 1 to N do
      čòũŉť(Random(MaxInt + 1));
    Writeln('naïve: ', rdtsc - t0, ' ticks');

    t0 := rdtsc;
    for I := 1 to N do
      count(Random(MaxInt + 1));
    Writeln('prőper: ', rdtsc - t0, ' ticks');

    Writeln(StringOfChar('-', 42));

  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;

  if DebugHook <> 0 then
  begin
    Write('any big key to exit...');
    Readln;
  end;

end.

{ http://imgs.xkcd.com/comics/haiku_proof.png :-P }

матан > метан
O(1) > O(N)
логарифм > байтоёбства с делением

bugmenot, 01 Декабря 2010

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

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

+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
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75

function WindowProc(Wnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM ): LRESULT; stdcall;
type
  Item = record
    szItemNr: array[0..8] of char;
    szItem: array[0..32] of char;
    szItemDescription: array[0..32] of char;
  end;
var
  ListColumn: LV_COLUMN;
  ListItem: LV_ITEM;
begin
  // In case of Msg ...
  case Msg of
    WM_CREATE: // Create?
    begin
      // Create list
      ListView := CreateWindowEx(WS_EX_CLIENTEDGE, WC_LISTVIEW, '', WS_VISIBLE Or WS_CHILD Or LVS_REPORT Or LVS_SHOWSELALWAYS,
                                 10, 10, 524, 300, Wnd, 0, hInstance, nil);
      ListView_SetExtendedListViewStyle(ListView, LVS_EX_FULLROWSELECT Or LVS_EX_GRIDLINES);
      // Filling list columns
      with ListColumn do begin
        mask := LVCF_FMT Or LVCF_WIDTH Or LVCF_TEXT Or LVCF_SUBITEM;
        fmt := LVCFMT_LEFT;

        iSubItem := 0;
        cx := 200;
        pszText := 'File name';
        ListView_InsertColumn(ListView, 0, ListColumn);

        iSubItem := 1;
        cx := 250;
        pszText := 'Folder path';
        ListView_InsertColumn(ListView, 1, ListColumn);

        iSubItem := 2;
        cx := 70;
        pszText := 'File size';
        ListView_InsertColumn(ListView, 2, ListColumn);
      end;

      with ListItem do begin
        mask := LVIF_TEXT;
        iItem := 1;
        iSubItem := 1;
        pszText := PChar('test');
        cchTextMax := SizeOf(PChar('test')) + 1;
      end;
      ListView_InsertItem(ListView, ListItem);
      ListView_SetItemText(ListView, 1, 1, PChar('Hello world!'));

      // Create static text, progress bar and buttons
      StaticText := CreateWindowEx(0, 'Static', '', WS_CHILD Or WS_VISIBLE Or SS_CENTER,
                                   10, 310, 524, 16, Wnd, ID_StaticText, hInstance, 0);
      ProgressBar := CreateWindowEx(0, PROGRESS_CLASS, nil, WS_CHILD Or WS_VISIBLE Or PBS_SMOOTH,
                                    9, 326, 525, 17, Wnd, ID_ProgressBar, hInstance, nil);
      Button_Start := CreateWindowEx(WS_EX_STATICEDGE, 'Button', 'Start', BS_DEFPUSHBUTTON Or WS_VISIBLE Or WS_CHILD,
                               150, 350, 70, 25, Wnd, ID_Button_Start, hInstance, nil );
      Button_Pause := CreateWindowEx(WS_EX_STATICEDGE, 'Button', 'Pause', WS_VISIBLE Or WS_CHILD Or WS_DISABLED,
                               230, 350, 70, 25, Wnd, ID_Button_Pause, hInstance, nil );
      Button_Stop := CreateWindowEx(WS_EX_STATICEDGE, 'Button', 'Stop', WS_VISIBLE Or WS_CHILD Or WS_DISABLED,
                               310, 350, 70, 25, Wnd, ID_Button_Stop, hInstance, nil );
    end;

    WM_DESTROY: // Closing?
    begin
      PostQuitMessage(0);
      Result := 0;
      Exit;  // Bye.
    end;

    WM_COMMAND: // Any command?
    case LoWord(wParam) of
        // ....................................
    end;
end;

Пристрелите меня кто-нибудь. Или объясните, как работает этот волшебный listview %)

iloveYou, 28 Ноября 2010

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

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

+101

01
02
03
04
05
06
07
08
09
10

procedure TSomeForm.DBGridEhDrawColumnCell(SomeParams);
begin
  ShowRecordCount(GridDataSet);
end;
...
procedure ShowRecordCount(const FibDataSet: TpFibDataSet);
begin
  FormMain.StatusBar1.Panels[2].Text := 'записей='+ IntToStr(FibDataSet.VisibleRecordCount);
  FormMain.StatusBar1.Refresh;
end;

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

labutinpa, 25 Ноября 2010

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

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

+145

01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16

{pascal}
{$M 65520,0,10000}
program govnokod;
a:word;
begin
repeat
writeln('кто считает что он дебил нажмите 1, кто наоборот 2');
readln(a);
if a=1
then
writeln('да ты прав');
readln
else
writeln('да нет ты не понял, надо нажать 1');
until a=1
end.

просто прикольная надоедаловка,

we-stalkers, 18 Ноября 2010

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

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

+145

1
2

if not Assigned(ArbPower) then
      DoException('Блятство');

эмокод, но какой душевный!

stokito, 18 Ноября 2010

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

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

+95

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

function  TForm1.beta(i:integer) : integer;
var bt:integer;
begin
bt:=0;
curI:=i;
if (alf=1) and (cad=0) then
begin
if i<=26 then bt:=2;
if (i<=36) and (i>=27) then bt:=3;
if (i<=48) and (i>=37) then  begin  bt:=1; addortolexlist(cT);  end;
if i=49 then bt:=4;
if i=50 then bt:=5;
if i=51 then bt:=6;
if i=52 then bt:=7;
end;
if (alf=2) and (cad=0) then
begin
if i<=26 then bt:=2;
if (i<=36) and (i>=27) then bt:=2;
end;
if (alf=3) and (cad=0) then
begin
if (i<=36) and (i>=27) then bt:=3;
end;
if (alf=4) and (cad=0) then
begin
if i=50 then
begin
 Tl[lexnow].n:=jj;
  Tl[lexnow].subst:='<>';
  Tl[lexnow].lexcod:=21;
  Tl[lexnow].index:=0;
  bt:=1;
   inc(lexnow);
   ii:=ii+1;
end;
if i=51 then
begin
  Tl[lexnow].n:=jj;
  Tl[lexnow].subst:='<=';
  Tl[lexnow].lexcod:=24;
  Tl[lexnow].index:=0;
 bt:=1;
 ii:=ii+1;
    inc(lexnow);
end;

Кусок кода из лабораторной работы по трансляторам. Как сказал парень - "Я не умею пользоваться функциями, поэтому я все пишу на массивах" О_о
Дальше в коде заполнение массивов размерностью в сотню элементов вручную!
Главное, что всё работает...

niravzi, 17 Ноября 2010

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

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

+108

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

TCalc = Class
  Public
    Order : 1..2;
    BMouseDown : Boolean;
    TSS : TPoint;
    mas : array[1..8,1..8] of Byte;
    Constructor Create;
    Procedure MouseDown (Stroka, Stolb : Byte; Var Bool : Boolean);
    Procedure FiguresCount (Var White, Black : Byte);
    Procedure Messages (i : Byte);
    Procedure Proverka (T : TPoint; Stroka, Stolb : Byte;
                        Var Bool, Double : Boolean; Var Dbl : TPoint);
    Procedure ReloadMas (Str, Stolb : Byte; Point : TPoint; Double : Boolean; DblP : TPoint);
    Procedure BoardHelp (Stroka, Stolb : Byte);
    Procedure NoChangeOrder (Stroka, Stolb : Byte; Var NoChangeOrder : Boolean);
    Procedure Proverka_GoTo (Str, Stolb : Byte; Var masBool : ArrBool;
                             Var masCoord : ArrCoord);
    Procedure Scanner (Var kol : Byte; Var ScanMas : ArrCoord);
    Procedure PlaySound (Wave : TLMDWaveComp; ind : Byte);
    Procedure FigureTrue (Str, Stolb : Byte);
    Procedure Damka_Go (Fig : TPoint; Str, Stolb : Byte;
                        Var Bool, Double : Boolean; Var Dbl : TPoint);
    Procedure IsDamka_Fight (X, Y : Byte; Var Bool : Boolean; Var Coord : TPoint);                    
end;

Объявление класса, отвечающего за логику в игре шашки.
Объектный подход :)

ClassVar, 16 Ноября 2010

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

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

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

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

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

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

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

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

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

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

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

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