-
+99
- 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
Procedure MakeChain(x: real; var a: array of word); (* Процедура раскладывает вещественное число в цепную дробь *)
var
i: byte;
begin
i:=0;
Repeat
a[i]:=Int(x); x:=1/(x-a[i]); i:=i+1
Until (abs(1/x) < epsilon) or (Int(x) = 0) (* NB! *)
end;
Procedure MakeFrac(a: array of word; var AN, BN: word); (* Процедура собирает обыкновенную дробь из цепной дроби *)
var
i: byte; AP, BP: word; temp: word;
begin
AN:=1; AP:=0; BN:=a[1]; BP:=1; i:=2;
Repeat
temp:=AN; AN:=AN*a[i]+AP; AP:=temp;
temp:=BN; BN:=BN*a[i]+BP; BP:=temp;
i:=i+1
Until a[i] = 0 (* NB! *)
end;
Function PowerInt(x: real; p: longint): real; (* возведение числа в целую степень *)
var
R: real;
begin
R:=1; if p<0 then x:=1/x; p:=abs(p);
Repeat
if p and 1 = 1 then R:=R*x;
p:=p shr 1;
if p<>0 then x:=sqr(x)
Until p=0;
PowerInt:=R
end;
Function Power(x: real; p: real): real;
var
y: real;
z: array[0..16000 div sizeof(word)] of word;
a, b: word;
begin
y:=PowerInt(x, Trunc(p)) * exp(Frac(p) * ln(abs(x)));
if x<0 then
begin
MakeChain(Frac(p), z);
MakeFrac(z, a, b);
if Odd(b) then
begin
if Odd(a) then y:=-y (* если числитель и знаменатель показателя степени нечётные, меняем знак результата *)
end
else
begin
(* NB! В случае чётного знаменателя показателя степени результат комплексный. Забьём на это *)
end
end;
Power:=y
end;
Инновационный алгоритм, написанный мной лет 12 тому назад, позволяющий возводить отрицательные числа в дробную степень.
Жанру сайта вполне соответствует, то есть не без говнокода.
inkanus-gray,
23 Декабря 2010
-
+106
- 01
- 02
- 03
- 04
- 05
- 06
- 07
- 08
- 09
- 10
- 11
- 12
- 13
- 14
- 15
- 16
- 17
- 18
- 19
- 20
- 21
function IsRunningWithAdminPrivs: Boolean;
begin
var
List: TStringList;
begin
List := TStringList.Create;
try
try
List.Text := 'Sample';
// Use SHGetFolder path to retreive the program files folder
// here is hardcoded for the sake of the example
List.SaveToFile('C:\program files\test.txt');
Result := True;
except
Result := False;
end;
finally
List.Free;
DeleteFile('C:\program files\test.txt');
end;
end;
Нуфф Саид
bugmenot,
22 Декабря 2010
-
+109
- 01
- 02
- 03
- 04
- 05
- 06
- 07
- 08
- 09
- 10
- 11
- 12
- 13
- 14
- 15
- 16
- 17
procedure RemoveDir(path: string);
var
sr: TSearchRec;
begin
if FindFirst(path + '\*.*', faAnyFile, sr) = 0 then
begin
repeat
if sr.Attr and faDirectory = 0 then
DeleteFile(path + '\' + sr.name);
else
RemoveDir(path + '\' + sr.name);
until
FindNext(sr) <> 0;
end;
FindClose(sr);
RemoveDirectory(PChar(path));
end;
История такова, писал я как-то программу по курсовому. (Это было еще года два-три назад, когда я про юнит тесты и различные технологии проектирования и разработки ничего не знал.) По задумки программа распаковывала некие файлы во временный каталог рядом с приложением и по завершению работы с ними удаляла эту папку вот этим методом. Итак, запустил я эту подпрограмму на выполнение для проверки ее работоспособности и смотрю в файловом менеджере, что папка успешно удалилась и все ок. Но вдруг студия начала жаловаться что нет каких-то файлов, я смотрю в файловый менеджер и вижу что файлы проекта программы исчезают буквально на глазах! Естественно я резко убиваю программу и далее начинаю восстанавливать исходники. Благо, что делал бэкапы и эта подпрограмма проработала все ничего, а ведь последствия могли быть еще больше. А мораль такая, нужно быть предельно внимательным, когда работаешь с удалением какой-либо информации.
P.S. Нужно добавить проверку между 10 и 11 строкой:
if (sr.Name <> '..') and (sr.Name <> '.') then
vanished,
18 Декабря 2010
-
+113
- 01
- 02
- 03
- 04
- 05
- 06
- 07
- 08
- 09
- 10
- 11
- 12
- 13
- 14
- 15
- 16
- 17
- 18
- 19
- 20
function FUNC(XD: TXMLDocument; L: ShortString): IXMLNode;
var
c: integer;
ln: IXMLNode;
s: ShortString;
begin
c:=0;
while c <> XD.DocumentElement.ChildNodes.Count-1 do
begin
if VarToStr(XD.DocumentElement.ChildNodes[c].Attributes['id']) = L then
begin
ln:=XD.DocumentElement.ChildNodes[c];
c:=XD.DocumentElement.ChildNodes.Count-1
end else
begin
c:=c+1; {DEBUG(VarToStr(XD.DocumentElement.ChildNodes[c].Attributes['id'],L) }
end
end;
result:=ln
end;
К слову о невнимательности и "непримеченных слонах". Итак задачка: перебором найти в наборе данных нужную строку и вернуть в итоговый результате элемент набора данных. Используем код (выше). По невнимательности своей я допустил в алгоритме ошибку и функция работала несколько некорректно. Перед Вами её изначальный вариант, до исправления. Если вкратце, то баг заключался в том, что функция не читала последний элемент XML-документа. Называется, нефиг было мудрить с алгоритмом. По сути там надо убрать из двух мест "-1". Но пока я докапывался до сути ошибки, я написал тестовую функцию, сравнивающую две строки и выводящую результат сравнения в окно сообщения. Назовём её DEBUG. И... Началось непонятное. Функция выдавала сообщение, значит результаты, как видно по алгоритму, не равны, но она выдавала РАВЕНСТВО! Мозг взрывается, ломаются представления о математике и рациональности вообще!
Xander_Bass,
18 Декабря 2010
-
+92
- 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
unit uncrt;
interface
procedure ClrScr;
procedure Sound(Hz: Word);
procedure NoSound;
procedure TextColor(Color: Byte);
procedure TextBackground(Color: Byte);
var
TextAttr: Byte; { Для особо продвинутых случаев }
implementation
procedure ClrScr;
begin end;
procedure Sound(Hz: Word);
begin end;
procedure NoSound;
begin end;
procedure TextColor(Color: Byte);
begin end;
procedure TextBackground(Color: Byte);
begin end;
end.
Вас достала школота, раскрашивающая свои бибикающие программы?
Вам поможет этот модуль!
TarasB,
16 Декабря 2010
-
+107
- 1
- 2
OpenDialog1.Execute;
Memo1.Lines.LoadFromFile(OpenDialog1.FileName);
Угадайте, что будет, если в опендиалоге нажать "Отмена".
PEMOHT,
16 Декабря 2010
-
+104
- 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
procedure TForm1.FormCreate(Sender: TObject);
begin
RS[0]:='а'; PRS[0]:='@';
RS[1]:='б'; PRS[1]:='6';
RS[2]:='в'; PRS[2]:='B';
RS[3]:='г'; PRS[3]:='r';
RS[4]:='д'; PRS[4]:='g';
RS[5]:='е'; PRS[5]:='e';
RS[6]:='ё'; PRS[6]:='e';
RS[7]:='ж'; PRS[7]:='}|{';
RS[8]:='з'; PRS[8]:='3';
RS[9]:='и'; PRS[9]:='u';
RS[10]:='й'; PRS[10]:='u';
RS[11]:='к'; PRS[11]:='k';
RS[12]:='л'; PRS[12]:='JI';
RS[13]:='м'; PRS[13]:='M';
RS[14]:='н'; PRS[14]:='H';
RS[15]:='о'; PRS[15]:='o';
RS[16]:='п'; PRS[16]:='n';
RS[17]:='р'; PRS[17]:='p';
RS[18]:='с'; PRS[18]:='c';
RS[19]:='т'; PRS[19]:='T';
RS[20]:='у'; PRS[20]:='y';
RS[21]:='ф'; PRS[21]:='%';
RS[22]:='х'; PRS[22]:='x';
RS[23]:='ц'; PRS[23]:='?';
RS[24]:='ч'; PRS[24]:='4';
RS[25]:='ш'; PRS[25]:='III';
RS[26]:='щ'; PRS[26]:='III,';
RS[27]:='ъ'; PRS[27]:='b';
RS[28]:='ы'; PRS[28]:='bI';
RS[29]:='ь'; PRS[29]:='b';
RS[30]:='э'; PRS[30]:='&';
RS[31]:='ю'; PRS[31]:='I-o';
RS[32]:='я'; PRS[32]:='9I';
RS[33]:='А'; PRS[33]:='A';
RS[34]:='Б'; PRS[34]:='6';
RS[35]:='В'; PRS[35]:='B';
RS[36]:='Г'; PRS[36]:='r';
RS[37]:='Д'; PRS[37]:='g';
RS[38]:='Е'; PRS[38]:='E';
RS[39]:='Ё'; PRS[39]:='E';
RS[40]:='Ж'; PRS[40]:='}|{';
RS[41]:='З'; PRS[41]:='3';
RS[42]:='И'; PRS[42]:='U';
RS[43]:='Й'; PRS[43]:='U';
RS[44]:='К'; PRS[44]:='K';
RS[45]:='Л'; PRS[45]:='JL';
RS[46]:='М'; PRS[46]:='M';
RS[47]:='Н'; PRS[47]:='H';
RS[48]:='О'; PRS[48]:='O';
RS[49]:='П'; PRS[49]:='n';
RS[50]:='Р'; PRS[50]:='p';
RS[51]:='С'; PRS[51]:='c';
RS[52]:='Т'; PRS[52]:='T';
RS[53]:='У'; PRS[53]:='Y';
RS[54]:='Ф'; PRS[54]:='%';
RS[55]:='Х'; PRS[55]:='X';
RS[56]:='Ц'; PRS[56]:='?';
RS[57]:='Ч'; PRS[57]:='4';
RS[58]:='Ш'; PRS[58]:='III';
RS[59]:='Щ'; PRS[59]:='III,';
RS[60]:='Ъ'; PRS[60]:='b';
RS[61]:='Ы'; PRS[61]:='bI';
RS[62]:='Ь'; PRS[62]:='b';
RS[63]:='Э'; PRS[63]:='&';
RS[64]:='Ю'; PRS[64]:='I-O';
RS[65]:='Я'; PRS[65]:='9I';
ES[0]:='a'; PPS[0]:='@';
ES[1]:='b'; PPS[1]:='6';
ES[2]:='c'; PPS[2]:='|_|,';
ES[3]:='d'; PPS[3]:=',^,';
ES[4]:='e'; PPS[4]:='e';
ES[5]:='f'; PPS[5]:='%';
ES[6]:='g'; PPS[6]:='|"';
ES[7]:='h'; PPS[7]:='][';
ES[8]:='i'; PPS[8]:='|/|';
ES[9]:='j'; PPS[9]:='>|<';
ES[10]:='k'; PPS[10]:='K';
ES[11]:='l'; PPS[11]:='/\';
ES[12]:='m'; PPS[12]:='M';
ES[13]:='n'; PPS[13]:='|-|';
ES[14]:='o'; PPS[14]:='0';
ES[15]:='p'; PPS[15]:='n';
ES[16]:='q'; PPS[16]:='k|3';
ES[17]:='r'; PPS[17]:='P';
ES[18]:='s'; PPS[18]:='$';
ES[19]:='t'; PPS[19]:='T';
ES[20]:='u'; PPS[20]:='Y';
ES[21]:='v'; PPS[21]:='\/';
ES[22]:='w'; PPS[22]:='|3';
ES[23]:='x'; PPS[23]:='kc';
ES[24]:='y'; PPS[24]:='9';
ES[25]:='z'; PPS[25]:='3';
ES[26]:='A'; PPS[26]:='@';
ES[27]:='B'; PPS[27]:='6';
ES[28]:='C'; PPS[28]:='|_|,';
ES[29]:='D'; PPS[29]:=',^,';
ES[30]:='E'; PPS[30]:='E';
ES[31]:='F'; PPS[31]:='%';
Найдено в DRKB. Double F@$EР@LM.
Govnocoder#0xFF,
13 Декабря 2010
-
+109
- 1
- 2
- 3
- 4
- 5
procedure TForm2.ExitButtonClick(Sender: TObject);
begin
Close;
Form1.Close;
end;
Об Application.Terminate даже и не догадываемся...
PEMOHT,
12 Декабря 2010
-
+105
- 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
case nd of
0..9:days.Caption := '00'+IntToStr(nd);
10..99:days.Caption := '0'+IntToStr(nd);
100..999:days.Caption := IntToStr(nd);
end;
case nh of
0..9:hrs.Caption := '0'+IntToStr(nh);
10..99:hrs.Caption := IntToStr(nh);
end;
case nm of
0..9:mins.Caption := '0'+IntToStr(nm);
10..99:mins.Caption := IntToStr(nm);
end;
case nsec of
0..9:secs1.Caption := '0'+IntToStr(nsec);
10..99:secs1.Caption := IntToStr(nsec);
end;
case nsec2 of
0..9:secs2.Caption := '0000000'+IntToStr(nsec2);
10..99:secs2.Caption := '000000'+IntToStr(nsec2);
100..999:secs2.Caption := '00000'+IntToStr(nsec2);
1000..9999:secs2.Caption := '0000'+IntToStr(nsec2);
10000..99999:secs2.Caption := '000'+IntToStr(nsec2);
100000..999999:secs2.Caption := '00'+IntToStr(nsec2);
1000000..9999999:secs2.Caption := '0'+IntToStr(nsec2);
10000000..99999999:secs2.Caption := IntToStr(nsec2);
end;
Таймер для дураков.
PEMOHT,
12 Декабря 2010
-
+107
- 01
- 02
- 03
- 04
- 05
- 06
- 07
- 08
- 09
- 10
- 11
- 12
- 13
Uses Windows;
Var Olly : hWnd;
begin
Olly:=FindWindow('OllyDBG', nil);
If Olly <> 0 then Exit;
Olly:=FindWindow('OllyDbg', nil);
If Olly <> 0 then Exit;
Olly:=FindWindow('OLLYDBG', nil);
If Olly <> 0 then Exit;
Olly:=FindWindow('ollydbg', nil);
If Olly <> 0 then Exit;
MessageBox(0, 'You are run me!', 'RunMe v0.1', 48);
end.
Код моей молодости. Кто не вкурил, это такая говнозащита от отладчика OllyDbg.
Govnocoder#0xFF,
11 Декабря 2010
Follow us!