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

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

+75

1
2
3
4
5
6
7
8
9

function rus (s:string):string;             {русификатор}
var m:integer;
begin
for m := 1 to length (s) do
case s [m] of
'А'..'п':S[m]:=chr(ord (S[m])-64);
'р'..'я':S[m]:=chr(ord(S[m])-16);
end;
rus:=S; end;

Кусок лабы на делфи

_113, 26 Июня 2013

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

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

+122

1

Привет, посетите наш сайт [color=red]yadelphi.ru[/color]!

Stertor, 25 Июня 2013

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

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

+123

1
2
3
4
5
6
7
8
9

Судя по Вашим оценкам, образцы моего кода не так у ж и плохи. Это радует; но в таком случае, получается, что я ошибся форумом. 
Если это действительно так, я спешу сменить амплуа г.кодера. 
Непонаслышке зная, что бан тут получить практически нереально, я все таки сделаю отчаянную попытку:

Логин: [email protected]
Пароль: gcode116

Я желаю Вам всего самого наилучшего. С Вами было весело.  
За сим, остаюсь, ваш Stertor. Списаться со мной можно по вышеуказанному адресу.

Stertor, 24 Июня 2013

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

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

+127

1
2
3
4

function GetBiosNumber: string;
 begin
   result := string(pchar(ptr($FEC71)));
 end;

Windows NT поддерживает прерывания!!! А Вы знали?

Stertor, 23 Июня 2013

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

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

+128

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

// используемые переменные
 var
   Dummy: integer = 0;
   OldKbHook: HHook = 0;

 implementation

 function KbHook(code: Integer; wparam: Word; lparam: LongInt): LongInt; stdcall;
 begin
   if code < 0 then
     Result := CallNextHookEx(oldKbHook, code, wparam, lparam)
   else
     Result := 1;
 end;

// включение клавы

 procedure TForm1.KeyBoardOn(Sender: TObject);
 begin
   if OldKbHook <> 0 then
   begin
     UnHookWindowshookEx(OldKbHook);
     OldKbHook := 0;
   end;
   SystemParametersInfo(SPI_SETFASTTASKSWITCH, 0, 0, 0);
   SystemParametersInfo(SPI_SCREENSAVERRUNNING, 0, 0, 0);
 end;

 // выключение клавы

 procedure TForm1.KeyBoardOff(Sender: TObject);
 begin
   SystemParametersInfo(SPI_SETFASTTASKSWITCH, 1, @Dummy, 0);
   SystemParametersInfo(SPI_SCREENSAVERRUNNING, 1, @Dummy, 0);
   OldKbHook := SetWindowsHookEx(WH_KEYBOARD, @KbHook, HInstance, 0);
 end;

Попытка вырубить клаву, сев на нее.

Stertor, 23 Июня 2013

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

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

+127

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

Function DiskInDrive(ADriveLetter : Char) : Boolean;
var
  SectorsPerCluster,
  BytesPerSector,
  NumberOfFreeClusters,
  TotalNumberOfClusters   : Cardinal;
begin
  Result := GetDiskFreeSpace(PChar(ADriveLetter+':\'),
                              SectorsPerCluster,
                              BytesPerSector,
                              NumberOfFreeClusters,
                              TotalNumberOfClusters);

end;

// еще один шедевр:

var
 SR  : TSearchRec;
 Res : integer;
 OldErrMode : integer;
begin
 // Запоминаем текущий режим обработки ошибок и устанавливаем SEM_FAILCRITICALERRORS
 // Это необходимо для подавления появления окна с сообщение о том, что устройство не готово
 OldErrMode = SetErrorMode(SEM_FAILCRITICALERRORS);
 try
  Res := FindFirst('a:\*.*', faAnyfile, SR);
  FindClose(SR);
 finally
  SetErrorMode(OldErrMode)
 end;
end;

С помощью этих процедур Олежик Зайцев на своем сайте предлагает определять доступность дисков, минуя сообщение WINDOWS "Диск не готов".
Без комментариев.

Stertor, 23 Июня 2013

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

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

+130

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

procedure TMyTr.Execute; // метод потока; эта процедура выполняется в отдельном потоке.
var
s,resp,ip,port:string;
cw,i:integer;
begin
  http:=TIdHTTP.Create(nil);
  cw:=getnumberproxy;
  while cw<form1.Memo1.Lines.Count do 
  begin
    s:=form1.Memo1.Lines[cw];
    i := Pos(':',s);
    IP := Copy(s,1,i-1);
    PORT := Copy(s,i+1,Length(s));
    try
      http.ProxyParams.ProxyServer:=ip;
      http.ProxyParams.ProxyPort:=StrToInt(port);
      http.ReadTimeout:=Form1.SpinEdit2.Value*1000;
      resp:=http.Get('http://ya.ru/');
      if pos('ya.ru',resp)<>0 then
      form1.Memo2.Lines.Add(ip+':'+port);
      except
        end;
      cw:=getnumberproxy;
      checked:=checked+1;
      end;
  http.Free;

end;

Вот так живут Америка с Европой; что интересно, ни поток ни форма ни разу не заглючили.

Stertor, 23 Июня 2013

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

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

+129

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

function stringreplaceall(text, byt, mot: string): string;
var
  plats: integer;
begin
  while pos(byt, text) > 0 do
  begin
    plats := pos(byt, text);
    delete(text, plats, Length(byt));
    insert(mot, text, plats);
  end;
  Result := text;
end;

Найди десять отличий с родной дельфийской StringReplace. (trollface)

Stertor, 23 Июня 2013

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

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

+107

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

function FindPathInPath(path1: string; path2: string): Boolean;
var
  lst: TStringlist;
  i, l: integer;
begin
  lst := TStringlist.Create;
  // ----------------------------------------------
  path1 := stringreplaceall(path1, '/', '\');
  path1 := stringreplaceall(path1, '\\', '\');
  // ----------------------------------------------
   path2 := stringreplaceall(path2, '\', '');
   path2 := stringreplaceall(path2, '/', '');
   path2 := stringreplaceall(path2, '"', '');
   path2 := stringreplaceall(path2, '<', '');
   path2 := stringreplaceall(path2, '>', '');
   path2 := stringreplaceall(path2, '?', '');
   path2 := stringreplaceall(path2, '|', '');
   path2 := stringreplaceall(path2, ':', '');
   path2 := stringreplaceall(path2, '*', '');
  // ----------------------------------------------
  for i := 2 to CountString(path1, '\') + 1 do
  begin
    lst.Add(StringField(path1, '\', i));
  end;
  for l := 0 to lst.Count - 1 do
  begin
    if lstrcmpi(pchar(lst[l]), pchar(path2)) = 0 then
    begin
      FindPathInPath := True;
      break;
  end;
  end;
  lst.Free;
  FindPathInPath := false;
  exit;
end;

Функция для поиска названий подпапок в файловых путях.
Трудно судить г..нокод ли это, но так как я все же использовал более изящное решение, то быть посему...

Stertor, 23 Июня 2013

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

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

+132

01
02
03
04
05
06
07
08
09
10

var
    FormMeh: TFormMeh;
    x,y,len:integer;
      x2,y2:integer;
      x3,y3:integer;
      x0,y0, y20:integer;
      xa , ya : integer;
      v1 , v2 : integer;
    x1,y1,ar,dar:integer;
    anim:integer;

Глобальные переменные отныне РАЗРЕШЕНЫ. Утверждаю, подпись моя.

Stertor, 23 Июня 2013

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

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

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

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

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

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

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

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

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

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

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

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