- 1
For i:=0 to 40 do For j:=1 to 10 do if (j=0) and (j=10) then W[i,j]:=0;
Нашли или выдавили из себя код, который нельзя назвать нормальным, на который без улыбки не взглянешь? Не торопитесь его удалять или рефакторить, — запостите его на говнокод.ру, посмеёмся вместе!
+105
For i:=0 to 40 do For j:=1 to 10 do if (j=0) and (j=10) then W[i,j]:=0;
Проблемы?
+107
function Ns(ds: char; var vs: byte): boolean;
begin
case ds of
'Q': vs:= 81;
'W': vs:= 87;
'E': vs:= 69;
'R': vs:= 82;
'T': vs:= 84;
'Y': vs:= 89;
'U': vs:= 85;
'I': vs:= 73;
'O': vs:= 79;
'P': vs:= 80;
'A': vs:= 65;
'S': vs:= 83;
'D': vs:= 68;
'F': vs:= 70;
'G': vs:= 71;
'H': vs:= 72;
'J': vs:= 74;
'K': vs:= 75;
'L': vs:= 76;
'Z': vs:= 90;
'X': vs:= 88;
'C': vs:= 67;
'V': vs:= 86;
'B': vs:= 66;
'N': vs:= 78;
'M': vs:= 77;
else vs:= 0;
end;
if vs = 0 then Result:= false else Result:= true;
end;
Определение кода виртуальных клавиш, вот что бывает, когда кто-то не знает матчасть, вся эта белиберда легко заменяется на :
function Ns(ds: char; var vs: byte): boolean;
begin
case ds of
'A'..'Z': vs:= byte(ds);
else vs:= 0;
end;
if vs = 0 then Result:= false else Result:= true;
end;
И не лень же было клаву мучить!
+72
const
zn1 = #60; { < }
zn2 = #62; { > }
function EnCrypt(ds: string): string;
var
k,l,m: string;
i,b,g: integer;
t: char;
function Lvs(ds: byte): string;
begin
case ds of
Byte(zn1): Result:= zn1+zn2;
Byte(zn2): Result:= zn2+zn1;
0: if Random(2)=0 then Result:= zn1+zn1
else Result:= zn2+zn2;
else
Result:= Chr(ds);end;
end;
begin
if length(ds)=0 then Exit;
Randomize; k:=''; m:=''; b:=1;
for i:=1 to RandomRange(5,16) do
k:= k+Chr(RandomRange(1,256));
for i:=1 to Length(ds) do begin
g:= Byte(ds[i])xor Byte(k[b]);
l:= Lvs(g); t:= k[b];
if i<= Length(k) then m:= m+t+l else m:=m+l;
Inc(b);
if b>Length(k) then b:= 1;
end;
l:= Chr(Length(k))+m;
for i:=1 to Length(l) do begin
b:= Byte(l[I]) xor i;k:= Lvs(b);
Result:= Result+k;
end;
end;
function DeCrypt(ds: string): string;
var
k,c,l,n: string;
i,b,m: integer;
d: boolean;
function Svl(ds: string; ts: integer): char;
var t: byte;
begin
t:=Byte(ds[1]);
if ds=zn1+zn2 then t:=Byte(zn1);
if ds=zn2+zn1 then t:=Byte(zn2);
if(ds=zn1+zn1) or (ds=zn2+zn2) then t:= 0;
Result:=Chr(Byte(t xor ts));
end;
begin
if length(ds)=0 then Exit;
b:=1; i:=1; n:='';
while i<=Length(ds) do begin c:= ds[i];
if (ds[i]=zn1)or(ds[i]=zn2)then begin
c:=ds[i]+ds[i+1]; Inc(i); end;
Inc(i);
n:= n+Svl(c,b);
Inc(b);
end; c:=''; k:=''; b:=1; i:=1;
d:=false;
m:=Byte(n[1]);
Delete(n,1,1);
while i<=Length(n)do begin
if b<=m*2 then begin if d then begin
l:=n[i];
if (n[i]=zn1) or (n[i]=zn2) then
begin
l:= n[i]+n[i+1]; Inc(i);
end;
c:=c+l;
Inc(b);
d:=false;
end else
begin
k:=k+n[i]; d:=true; Inc(b);
end;
end else begin
l:= n[i];
if (n[i]=zn1) or (n[i]=zn2) then
begin l:= n[i]+n[i+1]; Inc(i); end;
c:=c+l; end;
Inc(i); end;
if length(c)=0 then Exit;
i:=1;b:=1;
while i<=Length(c)do begin
l:=c[i];
if (c[i] = zn1) or (c[i] = zn2) then
begin
l:= c[i] + c[i+1]; Inc(i);
end;
Inc(i);
Result:= Result + Svl(l, Byte(k[b]));
Inc(b);
if b>Length(k)then b:=1;
end;
end;
В очень далёком 99м году была совершена попытка шифровать и дешифровать пароли пользователей простым ХОР-замесом. Тогда такой способ казался идеальным и оригинальным :) Но посмотрите, если руки не оттуда откуда надо растут, как же можно извратиться, чистый говнокод! До сих пор им пользуюсь, немного. Интересно, ктонить догадается, зачем здесь константные знаки используются?
+95
function bth(ds: byte): string;
const
b: string = '0123456789ABCDEF';
begin
Result:= b[(ds shr 4) + 1] + b[(ds and $F) + 1];
end;
Некоторое время назад потребовалось конвертить Byte в Hex. Стандартных способов не нашёл, а ничего лучше такой говнокодки выдумать не получилось. Сейчас смотрю и разбирает смех - весёлые были времена!
+92
function lz_UploadMount:boolean;
var del_l,i,j,k,ng,l,typ:integer;
pt:array[1..3]of integer;
begin
UpDiag:=0;
result:=true;
if I_AM_EMUL {or not I_AM_MAIN }then exit;
if Pult[1].Count+Pult[2].Count=0 then exit;
lg_UploadMount;
// exit;
UpDiag:=1;
result:=false;
__UPLOADING:=true;
try
if not JustC(21,[])then exit;
sleep(1000);
//if (Pult[1].Count>0)and(Pult[2].Count>0)then ng:=3 else ng:=1;
//if not JustC(25,[ng])then exit;;
if not JustC(22,[])then exit;;
{группы}
if (Pult[1].Count>0)and(Pult[2].Count>0)then ng:=2 else ng:=1;
for i:=1 to 2 do
begin
if Pult[i].Count=0 then continue;
k:=0;
for j:=1 to 3 do pt[j]:=MainShow.Params[j];
for j:=0 to Pult[i].Count-1 do
with TMotor(Pult[i][j])do
begin
k:=k+(1 shl (ConvertTP(TP)-1));
for L:=1 to 3 do if pt[L]>GParam(L)then pt[L]:=GParam(L);
end;
//маска
AddI(k);
//скорость
AddSpeed(round(pt[1]*KOREDV));
//ускорение разгона
//ускорение торможения
AddI((pt[2]shl 16)+pt[3]);
//номер джойстика
//функциональная клавиша
{Кнопка} {Джойстик}{повторы} {тип группы}
typ:=2;
AddI((i shl 6)+(i shl 3)+(1 shl 10)+typ);
end;
if not lz_Command(26,4,ng,[ng])then exit;;
CheckMountEffect;
{моторы}
lzData.Clear;
for i:=1 to 2 do
for j:=0 to Pult[i].Count-1 do
with TMotor(Pult[i][j])do
begin
if md_targ<0 then AddI((17 shl 16)+ConvertTP(TP))else AddI((18 shl 16)+ConvertTP(TP));
if md_targ<GetMotorInfo(TP,1)then del_l:=-1 else del_l:=1;
if md_targ<0 then
begin
AddI(-trunc(GParam(5)/KORED*65536));
AddI(-trunc(GParam(4)/KORED*65536));
end
else
begin
AddI(-trunc((md_targ+del_l/2)/KORED*65536));
AddSpeed(round(md_way*KOREDV));
end
end;
if not lz_Command(28,3,Pult[1].Count+Pult[2].Count,[Pult[1].Count+Pult[2].Count])then exit;
UpDiag:=2;
if not JustC(23,[])then exit;
(*EnterCriticalSection(csJoystick);
j_Changed:=true;
{J_Status[1]:=false;
J_Status[2]:=false;}
LastSign[1]:=-1;
LastSign[2]:=-1;
LeaveCriticalSection(csJoystick);*)
{if(Pult[1].Count>0)then if not JustC(36,[1,1])then exit;
if(Pult[2].Count>0)then if not JustC(36,[2,1])then exit;}
UpDiag:=0;
result:=true;
Uploaded:=true;
for i:=1 to 12 do
FirstGr[i]:=0;
finally
__UPLOADING:=false;
if Uploaded then WaitZero;
end;
end;
Случайно открыл свою первую рабочую программу. Забавно, как со временем меняется стиль программирования :)
В той что используется сейчас изменился протокол, так что прямого аналога нет, но примерно ту же функцию выполняет такой кусок:
----------------
procedure TMotion.GetTargetForPLC(M: TMotor; Mo: TNormalMotionData);
var
Conf: TMotorConfig;
ME: TElementMark;
I: Integer;
Ht, SP: Real;
begin
if not Uploaded then
exit;
Conf := PLCConf.Motor(M.MotorNumber);
ME := Mark.ElementByMotor(M.MotorNumber);
SP := Panel.GetValue(Speed);
// Проверка разрешений движения
if (Panel.GetStatus <> psGo) or (not Condition.CheckMotion) or FailedSafe or
(SP = 0) or (not ME.CheckMotion) then
Mo.CommandID := mcStop
else
Mo.CommandID := mcGo;
Mo.Accel := LimitVal(1, Conf.MotorTyp.ProgramToDrive(ktAccel,
Limits.GetParam(TAccelParam).Minimum));
Mo.Deccel := LimitVal(1, Conf.MotorTyp.ProgramToDrive(ktAccel,
Limits.GetParam(TDeccelParam).Minimum));
if SP >= 0 then
Ht := Effect.OutputTarget(M)
else
Ht := ME.GetTargetForPLC(false);
// M.StartPos.Value := 0.5;
if M.PositionType.InheritsFrom(TAngleWithTu rnsParam) then
Ht := M.HackCircleTarget(Ht);
Mo.Target := Conf.MotorTyp.ProgramToDrive(ktTarget, Ht);
Mo.Speed := Conf.MotorTyp.ProgramToDrive(ktSpeed, abs(SP)); { }{ }{ }
Mo.Time := 0;
if SP >= 0 then
Effect.ProcessCommand(M, Mo);
Mo.Mask := M.Children + [M.MotorNumber];
for I in Mo.Mask do
GetMotor(I).RawCommand := Mo;
end;
----------------
+121
procedure TForm1.Timer2Timer(Sender: TObject);
begin
image75.Visible:=false;image76.Visible:=false;
image1.Visible:=true;image2.Visible:=true;image3.Visible:=true;
image4.Visible:=true;image5.Visible:=true;image6.Visible:=true;
image7.Visible:=true;image8.Visible:=true;image9.Visible:=true;
image10.Visible:=true;image11.Visible:=true;image12.Visible:=true;
image13.Visible:=true;image14.Visible:=true;image15.Visible:=true;
image16.Visible:=true;image17.Visible:=true;image18.Visible:=true;
image19.Visible:=true;image20.Visible:=true;image21.Visible:=true;
image22.Visible:=true;image23.Visible:=true;image24.Visible:=true;
image25.Visible:=true;image26.Visible:=true;image27.Visible:=true;
image28.Visible:=true;image29.Visible:=true;image30.Visible:=true;
image31.Visible:=true;image32.Visible:=true;image33.Visible:=true;
image34.Visible:=true;image35.Visible:=true;image36.Visible:=true;
image37.Visible:=true;image38.Visible:=true;image39.Visible:=true;
image40.Visible:=true;image41.Visible:=true;image42.Visible:=true;
image43.Visible:=true;image44.Visible:=true;image45.Visible:=true;
image46.Visible:=true;image47.Visible:=true;image48.Visible:=true;
image49.Visible:=true;image50.Visible:=true;image51.Visible:=true;
image52.Visible:=true;image53.Visible:=true;image54.Visible:=true;
image55.Visible:=true;image56.Visible:=true;image57.Visible:=true;
image58.Visible:=true;image59.Visible:=true;image60.Visible:=true;
image61.Visible:=true;image62.Visible:=true;image63.Visible:=true;
image64.Visible:=true;image65.Visible:=true;image66.Visible:=true;
image67.Visible:=true;image68.Visible:=true;image69.Visible:=true;
image70.Visible:=true;image71.Visible:=true;image72.Visible:=true;
image73.Visible:=true;
if image1.left<360 then begin timer2.Enabled:=false;button2.Visible:=true;
image1.Visible:=false;image2.Visible:=false;image3.Visible:=false;
image4.Visible:=false;image5.Visible:=false;image6.Visible:=false;
image7.Visible:=false;image8.Visible:=false;image9.Visible:=false;
image10.Visible:=false;image11.Visible:=false;image12.Visible:=false;
image13.Visible:=false;image14.Visible:=false;image15.Visible:=false;
image16.Visible:=false;image17.Visible:=false;image18.Visible:=false;
image19.Visible:=false;image20.Visible:=false;image21.Visible:=false;
image22.Visible:=false;image23.Visible:=false;image24.Visible:=false;
image25.Visible:=false;image26.Visible:=false;image27.Visible:=false;
image28.Visible:=false;image29.Visible:=false;image30.Visible:=false;
image31.Visible:=false;image32.Visible:=false;image33.Visible:=false;
image34.Visible:=false;image35.Visible:=false;image36.Visible:=false;
image37.Visible:=false;image38.Visible:=false;image39.Visible:=false;
image40.Visible:=false;image41.Visible:=false;image42.Visible:=false;
image43.Visible:=false;image44.Visible:=false;image45.Visible:=false;
image46.Visible:=false;image47.Visible:=false;image48.Visible:=false;
image49.Visible:=false;image50.Visible:=false;image51.Visible:=false;
image52.Visible:=false;image53.Visible:=false;image54.Visible:=false;
image55.Visible:=false;image56.Visible:=false;image57.Visible:=false;
image58.Visible:=false;image59.Visible:=false;image60.Visible:=false;
image61.Visible:=false;image62.Visible:=false;image63.Visible:=false;
image64.Visible:=false;image65.Visible:=false;image66.Visible:=false;
image67.Visible:=false;image68.Visible:=false;image69.Visible:=false;
image70.Visible:=false;image71.Visible:=false;image72.Visible:=false;
image73.Visible:=false;end
else begin image1.left:=image1.Left-3;image1.top:=image1.top-1;
image2.left:=image2.Left+2;image2.top:=image2.top+2;
image3.left:=image3.Left-1;image3.top:=image3.top-3;
image4.left:=image4.Left-2;image4.top:=image4.top+4;
...
Ещё 65 строк кода!
Анимация взрыва на Delphi 7.
+129
function assemble(var w:word;s:string):boolean;
.....
else if length(cmd)=3 then
begin
{ТРЕХБУКВЕННЫЕ КОМАНДЫ}
case cmd[1] of
'a':case cmd[2] of
'c':if cmd[3]='i' then
begin
code:=$ce;
typ:=7;
end;
'd':case cmd[3] of
'd':begin
code:=$80;
typ:=4;
end;
'c':begin
code:=$88;
typ:=4;
end;
'i':begin
code:=$c6;
typ:=7;
end;
end;
..... еще 500 подобных строк ....
end;
Прочитал http://govnokod.ru/10002 и вспомнил, как когда-то писал асм\дизасм\эмуль для 8080 на паскале.
+73
function ADHasFactory(const AIID: TGUID): Boolean;
var
oIntf: IUnknown;
begin
try
ADCreateInterface(AIID, oIntf, False);
Result := oIntf <> nil;
except
Pointer(oIntf) := nil;
Result := False;
end;
end;
AnyDAC. Проверка наличия фабрики для заданного интерфейса.
+78
> В какую середину?) он ставиться на свое место. У тебя не верное представление об устройстве данных в памяти.
procedure TForm1.Button1Click(Sender: TObject);
type
parr = ^tarr;
tarr = array of integer;
var
pparr: array of parr;
begin
setlength(pparr,1);
memo1.Lines.Add('first array pointer '+inttostr(integer(@pparr)));
new(pparr[0]);
memo1.Lines.Add('second array pointer '+inttostr(integer(pparr[0])));
memo1.Lines.Add('first element '+inttostr(integer(pparr[0]^)));
end;
> вывод
first array pointer 1242664
second array pointer 10822692
first element 0
Человек нашёл единственно верный путь использования двумерных динмассивов. Через указатель на указатель, правда он сам этого не понимает. Авторское форматирование и орфография сохранены.
Источник:
http://www.gamedev.ru/projects/forum/?id=161043&page=3#m35
+75
program pr8;
uses crt;
var
a:array [1..32] of char;
b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r:integer;
a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1: integer;
begin
a[1]:=' ';
a[2]:='Ў';
a[3]:='ў';
a[4]:='Ј';
a[5]:='¤';
a[6]:='Ґ';
a[7]:='¦';
a[8]:='§';
a[9]:='Ё';
a[10]:='©';
a[11]:='Є';
a[12]:='«';
a[13]:='¬';
a[14]:='';
a[15]:='®';
a[16]:='Ї';
a[17]:='а';
a[18]:='б';
a[19]:='в';
a[20]:='г';
a[21]:='д';
a[22]:='е';
a[23]:='ж';
a[24]:='з';
a[25]:='и';
a[26]:='й';
a[27]:='к';
a[28]:='л';
a[29]:='м';
a[30]:='н';
a[31]:='о';
a[32]:='п';
b:=21;
c:=24;
d:=6;
e:=13;
f:=15;
g:=19;
h:=18;
i:=20;
j:=10;
k:=21;
l:=10;
m:=10;
n:=14;
o:=9;
p:=10;
q:=18;
for r:=1 to 32 do
begin
a1:=b+r;
if a1>32 then a1:=a1-32;
b1:=c+r;
if b1>32 then b1:=b1-32;
c1:=d+r;
if c1>32 then c1:=c1-32;
d1:=e+r;
if d1>32 then d1:=d1-32;
e1:=f+r;
if e1>32 then e1:=e1-32;
f1:=g+r;
if f1>32 then f1:=f1-32;
g1:=h+r;
if g1>32 then g1:=g1-32;
h1:=i+r;
if h1>32 then h1:=h1-32;
i1:=j+r;
if i1>32 then i1:=i1-32;
j1:=k+r;
if j1>32 then j1:=j1-32;
k1:=l+r;
if k1>32 then k1:=k1-32;
l1:=n+r;
if l1>32 then l1:=l1-32;
m1:=m+r;
if m1>32 then m1:=m1-32;
n1:=o+r;
if n1>32 then n1:=n1-32;
o1:=p+r;
if o1>32 then o1:=o1-32;
p1:=q+r;
if p1>32 then p1:=p1-32;
writeln(a[a1],a[b1],a[c1],a[d1],a[e1],a[f1],a[g1],' ',a[h1],a[i1],a[j1],a[k1],a[l1],a[m1],a[n1],a[o1],a[p1]);
end;
readln;
CLRSCR
end.
Парниша пытался написать шифр Цезаря... :)