Здесь представлены полезные подпрограммы, которые могут пригодиться при написании своих программ, а также рассматриваются примеры готовых проектов, создаваемых в среде программирования Delphi. График функции function f(x: real): real; begin Result:=10*Sin(x/2); end; procedure TForm1.Button1Click(Sender: TObject); const k=18.5; // коэффициент масштабирования var i, x0, y0, xi, yi: integer; x, y: real; begin With Image1.Canvas do begin { очистка поля } Pen.Color:=clWhite; Brush.Color:=Pen.Color; Rectangle(0, 0, Image1.Width, Image1.Height); { начало координат (центр поля) } x0:=Image1.Width div 2; y0:=Image1.Height div 2; { рисование координат } Pen.Color:=clBlack; MoveTo(0, y0); LineTo(Image1.Width, y0); MoveTo(x0, 0); LineTo(x0, Image1.Height); { рисование стрелок } MoveTo(Image1.Width-10, y0-5); LineTo(Image1.Width, y0); LineTo(Image1.Width-11, y0+6); MoveTo(x0-5, 10); LineTo(x0, 0); LineTo(x0+6, 11); { нанесение делений на осях } For i:=-Round(x0/k) to Round((x0-20)/k) do // 20 - на стрелках не наносить begin xi:=x0+Round(i*k); If i<>0 then TextOut(xi-5, y0+5, IntToStr(i)); MoveTo(xi, y0-3); LineTo(xi, y0+4); end; For i:=-Round(y0/k) to Round((y0-20)/k) do begin yi:=y0-Round(i*k); If i<>0 then TextOut(x0+5, yi-7, IntToStr(i)); MoveTo(x0-3, yi); LineTo(x0+4, yi); end; { рисование самой функции } Pen.Color:=clRed; y:=f(-x0/k); yi:=y0-Round(y*k); MoveTo(0, yi); For i:=0 to Image1.Width do begin x:=(i-x0)/k; y:=f(x); xi:=x0+Round(x*k); yi:=y0-Round(y*k); LineTo(xi, yi); end; end; end; Генератор псевдослучайных чисел (ГПСЧ) Нельзя говорить, что программа выдает случайные числа. На самом деле она их выдает по определенному алгоритму в строгой последовательности. В этой статье рассмотрен алгоритм работы программы. 1. Как работает процедура Randomize? Процедура Randomize инициализирует генератор случайных чисел, задавая значение переменной RandSeed, вычисленное с помощью системных часов. Переменная RandSeed - это глобальная предопределенная переменная, объявленная в модуле System. Она задает начальное значение для генератора случайных чисел. Переменная RandSeed также устанавливает генератор случайного числа на следующее значение. procedure Randomize1; var SystemTime: TSystemTime; begin GetSystemTime(SystemTime); With SystemTime do RandSeed:=((wHour*60 + wMinute)*60 + wSecond)*1000 + wMilliseconds; end; В данной процедуре видно, что переменная RandSeed зависит от системных часов (время всемирное - по Гринвичу). При запуске программы эта переменная равна нулю. Поэтому при запуске программы надо хотя бы один раз вызвать процедуру Randomize, которая устанавливает начальное значение переменной RandSeed из данных системного времени. Так как программа запускается в какое-то случайное время, то и значение переменной RandSeed будет случайным. А, следовательно, и функция Random будет возвращать случайные значения. Исходя из того, что процедура Randomize задает начальное значение переменной RandSeed на основе текущего времени компьютера, можно предположить, что, например, если запустить программу сегодня в 12:00:00 и завтра в это же время, то функция Random вернет одинаковые числа. К сожалению, проверить это очень трудно, так как запустить программу в одно и то же время с точностью до миллисекунды будет практически невозможно. Например, допустим, что сейчас 10 часов, 54 минуты, 38 секунд и 812 миллисекунд. В компьютере установлен 3-й часовой пояс (UTC+03:00, Москва). В этом случае всемирное время равно 7:54:38,812. Тогда переменная RandSeed примет значение 28478812 (((7*60 + 54)*60 + 38)*1000 + 812). Рассмотрим еще пример. Запустим 2 процедуры Randomize и Randomize1 при запуске программы, а результаты переменной RandSeed выведем в Memo1 и Memo2. procedure TForm1.FormCreate(Sender: TObject); begin Randomize; Memo1.Text:=IntToStr(RandSeed); Randomize1; Memo2.Text:=IntToStr(RandSeed); end; После запуска программы увидим, что значение переменной RandSeed в обоих случаях совпадает. Это доказывает то, что RandSeed действительно зависит от системных часов. Примечание. В названиях процедур (или функций) будем добавлять порядковые номера (1, 2, 3, ...) для того, чтобы не переопределять системные процедуры (или функции). 2. Как работает функция Random? Рассмотрим работу функции для целых чисел. Поскольку переменная RandSeed задает начальное значение для генератора случайных чисел, функция Random генерирует случайное число (если быть точным, оно рассчитывается по определенному алгоритму). function Random1(Range: integer): integer; var z: int64; begin RandSeed:=RandSeed*$8088405 + 1; z:=RandSeed; If z<0 then z:=z+$100000000; z:=z*Range; Result:=z div $100000000; end; где Range - диапазон случайных чисел. Примечание. Числа, начинающие со знака "$", являются шестнадцатеричными числами. $8088405 - 134 775 813 $100000000 - 4 294 967 296 Согласно этой функции, последовательность чисел зависит от переменной RandSeed. Но, если значение переменной RandSeed будет всегда одинаковым, то мы получим одинаковый набор случайных чисел. Еще одна особенность заключается в том, что переменная RandSeed всегда изменяется при вызове функции Random, т.е. устанавливает генератор случайного числа на следующее значение. Рассмотрим пример образования последовательности чисел в диапазоне от 0 до 50 (Range = 50). Процедуру Randomize вызывать не будем (RandSeed = 0). Последовательность чисел будем вызывать с помощью функций Random1 и Random (для проверки). procedure TForm1.Button1Click(Sender: TObject); const r = 50; rs = 0; var i, a: integer; begin Memo1.Clear; RandSeed:=rs; For i:=1 to 30 do begin a:=Random(r); Memo1.Lines.Add(Format('%d число = %d, RandSeed = %d',[i,a,RandSeed])); end; Memo2.Clear; RandSeed:=rs; For i:=1 to 30 do begin a:=Random1(r); Memo2.Lines.Add(Format('%d число = %d, RandSeed = %d',[i,a,RandSeed])); end; end; Тексты в Memo1 и Memo2 будут выглядеть одинаково: 1 число = 0, RandSeed = 1 2 число = 1, RandSeed = 134775814 3 число = 43, RandSeed = -596792289 4 число = 10, RandSeed = 870078620 5 число = 13, RandSeed = 1172187917 6 число = 33, RandSeed = -1410233534 7 число = 15, RandSeed = 1368768587 8 число = 8, RandSeed = 694906232 9 число = 18, RandSeed = 1598751577 10 число = 21, RandSeed = 1828254910 11 число = 4, RandSeed = 352239543 12 число = 23, RandSeed = 2039224980 13 число = 3, RandSeed = 303092965 14 число = 42, RandSeed = -683524998 15 число = 2, RandSeed = 256513635 16 число = 14, RandSeed = 1259699184 17 число = 45, RandSeed = -355259471 18 число = 18, RandSeed = 1580146294 19 число = 38, RandSeed = -967806897 20 число = 16, RandSeed = 1408429452 21 число = 34, RandSeed = -1298476099 22 число = 42, RandSeed = -669280590 23 число = 35, RandSeed = -1211254405 24 число = 15, RandSeed = 1317014376 25 число = 8, RandSeed = 698472713 26 число = 16, RandSeed = 1415176494 27 число = 23, RandSeed = 2001542631 28 число = 12, RandSeed = 1059369348 29 число = 41, RandSeed = -748714091 30 число = 13, RandSeed = 1198422506 Таким образом, при неоднократном вызове Random(50) функция выдаст последовательность чисел: 0, 1, 43, 10, 13, 33, 15, 8, 18, 21, 4, 23, 3, 42, 2, 14 и т.д. Рассмотрим подробно образование случайных чисел. 1 число RandSeed = RandSeed * $8088405 + 1 = 0 * 134775813 + 1 = 1 z = RandSeed = 1 z = z * Range = 1 * 50 = 50 Result = z div $100000000 = 50 div 4294967296 = 0 Вывод: 1 число = 0, RandSeed = 1 2 число RandSeed = RandSeed * $8088405 + 1 = 1 * 134775813 + 1 = 134775814 z = RandSeed = 134775814 z = z * Range = 134775814 * 50 = 6738790700 Result = z div $100000000 = 6738790700 div 4294967296 = 1 Вывод: 2 число = 1, RandSeed = 134775814 3 число RandSeed = RandSeed * $8088405 + 1 = 134775814 * 134775813 + 1 = 18164519904586783 ($408888DC6DAC1F) = -596792289 ($DC6DAC1F) z = RandSeed = -596792289 ($DC6DAC1F) If z<0 then z:=z+$100000000; If -596792289<0 then z = -596792289 + 4294967296 = 3698175007 z = z * Range = 3698175007 * 50 = 184908750350 Result = z div $100000000 = 184908750350 div 4294967296 = 43 Вывод: 3 число = 43, RandSeed = -596792289 Примечание. Поскольку тип Integer принимает значения -2147483648..2147483647, занимает 4 байта, то в памяти компьютера произойдет переполнение: 18164519904586783 > 2147483647. В этом случае, в переменную RandSeed запишется только 4 младших байта ($DC6DAC1F), а остальную часть ($408888) отбросит. Т.к. число $DC6DAC1F = 3698175007 > 2147483647, в этом случае переменная RandSeed примет отрицательное значение: -596792289. Размер переменной z составляет 8 байт (тип Int64), поэтому для корректной работы необходимо положительное значение, добавив небольшое условие. 4 число RandSeed = RandSeed * $8088405 + 1 = -596792289 * 134775813 + 1 = <для корректной работы -596792289 заменим на 3698175007> = 3698175007 * 134775813 + 1 = 498424543184705692 ($6EAC27B33DC589C) = 870078620 ($33DC589C) z = RandSeed = 870078620 ($33DC589C) z = z * Range = 870078620 * 50 = 43503931000 Result = z div $100000000 = 43503931000 div 4294967296 = 10 Вывод: 4 число = 10, RandSeed = 870078620 5 число RandSeed = RandSeed * $8088405 + 1 = 870078620 * 134775813 + 1 = 117265553384418061 ($1A09C6645DE2B0D) = 1172187917 ($45DE2B0D) z = RandSeed = 1172187917 ($45DE2B0D) z = z * Range = 1172187917 * 50 = 58609395850 Result = z div $100000000 = 58609395850 div 4294967296 = 13 Вывод: 5 число = 13, RandSeed = 1172187917 Далее аналогичным образом рассчитываются следующие числа. Рассмотрим следующую функцию, написанную на ассемблере. function Random2(Range: integer): integer; asm MOV EAX,Range IMUL EDX,RandSeed,$8088405 INC EDX MOV RandSeed,EDX MUL EDX MOV Result,EDX end; Комментарии: MOV EAX,Range - присваивает регистру EAX значение Range; IMUL EDX,RandSeed,$8088405 - умножает RandSeed на $8088405 и записывает в регистр EDX; INC EDX - увеличивает значение регистра EDX на единицу; MOV RandSeed,EDX - присваивает переменной RandSeed значение регистра EDX; MUL EDX - умножает значение регистра EDX на значение регистра EAX, результат запишется в 2 регистра: EDX (старшее слово) и EAX (младшее слово); MOV Result,EDX - присваивает переменной Result значение регистра EDX. Рассмотрим пример образования последовательности чисел в диапазоне от 0 до 60 (Range = 60). Процедуру Randomize вызывать не будем (RandSeed = 0). Последовательность чисел будем вызывать с помощью функций Random2 и Random (для проверки). В процедуре TForm1.Button1Click изменим постоянную r на 60, а в коде заменим функцию Random1(r) на Random2(r). Тексты в Memo1 и Memo2 будут выглядеть одинаково: 1 число = 0, RandSeed = 1 2 число = 1, RandSeed = 134775814 3 число = 51, RandSeed = -596792289 4 число = 12, RandSeed = 870078620 5 число = 16, RandSeed = 1172187917 6 число = 40, RandSeed = -1410233534 7 число = 19, RandSeed = 1368768587 8 число = 9, RandSeed = 694906232 9 число = 22, RandSeed = 1598751577 10 число = 25, RandSeed = 1828254910 11 число = 4, RandSeed = 352239543 12 число = 28, RandSeed = 2039224980 13 число = 4, RandSeed = 303092965 14 число = 50, RandSeed = -683524998 15 число = 3, RandSeed = 256513635 16 число = 17, RandSeed = 1259699184 17 число = 55, RandSeed = -355259471 18 число = 22, RandSeed = 1580146294 19 число = 46, RandSeed = -967806897 20 число = 19, RandSeed = 1408429452 21 число = 41, RandSeed = -1298476099 22 число = 50, RandSeed = -669280590 23 число = 43, RandSeed = -1211254405 24 число = 18, RandSeed = 1317014376 25 число = 9, RandSeed = 698472713 26 число = 19, RandSeed = 1415176494 27 число = 27, RandSeed = 2001542631 28 число = 14, RandSeed = 1059369348 29 число = 49, RandSeed = -748714091 30 число = 16, RandSeed = 1198422506 Таким образом, при неоднократном вызове Random(60) функция выдаст последовательность чисел: 0, 1, 51, 12, 16, 40, 19, 9, 22, 25, 4, 28, 4, 50, 3, 17 и т.д. Рассмотрим подробно образование случайных чисел. 1 число MOV EAX,Range EAX = $3C (60) Примечание. В регистры будем записывать только шестнадцатеричные значения, а в скобках - десятичные. IMUL EDX,RandSeed,$8088405 EDX = $0 (0) - 0 * 134775813 Примечание. После знака "тире" будем записывать подробное вычисление. INC EDX EDX = $1 (1) MOV RandSeed,EDX RandSeed = $1 (1) MUL EDX EDX = $0 (0) EAX = $3С (60) - 1 * 60 MOV Result,EDX Result = $0 (0) Вывод: 1 число = 0, RandSeed = 1 2 число MOV EAX,Range EAX = $3C (60) IMUL EDX,RandSeed,$8088405 EDX = $8088405 (134775813) - 1 * 134775813 INC EDX EDX = $8088406 (134775814) MOV RandSeed,EDX RandSeed = $8088406 (134775814) MUL EDX EDX = $1 (1) EAX = $E1FEF168 (3791581544) - 134775814 * 60 MOV Result,EDX Result = $1 (1) Вывод: 2 число = 1, RandSeed = 134775814 3 число MOV EAX,Range EAX = $3C (60) IMUL EDX,RandSeed,$8088405 EDX = $DC6DAC1E (3698175006) - 134775814 * 134775813 Примечание. Старшее слово ($408888) нигде не записывается (оно не учитывается). В регистр EDX записываются только младшие разряды шестнадцатеричного числа. INC EDX EDX = $DC6DAC1F (3698175007) MOV RandSeed,EDX RandSeed = $DC6DAC1F (-596792289) Примечание. Поскольку тип Integer принимает значения -2147483648..2147483647, то число будет занимать 4 байта. Т.к. число $DC6DAC1F = 3698175007 > 2147483647, в этом случае переменная RandSeed примет отрицательное значение: -596792289. MUL EDX EDX = $33 (51) EAX = $A9B45744 (2847168324) - 3698175007 * 60 MOV Result,EDX Result = $33 (51) Вывод: 3 число = 51, RandSeed = -596792289 4 число MOV EAX,Range EAX = $3C (60) IMUL EDX,RandSeed,$8088405 EDX = $33DC589B (870078619) - 3698175007 * 134775813 INC EDX EDX = $33DC589C (870078620) MOV RandSeed,EDX RandSeed = $33DC589C (870078620) MUL EDX EDX = $С (12) EAX = $27A4C490 (665109648) - 870078620 * 60 MOV Result,EDX Result = $C (12) Вывод: 4 число = 12, RandSeed = 870078620 5 число MOV EAX,Range EAX = $3C (60) IMUL EDX,RandSeed,$8088405 EDX = $45DE2B0C (1172187916) - 870078620 * 134775813 INC EDX EDX = $45DE2B0D (1172187917) MOV RandSeed,EDX RandSeed = $45DE2B0D (1172187917) MUL EDX EDX = $10 (16) EAX = $6012170C (1611798284) - 1172187917 * 60 MOV Result,EDX Result = $10 (16) Вывод: 5 число = 16, RandSeed = 1172187917 Далее аналогичным образом рассчитываются следующие числа. Рассмотрим работу функции для вещественных (дробных) чисел. function Random3: extended; const two2neg32 = 1/$100000000; // 2^-32 var z: int64; begin RandSeed:=RandSeed*$8088405 + 1; z:=RandSeed; If z<0 then z:=z+$100000000; Result:=z*two2neg32; end; Примечание 1. Допускается перегружать процедуры и функции с одинаковыми именами, дописав слово overload: function Random1: extended; overload; Примечание 2. Константа two2neg32 равна 0,00000000023283064365386962890625 (2 в степени -32). Рассмотрим пример образования последовательности вещественных чисел в диапазоне от 0 до 1. Процедуру Randomize вызывать не будем (RandSeed = 0). Последовательность чисел будем вызывать с помощью функций Random3 и Random (для проверки). procedure TForm1.Button2Click(Sender: TObject); const rs = 0; var i: integer; a: real; begin Memo1.Clear; RandSeed:=rs; For i:=1 to 30 do begin a:=Random; Memo1.Lines.Add(Format('%d число = %g, RandSeed = %d',[i,a,RandSeed])); end; Memo2.Clear; RandSeed:=rs; For i:=1 to 30 do begin a:=Random3; Memo2.Lines.Add(Format('%d число = %g, RandSeed = %d',[i,a,RandSeed])); end; end; Тексты в Memo1 и Memo2 будут выглядеть одинаково: 1 число = 2,3283064365387E-10, RandSeed = 1 2 число = 0,0313799395225942, RandSeed = 134775814 3 число = 0,861048467224464, RandSeed = -596792289 4 число = 0,202580965124071, RandSeed = 870078620 5 число = 0,272921267198399, RandSeed = 1172187917 6 число = 0,671654418576509, RandSeed = -1410233534 7 число = 0,318691271124408, RandSeed = 1368768587 8 число = 0,161795465275645, RandSeed = 694906232 9 число = 0,372238358715549, RandSeed = 1598751577 10 число = 0,425673767458647, RandSeed = 1828254910 11 число = 0,0820121595170349, RandSeed = 352239543 12 число = 0,474794064648449, RandSeed = 2039224980 13 число = 0,0705693301279098, RandSeed = 303092965 14 число = 0,84085443476215, RandSeed = -683524998 15 число = 0,0597242347430438, RandSeed = 256513635 16 число = 0,293296571820974, RandSeed = 1259699184 17 число = 0,917284708702937, RandSeed = -355259471 18 число = 0,367906478699297, RandSeed = 1580146294 19 число = 0,774664897238836, RandSeed = -967806897 20 число = 0,327925535850227, RandSeed = 1408429452 21 число = 0,697674974100664, RandSeed = -1298476099 22 число = 0,844170969445258, RandSeed = -669280590 23 число = 0,717982857255265, RandSeed = -1211254405 24 число = 0,306641304865479, RandSeed = 1317014376 25 число = 0,162625851342455, RandSeed = 698472713 26 число = 0,329496453981847, RandSeed = 1415176494 27 число = 0,46602045907639, RandSeed = 2001542631 28 число = 0,24665364716202, RandSeed = 1059369348 29 число = 0,825676416279748, RandSeed = -748714091 30 число = 0,279029483441263, RandSeed = 1198422506 Таким образом, при неоднократном вызове Random функция выдаст последовательность чисел: 2,3283064365387E-10, 0,0313799395225942, 0,861048467224464, 0,202580965124071, 0,272921267198399, 0,671654418576509, 0,318691271124408, 0,161795465275645, 0,372238358715549, 0,425673767458647, 0,0820121595170349, 0,474794064648449, 0,0705693301279098, 0,84085443476215, 0,0597242347430438, 0,293296571820974 и т.д. Рассмотрим подробно образование случайных чисел. 1 число RandSeed = RandSeed * $8088405 + 1 = 0 * 134775813 + 1 = 1 z = RandSeed = 1 Result = z * two2neg32 = 1 * 0,00000000023283064365386962890625 = 2,3283064365387E-10 Вывод: 1 число = 2,3283064365387E-10, RandSeed = 1 2 число RandSeed = RandSeed * $8088405 + 1 = 1 * 134775813 + 1 = 134775814 z = RandSeed = 134775814 Result = z * two2neg32 = 134775814 * 0,00000000023283064365386962890625 = 0,0313799395225942 Вывод: 2 число = 0,0313799395225942, RandSeed = 134775814 3 число RandSeed = RandSeed * $8088405 + 1 = 134775814 * 134775813 + 1 = 18164519904586783 ($408888DC6DAC1F) = -596792289 ($DC6DAC1F) z = RandSeed = -596792289 ($DC6DAC1F) If z<0 then z:=z+$100000000; If -596792289<0 then z = -596792289 + 4294967296 = 3698175007 Result = z * two2neg32 = 3698175007 * 0,00000000023283064365386962890625 = 0,861048467224464 Вывод: 3 число = 0,861048467224464, RandSeed = -596792289 Примечание. Поскольку тип Integer принимает значения -2147483648..2147483647, занимает 4 байта, то в памяти компьютера произойдет переполнение: 18164519904586783 > 2147483647. В этом случае, в переменную RandSeed запишется только 4 младших байта ($DC6DAC1F), а остальную часть ($408888) отбросит. Т.к. число $DC6DAC1F = 3698175007 > 2147483647, в этом случае переменная RandSeed примет отрицательное значение: -596792289. Размер переменной z составляет 8 байт (тип Int64), поэтому для корректной работы необходимо положительное значение, добавив небольшое условие. 4 число RandSeed = RandSeed * $8088405 + 1 = -596792289 * 134775813 + 1 = <для корректной работы -596792289 заменим на 3698175007> = 3698175007 * 134775813 + 1 = 498424543184705692 ($6EAC27B33DC589C) = 870078620 ($33DC589C) z = RandSeed = 870078620 ($33DC589C) Result = z * two2neg32 = 870078620 * 0,00000000023283064365386962890625 = 0,202580965124071 Вывод: 4 число = 0,202580965124071, RandSeed = 870078620 5 число RandSeed = RandSeed * $8088405 + 1 = 870078620 * 134775813 + 1 = 117265553384418061 ($1A09C6645DE2B0D) = 1172187917 ($45DE2B0D) z = RandSeed = 1172187917 ($45DE2B0D) Result = z * two2neg32 = 1172187917 * 0,00000000023283064365386962890625 = 0,272921267198399 Вывод: 5 число = 0,272921267198399, RandSeed = 1172187917 Далее аналогичным образом рассчитываются следующие числа. Рассмотрим следующую функцию, написанную на ассемблере. function Random4: extended; const two2neg32: double = 1/$100000000; // 2^-32 asm IMUL EDX,RandSeed,$8088405 INC EDX MOV RandSeed,EDX FLD QWORD PTR two2neg32 PUSH $0 PUSH EDX FILD QWORD PTR [ESP] ADD ESP,$4 POP EDX FMULP FSTP TBYTE PTR Result end; Комментарии: IMUL EDX,RandSeed,$8088405 - умножает RandSeed на $8088405 и записывает в регистр EDX; INC EDX - увеличивает значение регистра EDX на единицу; MOV RandSeed,EDX - присваивает переменной RandSeed значение регистра EDX; FLD QWORD PTR two2neg32 - загружает 64-разрядное вещественное число two2neg32 в ST(0) (вершину стека сопроцессора); PUSH $0 - размещает значение "0" в стеке, т.е. помещает значение в ячейку памяти, на которую указывает регистр ESP, после этого значение регистра ESP уменьшается на 4; PUSH EDX - размещает значение регистра EDX в стеке; FILD QWORD PTR [ESP] - загружает 64-разрядное целое число в регистр ST(0) (вершину стека сопроцессора) из области памяти по адресу ESP, при загрузке какого-либо значения в стек сопроцессора все значения стека сдвигаются, т.е. значение регистра ST(0) загрузит в ST(1), а наше новое значение загружается в ST(0); ADD ESP,$4 - увеличивает значение регистра ESP на 4; POP EDX - извлекает значение из стека, т.е. извлекает значение из ячейки памяти, на которую указывает регистр ESP, и сохраняет в регистре EDX, после этого увеличивает значение регистра ESP на 4; FMULP - умножение значений регистра ST(0) сопроцессора на ST(1) и выталкивание из стека (значение в ST(1) будет Empty /нет данных/), результат записывается в ST(0); FSTP TBYTE PTR Result - записывает 80-разрядное вещественное число из регистра ST(0) в переменную Result, при этом происходит выталкивание вершины из стека сопроцессора (ST(0) = Empty). Рассмотрим пример образования последовательности вещественных чисел в диапазоне от 0 до 1. Процедуру Randomize вызывать не будем (RandSeed = 0). Последовательность чисел будем вызывать с помощью функций Random4 и Random (для проверки). В процедуре TForm1.Button2Click в коде заменим функцию Random3(r) на Random4(r). Тексты в Memo1 и Memo2 будут выглядеть одинаково: 1 число = 2,3283064365387E-10, RandSeed = 1 2 число = 0,0313799395225942, RandSeed = 134775814 3 число = 0,861048467224464, RandSeed = -596792289 4 число = 0,202580965124071, RandSeed = 870078620 5 число = 0,272921267198399, RandSeed = 1172187917 6 число = 0,671654418576509, RandSeed = -1410233534 7 число = 0,318691271124408, RandSeed = 1368768587 8 число = 0,161795465275645, RandSeed = 694906232 9 число = 0,372238358715549, RandSeed = 1598751577 10 число = 0,425673767458647, RandSeed = 1828254910 11 число = 0,0820121595170349, RandSeed = 352239543 12 число = 0,474794064648449, RandSeed = 2039224980 13 число = 0,0705693301279098, RandSeed = 303092965 14 число = 0,84085443476215, RandSeed = -683524998 15 число = 0,0597242347430438, RandSeed = 256513635 16 число = 0,293296571820974, RandSeed = 1259699184 17 число = 0,917284708702937, RandSeed = -355259471 18 число = 0,367906478699297, RandSeed = 1580146294 19 число = 0,774664897238836, RandSeed = -967806897 20 число = 0,327925535850227, RandSeed = 1408429452 21 число = 0,697674974100664, RandSeed = -1298476099 22 число = 0,844170969445258, RandSeed = -669280590 23 число = 0,717982857255265, RandSeed = -1211254405 24 число = 0,306641304865479, RandSeed = 1317014376 25 число = 0,162625851342455, RandSeed = 698472713 26 число = 0,329496453981847, RandSeed = 1415176494 27 число = 0,46602045907639, RandSeed = 2001542631 28 число = 0,24665364716202, RandSeed = 1059369348 29 число = 0,825676416279748, RandSeed = -748714091 30 число = 0,279029483441263, RandSeed = 1198422506 Таким образом, при неоднократном вызове Random функция выдаст последовательность чисел: 2,3283064365387E-10, 0,0313799395225942, 0,861048467224464, 0,202580965124071, 0,272921267198399, 0,671654418576509, 0,318691271124408, 0,161795465275645, 0,372238358715549, 0,425673767458647, 0,0820121595170349, 0,474794064648449, 0,0705693301279098, 0,84085443476215, 0,0597242347430438, 0,293296571820974 и т.д. Рассмотрим подробно образование случайных чисел. 1 число IMUL EDX,RandSeed,$8088405 EDX = $0 (0) - 0 * 134775813 Примечание. В регистры будем записывать только шестнадцатеричные значения, а в скобках - десятичные, а после знака "тире" будем записывать подробное вычисление. INC EDX EDX = $1 (1) MOV RandSeed,EDX RandSeed = $1 (1) FLD QWORD PTR two2neg32 ST0 = 2,3283064365387E-10 ESP = $18F2C8 Примечание. Здесь дополнительно будем использовать значение регистра ESP - это указатель вершины стека. В регистре ESP хранится адрес последней добавленной записи. PUSH $0 ESP = $18F2C4 - $18F2C8 - $4 $18F2C4 = $0 (0) Примечание. Здесь дополнительно будем выводить значения в стеке по адресам. PUSH EDX ESP = $18F2C0 - $18F2C4 - $4 $18F2C4 = $0 (0) $18F2C0 = $1 (1) FILD QWORD PTR [ESP] ST0 = 1 ST1 = 2,3283064365387E-10 ADD ESP,$4 ESP = $18F2C4 - $18F2C0 + $4 $18F2C4 = $0 (0) POP EDX EDX = $0 (0) ESP = $18F2C8 - $18F2C4 + $4 FMULP ST0 = 2,3283064365387E-10 - 1 * 2,3283064365387E-10 ST1 = Empty (нет данных) FSTP TBYTE PTR Result Result = 2,3283064365387E-10 ST0 = Empty (нет данных) Вывод: 1 число = 2,3283064365387E-10, RandSeed = 1 2 число IMUL EDX,RandSeed,$8088405 EDX = $8088405 (134775813) - 1 * 134775813 INC EDX EDX = $8088406 (134775814) MOV RandSeed,EDX RandSeed = $8088406 (134775814) FLD QWORD PTR two2neg32 ST0 = 2,3283064365387E-10 ESP = $18F2C8 PUSH $0 ESP = $18F2C4 $18F2C4 = $0 (0) PUSH EDX ESP = $18F2C0 $18F2C4 = $0 (0) $18F2C0 = $8088406 (134775814) FILD QWORD PTR [ESP] ST0 = 134775814 ST1 = 2,3283064365387E-10 ADD ESP,$4 ESP = $18F2C4 $18F2C4 = $0 (0) POP EDX EDX = $0 (0) ESP = $18F2C8 FMULP ST0 = 0,0313799395225942 - 134775814 * 2,3283064365387E-10 ST1 = Empty (нет данных) FSTP TBYTE PTR Result Result = 0,0313799395225942 ST0 = Empty (нет данных) Вывод: 2 число = 0,0313799395225942, RandSeed = 134775814 3 число IMUL EDX,RandSeed,$8088405 EDX = $DC6DAC1E (3698175006) - 134775814 * 134775813 Примечание. Старшее слово ($408888) нигде не записывается (оно не учитывается). В регистр EDX записываются только младшие разряды шестнадцатеричного числа. INC EDX EDX = $DC6DAC1F (3698175007) MOV RandSeed,EDX RandSeed = $DC6DAC1F (-596792289) Примечание. Поскольку тип Integer принимает значения -2147483648..2147483647, то число будет занимать 4 байта. Т.к. число $DC6DAC1F = 3698175007 > 2147483647, в этом случае переменная RandSeed примет отрицательное значение: -596792289. FLD QWORD PTR two2neg32 ST0 = 2,3283064365387E-10 ESP = $18F2C8 PUSH $0 ESP = $18F2C4 $18F2C4 = $0 (0) PUSH EDX ESP = $18F2C0 $18F2C4 = $0 (0) $18F2C0 = $DC6DAC1F (3698175007) FILD QWORD PTR [ESP] ST0 = 3698175007 ST1 = 2,3283064365387E-10 ADD ESP,$4 ESP = $18F2C4 $18F2C4 = $0 (0) POP EDX EDX = $0 (0) ESP = $18F2C8 FMULP ST0 = 0,861048467224464 - 3698175007 * 2,3283064365387E-10 ST1 = Empty (нет данных) FSTP TBYTE PTR Result Result = 0,861048467224464 ST0 = Empty (нет данных) Вывод: 3 число = 0,861048467224464, RandSeed = -596792289 4 число IMUL EDX,RandSeed,$8088405 EDX = $33DC589B (870078619) - 3698175007 * 134775813 INC EDX EDX = $33DC589C (870078620) MOV RandSeed,EDX RandSeed = $33DC589C (870078620) FLD QWORD PTR two2neg32 ST0 = 2,3283064365387E-10 ESP = $18F2C8 PUSH $0 ESP = $18F2C4 $18F2C4 = $0 (0) PUSH EDX ESP = $18F2C0 $18F2C4 = $0 (0) $18F2C0 = $33DC589C (870078620) FILD QWORD PTR [ESP] ST0 = 870078620 ST1 = 2,3283064365387E-10 ADD ESP,$4 ESP = $18F2C4 $18F2C4 = $0 (0) POP EDX EDX = $0 (0) ESP = $18F2C8 FMULP ST0 = 0,202580965124071 - 870078620 * 2,3283064365387E-10 ST1 = Empty (нет данных) FSTP TBYTE PTR Result Result = 0,202580965124071 ST0 = Empty (нет данных) Вывод: 4 число = 0,202580965124071, RandSeed = 870078620 5 число IMUL EDX,RandSeed,$8088405 EDX = $45DE2B0C (1172187916) - 870078620 * 134775813 INC EDX EDX = $45DE2B0D (1172187917) MOV RandSeed,EDX RandSeed = $45DE2B0D (1172187917) FLD QWORD PTR two2neg32 ST0 = 2,3283064365387E-10 ESP = $18F2C8 PUSH $0 ESP = $18F2C4 $18F2C4 = $0 (0) PUSH EDX ESP = $18F2C0 $18F2C4 = $0 (0) $18F2C0 = $45DE2B0D (1172187917) FILD QWORD PTR [ESP] ST0 = 1172187917 ST1 = 2,3283064365387E-10 ADD ESP,$4 ESP = $18F2C4 $18F2C4 = $0 (0) POP EDX EDX = $0 (0) ESP = $18F2C8 FMULP ST0 = 0,272921267198399 - 1172187917 * 2,3283064365387E-10 ST1 = Empty (нет данных) FSTP TBYTE PTR Result Result = 0,272921267198399 ST0 = Empty (нет данных) Вывод: 5 число = 0,272921267198399, RandSeed = 1172187917 Далее аналогичным образом рассчитываются следующие числа. Примечание 1. Здесь дополнительно используется значение регистра ESP - это указатель вершины стека. В регистре ESP хранится адрес последней добавленной записи. Примечание 2. Строки "ADD ESP,$4" и "POP EDX" можно заменить одной строкой "ADD ESP,$8". Это означает, что команда ADD увеличит значение регистра ESP сразу на 8, а в регистре EDX останется старое значение. Сфера (3D) uses Math; function Tochka(a, b: real; a0, b0, c0, r: integer; var x, y: integer): boolean; const da=90; var a1, a2, b1, r0, ugol, xr, yr: real; function Gradus(a, a0: real): real; var d: integer; procedure da; begin d:=0; If a=360+a0 then d:=-360; end; begin da; While d<>0 do begin a:=a+d; da; end; Result:=a; end; function b90(b0: integer): integer; begin If b0>90 then b0:=180-b0; If b0<-90 then b0:=-180-b0; Result:=b0; end; begin b0:=Round(Gradus(b0, -180)); If Abs(b0)<=90 then a:=Gradus(a+da-a0, -90) else a:=Gradus(a+da-a0, 90); b:=Gradus(b, -180); c0:=Round(Gradus(c0, -180)); Result:=true; If (b<=b90(b0)-90) or (b>=b90(b0)+90) then Result:=false; b1:=90-Abs(b0); If Abs(b)90 then begin a1:=a1+180; a2:=a2+180; end; If (aa2) then Result:=false; end; r0:=r*Cos(b*pi/180); xr:=r0*Cos(a*pi/180); yr:=-r0*Sin(a*pi/180)*Sin(b0*pi/180)+r*Sin(b*pi/180)*Cos(b0*pi/180); ugol:=ArcTan(yr/xr)*180/pi; If xr<0 then ugol:=ugol+180; ugol:=ugol-c0; r0:=Sqrt(xr*xr+yr*yr); xr:=r0*Cos(ugol*pi/180); yr:=r0*Sin(ugol*pi/180); x:=Round(xr); y:=-Round(yr); end; где a - долгота (для карты Земли), прямое восхождение (для карты звездного неба); b - широта (для карты Земли), склонение (для карты звездного неба); a0 - начальная долгота, начальное прямое восхождение; b0 - начальная широта, начальное склонение; c0 - наклон сферы; r - радиус сферы; x, y - вычисляемые координаты точки (для рисования 2D). Функция Tochka показывает видимость точки с координатами (a, b), т.е. находится ли заданная точка на переднем плане. Примечание. Координаты a, b, a0, b0, c0 задаются в градусах. procedure Sphere(Canvas: TCanvas; a0, b0, c0, r, x0, y0: integer); var a, b, x, y: integer; vis, vist: boolean; begin Canvas.Ellipse(x0-r, y0-r, x0+r+1, y0+r+1); For b:=-90 to 90 do begin If b mod 10 <> 0 then Continue; If b=0 then Canvas.Pen.Width:=2 else Canvas.Pen.Width:=1; vis:=false; For a:=0 to 360 do begin vist:=Tochka(a, b, a0, b0, c0, r, x, y); If vist then If not vis then begin vis:=true; Canvas.MoveTo(x0+x, y0+y); end else Canvas.LineTo(x0+x, y0+y) else vis:=false; end; end; For a:=0 to 360 do begin If a mod 15 <> 0 then Continue; If a=0 then Canvas.Pen.Width:=2 else Canvas.Pen.Width:=1; vis:=false; For b:=-90 to 90 do begin vist:=Tochka(a, b, a0, b0, c0, r, x, y); If vist then If not vis then begin vis:=true; Canvas.MoveTo(x0+x, y0+y); end else Canvas.LineTo(x0+x, y0+y) else vis:=false; end; end; end; где Canvas - объект для рисования (например, Label1.Canvas); x0, y0 - координаты центра сферы относительно Canvas. Процедура Sphere рисует сферу с географической сеткой. Экватор и нулевой меридиан выделены толстой линией. Примечание. Если поместить процедуру Sphere в таймер и постоянно изменять начальные координаты a0, b0 или c0 (или их комбинации), то можно увидеть анимацию - вращение сферы. Календарь type TOrient = (horz, vert); const mesyatsR: array[1..12] of string = ('Январь', 'Февраль', 'Март', 'Апрель', 'Май', 'Июнь', 'Июль', 'Август', 'Сентябрь', 'Октябрь', 'Ноябрь', 'Декабрь'); dnR: array[1..7] of string = ('Пн', 'Вт', 'Ср', 'Чт', 'Пт', 'Сб', 'Вс'); procedure CanvasKalendar(Canvas: TCanvas; x, y, dx, dy, leftmes, mes, god, FontSize: integer; BrushColor, FontColor: array of TColor; d31, zgod: boolean; orient: TOrient; date: TDateTime; prazdniki: array of byte); const wihodnye: array[0..1] of byte = (6, 7); var x1, x2, y1, y2, PosX, PosY: integer; dat: TDateTime; s: string; i, nomer_dn, x_, y_: byte; function LabelHeightFontSize(FontSize: integer): integer; begin If FontSize<1 then FontSize:=1; Case FontSize of 10..11: Result:=16; 12..13: Result:=20; 14..16: Result:=24; 17: Result:=26; 18..19: Result:=29; 20..22: Result:=32; 23..26: Result:=37; 27..32: Result:=48; 33..35: Result:=52; 36..38: Result:=58; 39..40: Result:=64; 41..46: Result:=65; 47..48: Result:=74; else Result:=13; end; end; function ColorRead(Color: array of TColor; n: byte): TColor; begin Result:=0; If n<=High(Color) then Result:=Color[n]; end; function PrinadlezhitB(n: byte; p: array of byte): boolean; var i: integer; begin Result:=false; For i:=Low(p) to High(p) do If n=p[i] then Result:=true; end; begin With Canvas do begin If dx1) then begin PosX:=PosX+1; PosY:=PosY+1; end; If (PosX=6) and d31 {перенести "31" в первый (левый) ряд} then PosX:=1; If (PosY=7) and d31 {перенести "31" в первый (верхний) ряд} then PosY:=2; Pen.Color:=ColorRead(BrushColor, 2); Font.Color:=ColorRead(FontColor, 2); If PrinadlezhitB(nomer_dn, wihodnye) then begin Pen.Color:=ColorRead(BrushColor, 4); Font.Color:=ColorRead(FontColor, 4); end; If dat=Trunc(date) then begin Pen.Color:=ColorRead(BrushColor, 3); Font.Color:=ColorRead(FontColor, 3); end; If PrinadlezhitB(i, prazdniki) then begin Pen.Color:=ColorRead(BrushColor, 5); Font.Color:=ColorRead(FontColor, 5); end; Brush.Color:=Pen.Color; x1:=x+(nomer_dn-1)*dx+1; y1:=y+PosY*dy+1; x2:=x+nomer_dn*dx; y2:=y+(PosY+1)*dy; If orient=vert then begin x1:=x+PosX*dx+1; y1:=y+nomer_dn*dy+1; x2:=x+(PosX+1)*dx; y2:=y+(nomer_dn+1)*dy; end; Rectangle(x1, y1, x2, y2); If i<10 then x1:=x1+3; TextOut(x1+x_, y1+y_-1, IntToStr(i)); end; { границы календаря } PosX:=PosX+1; If d31 then PosX:=6; If orient=horz then PosX:=7; PosY:=PosY+1; If d31 then PosY:=7; If orient=vert then PosY:=8; Pen.Width:=2; Pen.Color:=1; x1:=x; y1:=y+2*dy; x2:=x+PosX*dx; y2:=y+PosY*dy; If orient=vert then y1:=y+dy; MoveTo(x1+Pen.Width-1, y1+Pen.Width-1); LineTo(x1+Pen.Width-1, y2+Pen.Width-1); LineTo(x2+Pen.Width-1, y2+Pen.Width-1); LineTo(x2+Pen.Width-1, y1+Pen.Width-1); { название месяца (и года) } Font.Color:=ColorRead(FontColor, 0); Brush.Color:=ColorRead(BrushColor, 0); x2:=x+PosX*dx+1; Rectangle(x+Pen.Width-1, y+Pen.Width-1, x2+Pen.Width-1, y+dy+Pen.Width); s:=''; If (mes>=1) and (mes<=12) then s:=mesyatsR[mes]; If zgod then s:=Format('%s - %d год', [s, god]); TextOut(x+leftmes, y+y_, s); { названия дней недели } Font.Color:=ColorRead(FontColor, 1); Brush.Color:=ColorRead(BrushColor, 1); x1:=x; y1:=y+dy; x2:=x+PosX*dx+1; y2:=y+2*dy+1; If orient=vert then begin x2:=x+dx+1; y2:=y+PosY*dy+1; end; Rectangle(x1+Pen.Width-1, y1+Pen.Width-1, x2+Pen.Width-1, y2+Pen.Width-1); For i:=0 to 6 do begin x1:=x+i*dx; y1:=y+dy; If orient=vert then begin x1:=x; y1:=y+(i+1)*dy; end; TextOut(x1+x_, y1+y_, dnR[((i+1) mod 7)+1]); end; { сетка } Pen.Width:=1; x1:=1; x2:=6; y1:=3; y2:=PosY-1; If orient=vert then begin x1:=2; x2:=PosX-1; y1:=2; y2:=7; end; For i:=x1 to x2 do begin MoveTo(x+i*dx, y+dy+1); LineTo(x+i*dx, y+PosY*dy+1); end; For i:=y1 to y2 do begin MoveTo(x, y+i*dy); LineTo(x+PosX*dx+1, y+i*dy); end; end; end; где Canvas - объект для рисования (например, Label1.Canvas); x, y - положение календаря относительно компонента; dx, dy - размер клетки; leftmes - положение названия месяца (Left); mes, god - номера месяца и года соответственно; FontSize - размер текста; BrushColor - цвета заливок, размер массива от 0 до 5, обозначения которых даны ниже: 0 - месяц, 1 - дни недели, 2 - обычные дни, 3 - текущий (сегодняшний) день, 4 - выходные дни, 5 - праздничные дни; FontColor - цвета надписей, размер массива от 0 до 5, обозначения которых совпадают со значениями массива BrushColor; d31 - перенос чисел (29-31) в первый (верхний/левый) ряд; zgod - вывод года после месяца в названии; orient - ориентация ряда чисел, значения которых даны ниже: horz - горизонтальная, vert - вертикальная; date - текущая (сегодняшняя) дата (выделяется цветом BrushColor[3]); prazdniki - список праздников (выделяется цветом BrushColor[5]). Например, CanvasKalendar(Image1.Canvas, 0, 0, 12, 12, 40, 5, 2016, 8, [clWhite, clYellow, clWhite, clLime, clFuchsia, clRed], [clBlack, clRed], false, false, vert, 42515, [1, 9]) состоит из следующих параметров: Image1.Canvas - рисование календаря на компоненте Image1, 0, 0 - положение календаря на Image1, 12, 12 - размер клетки, 40 - положение названия месяца слева, 5, 2016 - май 2016 года, 8 - размер текста, [clWhite - закрашивание фона в названии месяца, clYellow - фон в днях недели, clWhite - фон во всех числах (основной фон), clLime - выделить сегодняшний день (25.05.2016), clFuchsia - выделить выходные дни (суббота и воскресенье), clRed] - выделить праздничные дни (1.05.2016, 9.05.2016), [clBlack - цвет надписи в названии месяца, clRed] - цвет надписи в днях недели, остальные цвета надписей (числа) будут по умолчанию черными, т.к. здесь задан размер массива из 2 значений, false - не переносить числа (30-31) в первый (левый) ряд (таблица будет состоять из 7 столбцов: дн, 1, 2-8, 9-15, 16-22, 23-29, 30-31), false - не выводить год после месяца в названии (название таблицы: 'Май'), vert - расположить числа вертикально, 42515 - сегодня 25.05.2016, [1, 9] - праздничные дни: 1.05.2016, 9.05.2016. CanvasKalendar(Image1.Canvas, 130, 0, 20, 20, 12, 3, 2099, 8, [clLime, clWhite, clYellow, clAqua, clRed, clFuchsia], [clRed, clPurple, clBlue, clBlack, clWhite], true, true, horz, 72761, [8]) состоит из следующих параметров (сокращенно): Image1.Canvas, 130, 0, 20, 20, 12, 3, 2099 - март 2099 года, 8, [clLime, clWhite, clYellow, clAqua, clRed, clFuchsia], [clRed, clPurple, clBlue, clBlack, clWhite], true - переносить числа (30-31) в первый (верхний) ряд (таблица будет состоять из 7 строк: 'Март - 2099 год', 30-31 и 1, 2-8, 9-15, 16-22, 23-29), true - выводить год после месяца в названии (название таблицы: 'Март - 2099 год'), horz - расположить числа горизонтально, 72761 - сегодня 17.03.2099, [8] - праздничные дни: 8.03.2099. Список дисков uses FileCtrl; procedure TForm1.Button1Click(Sender: TObject); var i: byte; a, b: cardinal; sz, fr: int64; s1, s2: string; disk: char; DriveType: TDriveType; DriveBits: set of 0..25; Buf: array [0..MAX_PATH] of char; begin Memo1.Clear; Integer(DriveBits):=GetLogicalDrives; For i:=0 to 25 do begin If not (i in DriveBits) then Continue; disk:=Char(i+Ord('A')); If GetVolumeInformation(PChar(disk+':\'), Buf, SizeOf(Buf), nil, a, b, nil, 0) then SetString(s1, Buf, StrLen(Buf)) else s1:=''; DriveType:=TDriveType(GetDriveType(PChar(disk+':\'))); case DriveType of dtUnknown: s2:='Unknown'; dtNoDrive: s2:='NoDrive'; dtFloppy: s2:='Floppy'; dtFixed: s2:='Fixed'; dtNetwork: s2:='Network'; dtCDROM: s2:='CDROM'; dtRAM: s2:='RAM'; else s2:=''; end; sz:=DiskSize(i+1); fr:=DiskFree(i+1); Memo1.Lines.Add(Format('%s: [%s] (%s). Емкость: %d, занято: %d, свободно: %d', [disk, s1, s2, sz, sz-fr, fr])); end; end; Например, текст в Memo1 будет выглядеть следующим образом: C: [OS] (Fixed). Емкость: 128029028352, занято: 74515865600, свободно: 53513162752 D: [OS2] (Fixed). Емкость: 52428795904, занято: 26569834496, свободно: 25858961408 E: [user] (Fixed). Емкость: 112662147072, занято: 107531603968, свободно: 5130543104 F: [Новый] (CDROM). Емкость: 4696145920, занято: 4696145920, свободно: 0 G: [] (Floppy). Емкость: 3994419200, занято: 3936256, свободно: 3990482944 Z: [newerow1989] (Network). Емкость: 59041026048, занято: 57700401152, свободно: 1340624896 Поиск файлов procedure FileSystem(papka, fajl: string); const FileAttr: array[0..37] of integer = (1, 2, 3, 4, 5, 6, 7, 32, 33, 34, 35, 36, 37, 38, 39, 128, 288, 289, 290, 2048, 2080, 2081, 2082, 2083, 2084, 2085, 2086, 8198, 8224, 8225, 8226, 8227, 8228, 8229, 8230, 10272, 10273, 10274); // всевозможные атрибуты файлов { faReadOnly = $00000001 (1) } { faHidden = $00000002 (2) } { faSysFile = $00000004 (4) } { faVolumeID = $00000008 (8) } { faArchive = $00000020 (32) } { faAnyFile = $0000003F (63) } PapkaAttr: array[0..25] of integer = (16, 17, 18, 19, 20, 21, 22, 48, 49, 50, 2064, 2065, 2066, 2067, 2068, 2069, 2070, 2071, 8208, 8209, 8210, 8211, 8212, 8213, 8214, 10256); // всевозможные атрибуты папок { faDirectory = $00000010 (16) } var poisk: TSearchRec; ds: string; function PrinadlezhitI(n: integer; p: array of integer): boolean; var i: integer; begin Result:=false; For i:=Low(p) to High(p) do If n=p[i] then Result:=true; end; begin ChDir(papka); If IOResult<>0 then Exit; If papka[Length(papka)]<>'\' then papka:=papka+'\'; If FindFirst(fajl, faAnyFile, poisk)=0 then Repeat If PrinadlezhitI(poisk.Attr, FileAttr) then begin ds:=FormatDateTime('dd.mm.yyyy hh:nn:ss', FileDateToDateTime(poisk.Time)); Form1.Memo1.Lines.Add(Format('%s%s: размер - %d, дата изменения - %s', [papka, poisk.Name, poisk.Size, ds])); end; Until FindNext(poisk)<>0; ChDir(papka); If FindFirst('*', faAnyFile, poisk)=0 then Repeat If PrinadlezhitI(poisk.Attr, PapkaAttr) then If not (poisk.Name='.') and not (poisk.Name='..') then begin FileSystem(papka+poisk.Name, fajl); ChDir(papka); end; Until FindNext(poisk)<>0; FindClose(poisk); end; procedure TForm1.Button1Click(Sender: TObject); begin Memo1.Clear; FileSystem('E:\Temp', '*'); // поиск всех файлов end; procedure TForm1.Button2Click(Sender: TObject); begin Memo1.Clear; FileSystem('E:\Temp', '*.mp3'); // поиск файлов типа mp3 end; где papka - исходная папка; fajl - файлы, которые нужно найти в исходной папке. Например, при нажании на 1-ю кнопку текст в Memo1 будет выглядеть следующим образом: E:\Temp\112.bmp: размер - 115926, дата изменения - 03.08.2016 09:54:12 E:\Temp\2016.jpg: размер - 58919, дата изменения - 21.09.2015 16:14:14 E:\Temp\Desktop.ini: размер - 78, дата изменения - 17.06.2011 16:55:34 E:\Temp\MAMBO.mp3: размер - 3584418, дата изменения - 08.08.2015 16:06:16 E:\Temp\PIN.png: размер - 22577, дата изменения - 11.01.2016 16:24:36 E:\Temp\Одноклассники.mp3: размер - 4047517, дата изменения - 14.08.2015 12:43:50 E:\Temp\Отпусти.mp3: размер - 3528829, дата изменения - 13.08.2015 12:26:16 E:\Temp\Шепот.txt: размер - 6444, дата изменения - 01.08.2016 18:36:48 E:\Temp\1\Сентябрь - Школьное солнце.mp3: размер - 3824744, дата изменения - 13.08.2015 18:52:34 E:\Temp\1\Я за тобой.mp3: размер - 3325701, дата изменения - 13.08.2015 16:19:24 E:\Temp\2\Project1.cfg: размер - 434, дата изменения - 20.03.2008 22:19:44 E:\Temp\2\Project1.dof: размер - 2015, дата изменения - 20.03.2008 22:19:44 E:\Temp\2\Project1.dpr: размер - 188, дата изменения - 20.03.2008 20:11:12 E:\Temp\2\Project1.exe: размер - 379904, дата изменения - 20.03.2008 22:19:16 E:\Temp\2\Project1.res: размер - 876, дата изменения - 20.03.2008 19:23:48 E:\Temp\2\Project1.~dpr: размер - 188, дата изменения - 20.03.2008 20:11:12 E:\Temp\2\Unit1.dcu: размер - 4601, дата изменения - 20.03.2008 22:17:46 E:\Temp\2\Unit1.ddp: размер - 51, дата изменения - 20.03.2008 22:19:42 E:\Temp\2\Unit1.dfm: размер - 746, дата изменения - 20.03.2008 22:19:16 E:\Temp\2\Unit1.pas: размер - 1459, дата изменения - 20.03.2008 22:17:42 E:\Temp\2\Unit1.~ddp: размер - 51, дата изменения - 20.03.2008 22:18:10 E:\Temp\2\Unit1.~dfm: размер - 718, дата изменения - 20.03.2008 19:33:48 E:\Temp\2\Unit1.~pas: размер - 1459, дата изменения - 20.03.2008 22:17:42 При нажании на 2-ю кнопку текст в Memo1 будет выглядеть следующим образом: E:\Temp\MAMBO.mp3: размер - 3584418, дата изменения - 08.08.2015 16:06:16 E:\Temp\Одноклассники.mp3: размер - 4047517, дата изменения - 14.08.2015 12:43:50 E:\Temp\Отпусти.mp3: размер - 3528829, дата изменения - 13.08.2015 12:26:16 E:\Temp\1\Сентябрь - Школьное солнце.mp3: размер - 3824744, дата изменения - 13.08.2015 18:52:34 E:\Temp\1\Я за тобой.mp3: размер - 3325701, дата изменения - 13.08.2015 16:19:24 Примечание. Допускается использовать следующие константы: faReadOnly, faHidden, faSysFile, faVolumeID, faDirectory, faArchive, faAnyFile. Например: If poisk.Attr = faSysFile then // найти системные файлы If poisk.Attr = faAnyFile then // найти все файлы Создание папки function PapkuSozdat(polnoe_imya_papki: string): boolean; var i: integer; begin For i:=1 to Length(polnoe_imya_papki) do If polnoe_imya_papki[i]='\' then CreateDir(Copy(polnoe_imya_papki, 1, i-1)); Result:=CreateDir(polnoe_imya_papki); end; где polnoe_imya_papki - полный путь в имени папки. Например, PapkuSozdat('E:\1\2\12\85\Пробная папка') выведет положительное значение, если папка создана успешно, или отрицательное значение, если папку не удалось создать (нет диска, доступ запрещен или другие причины). Копирование файла function KopirowatFajl(staroe_imya, nowoe_imya: string): boolean; const MaxBufSize=$F000; var H1, H2, Count: integer; Buffer: pChar; begin Result:=false; H1:=FileOpen(staroe_imya, 64); If H1<0 then Exit; H2:=FileCreate(nowoe_imya); If H2<0 then begin FileClose(H1); Exit; end; Result:=true; FileSeek(H1, 0, 0); GetMem(Buffer, MaxBufSize); try Repeat Count:=FileRead(H1, Buffer^, MaxBufSize); If Count>0 then FileWrite(H2, Buffer^, Count); Until Count<=0; finally FreeMem(Buffer, MaxBufSize); FileClose(H1); FileClose(H2); end; end; где staroe_imya - старое имя файла (исходный файл); nowoe_imya - новое имя файла (конечный файл). Например, KopirowatFajl('E:\123.txt', 'E:\tmp\456.txt') выведет положительное значение, если файл скопирован успешно, или отрицательное значение, если файл не удалось скопировать (исходный файл отсутствует, доступ запрещен, нет конечной папки или другие причины). Скачивание файла из Интернета uses WinInet, IdHTTP; procedure InternetZagruzitFajl1(URL, f: string); const MaxBuffer=65536; var H1, H2: pointer; H3: integer; Buffer: array[1..MaxBuffer] of char; Count: cardinal; begin H1:=InternetOpen('', 0, nil, nil, 0); try H2:=InternetOpenURL(H1, PChar(URL), nil, 0, 0, 0); If H2=nil then begin InternetCloseHandle(H1); Exit; end; try H3:=FileCreate(f); Count:=0; try Repeat InternetReadFile(H2, @Buffer, SizeOf(Buffer), Count); Count:=FileWrite(H3, Buffer, Count); Until Count<=0; finally FileClose(H3); end; finally InternetCloseHandle(H2); end; finally InternetCloseHandle(H1); end; end; procedure InternetZagruzitFajl2(URL, f: string); const MaxBuffer=65536; var LoadStream: TMemoryStream; idHTTP1: TIdHTTP; H3: integer; Count: cardinal; Buffer: array[1..MaxBuffer] of char; begin LoadStream:=TMemoryStream.Create; idHTTP1:=TIdHTTP.Create(Application); try idHTTP1.Get(URL, LoadStream); except LoadStream.Free; idHTTP1.Free; Exit; end; H3:=FileCreate(f); If H3=-1 then begin LoadStream.Free; idHTTP1.Free; Exit; end; FileSeek(H3, 0, 0); LoadStream.Seek(0, 0); Repeat Count:=LoadStream.Read(Buffer, MaxBuffer); If Count>0 then FileWrite(H3, Buffer, Count); Until Count<=0; FileClose(H3); LoadStream.Free; idHTTP1.Free; end; procedure TForm1.Button1Click(Sender: TObject); const URL='http://newerow1989.narod.ru/list.txt'; f1='E:\list1.txt'; f2='E:\list2.txt'; begin InternetZagruzitFajl1(URL, f1); InternetZagruzitFajl2(URL, f2); end; где URL - URL-файл в Интернете, который нужно скачать; f - полное имя файла, сохраняемого на компьютере. Диалоговое окно procedure TForm1.Button1Click(Sender: TObject); var Form2: TForm; Edit1: TEdit; begin Form2:=TForm.Create(Application); Form2.Caption:='Тестовое диалоговое окно'; Form2.Width:=420; Form2.Height:=100; Form2.BorderStyle:=bsDialog; Form2.Position:=poScreenCenter; With TLabel.Create(Form2) do begin Parent:=Form2; Left:=8; Top:=8; Font.Size:=14; Caption:='Введите текст:'; end; Edit1:=TEdit.Create(Form2); Edit1.Parent:=Form2; Edit1.Left:=8; Edit1.Top:=32; Edit1.Width:=400; Edit1.Font.Size:=14; Edit1.Text:=''; Form2.ShowModal; Label1.Caption:=Edit1.Text; Form2.Free; end; При нажатии на кнопку появится диалоговое окно, где требуется ввести текст. При его закрытии введенный текст появится на Label1. Примечание. На форме Form1 должны быть добавлены компоненты Label1 и Button1. Операции с иконками на панели задач Для начала объявим модуль и новый тип, которые необходимы для нашей работы: uses ShellAPI; type TDUMMYUNIONNAME = record case Integer of 0: (uTimeout: UINT); 1: (uVersion: UINT); end; TNewNotifyIconData = record cbSize: DWORD; Wnd: HWND; uID: UINT; uFlags: UINT; uCallbackMessage: UINT; hIcon: HICON; szTip: array[0..127] of Char; dwState: DWORD; dwStateMask: DWORD; szInfo: array[0..255] of Char; DUMMYUNIONNAME: TDUMMYUNIONNAME; szInfoTitle: array[0..63] of Char; dwInfoFlags: DWORD; end; 1. Создание иконки на панели задач procedure IkonNaPZSozdat(Form: TForm; Icon: TIcon; nomer: integer; hint: string); var nidata: TNewNotifyIconData; begin With nidata do begin cbSize:=SizeOf(nidata); Wnd:=Form.Handle; uID:=nomer; uFlags:=NIF_ICON or NIF_MESSAGE or NIF_TIP; uCallBackMessage:=WM_USER; hIcon:=Icon.Handle; StrPCopy(szTip, hint); end; Shell_NotifyIcon(NIM_ADD, @nidata); end; где Form - форма приложения; Icon - иконка в виде рисунка (она отображается на панели задач); nomer - идентификационный номер иконки; hint - текст в виде всплывающей подсказки. Например, IkonNaPZSozdat(Form1, Application.Icon, 2, 'Иконка на панели задач'). 2. Изменение иконки procedure IkonNaPZIzmenit(Form: TForm; Icon: TIcon; nomer: integer; hint: string); var nidata: TNewNotifyIconData; begin With nidata do begin cbSize:=SizeOf(nidata); Wnd:=Form.Handle; uID:=nomer; uFlags:=NIF_ICON or NIF_MESSAGE or NIF_TIP; uCallBackMessage:=WM_USER; hIcon:=Icon.Handle; StrPCopy(szTip, hint); end; Shell_NotifyIcon(NIM_MODIFY, @nidata); end; Например, IkonNaPZIzmenit(Form1, Application.Icon, 2, 'Изменение иконки на ПЗ'). Здесь изменили текст всплывающей подсказки. 3. Сообщение программы на панели задач procedure IkonNaPZSoobschenie(Form: TForm; Icon: TIcon; nomer: integer; ImagePicture: DWORD; zagolowok, soobschenie: string); var nidata: TNewNotifyIconData; begin With nidata do begin cbSize:=SizeOf(nidata); Wnd:=Form.Handle; uID:=nomer; uFlags:=NIF_ICON or NIF_MESSAGE or NIF_TIP or $10; uCallBackMessage:=WM_USER; hIcon:=Icon.Handle; StrPCopy(szInfo, soobschenie); StrPCopy(szInfoTitle, zagolowok); dwInfoFlags:=ImagePicture; end; Shell_NotifyIcon(NIM_MODIFY, @nidata); end; где ImagePicture - номер значка сообщения, значения которых даны ниже: 0 - нет иконки, 1 - информация, 2 - внимание, 3 - ошибка, 4 - значок программы, 5 и более - другие значки; zagolowok - заголовок сообщения; soobschenie - текст сообщения. Например, IkonNaPZSoobschenie(Form1, Application.Icon, 2, 3, 'Сообщение', 'Образец сообщения'). 4. Наведение мыши на иконку В типе TForm1 создать процедуру WMICON, которая будет выполняться при манипуляциях мыши на иконках: type TForm1 = class(TForm) Button1: TButton; Label1: TLabel; Image1: TImage; procedure FormCreate(Sender: TObject); procedure WMICON(var msg: TMessage); message WM_USER; procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; ... procedure TForm1.WMICON(var msg: TMessage); begin Label1.Caption:=Format('ID = %d, Signal = %d', [msg.WParam, msg.LParam]); end; ... где msg - переменная типа TMessage, следующие свойства которых необходимы для обработки: msg.WParam - идентификационный номер иконки, msg.LParam - числовой код, основные значения которых даны ниже: WM_MOUSEMOVE - наведена мышь на иконку, WM_LBUTTONDOWN - нажата левая кнопка мыши на иконке, WM_LBUTTONDBLCLK - двойной щелчок левой кнопки мыши на иконке, WM_RBUTTONDOWN - нажата правая кнопка мыши на иконке, WM_RBUTTONDBLCLK - двойной щелчок правой кнопки мыши на иконке, 1028 - щелчок правой кнопки мыши по всплывающему сообщению программы, 1029 - щелчок левой кнопки мыши по всплывающему сообщению программы. 5. Удаление иконки procedure IkonNaPZUdalit(Form: TForm; nomer: integer); var nidata: TNewNotifyIconData; begin With nidata do begin cbSize:=SizeOf(nidata); Wnd:=Form.Handle; uID:=nomer; end; Shell_NotifyIcon(NIM_DELETE, @nidata); end; Например, IkonNaPZUdalit(Form1, 2). 6. Программа Рассмотрим программу, позволяющую делать любые операции с иконками на панели задач. unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, Menus; type TForm1 = class(TForm) Image1: TImage; Button1: TButton; Button2: TButton; Button3: TButton; Button4: TButton; PopupMenu1: TPopupMenu; procedure FormCreate(Sender: TObject); procedure WMICON(var msg: TMessage); message WM_USER; procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); procedure Button3Click(Sender: TObject); procedure Button4Click(Sender: TObject); procedure N1Click(Sender: TObject); procedure N2Click(Sender: TObject); procedure N3Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} uses ShellAPI; type TDUMMYUNIONNAME = record case Integer of 0: (uTimeout: UINT); 1: (uVersion: UINT); end; TNewNotifyIconData = record cbSize: DWORD; Wnd: HWND; uID: UINT; uFlags: UINT; uCallbackMessage: UINT; hIcon: HICON; szTip: array[0..127] of Char; dwState: DWORD; dwStateMask: DWORD; szInfo: array[0..255] of Char; DUMMYUNIONNAME: TDUMMYUNIONNAME; szInfoTitle: array[0..63] of Char; dwInfoFlags: DWORD; end; procedure IkonNaPZSozdat(Form: TForm; Icon: TIcon; nomer: integer; hint: string); var nidata: TNewNotifyIconData; begin With nidata do begin cbSize:=SizeOf(nidata); Wnd:=Form.Handle; uID:=nomer; uFlags:=NIF_ICON or NIF_MESSAGE or NIF_TIP; uCallBackMessage:=WM_USER; hIcon:=Icon.Handle; StrPCopy(szTip, hint); end; Shell_NotifyIcon(NIM_ADD, @nidata); end; procedure IkonNaPZIzmenit(Form: TForm; Icon: TIcon; nomer: integer; hint: string); var nidata: TNewNotifyIconData; begin With nidata do begin cbSize:=SizeOf(nidata); Wnd:=Form.Handle; uID:=nomer; uFlags:=NIF_ICON or NIF_MESSAGE or NIF_TIP; uCallBackMessage:=WM_USER; hIcon:=Icon.Handle; StrPCopy(szTip, hint); end; Shell_NotifyIcon(NIM_MODIFY, @nidata); end; procedure IkonNaPZSoobschenie(Form: TForm; Icon: TIcon; nomer: integer; ImagePicture: DWORD; zagolowok, soobschenie: string); var nidata: TNewNotifyIconData; begin With nidata do begin cbSize:=SizeOf(nidata); Wnd:=Form.Handle; uID:=nomer; uFlags:=NIF_ICON or NIF_MESSAGE or NIF_TIP or $10; uCallBackMessage:=WM_USER; hIcon:=Icon.Handle; StrPCopy(szInfo, soobschenie); StrPCopy(szInfoTitle, zagolowok); dwInfoFlags:=ImagePicture; end; Shell_NotifyIcon(NIM_MODIFY, @nidata); end; procedure IkonNaPZUdalit(Form: TForm; nomer: integer); var nidata: TNewNotifyIconData; begin With nidata do begin cbSize:=SizeOf(nidata); Wnd:=Form.Handle; uID:=nomer; end; Shell_NotifyIcon(NIM_DELETE, @nidata); end; procedure TForm1.FormCreate(Sender: TObject); var Items: array[0..3] of TMenuItem; begin Image1.Picture.LoadFromFile('E:\1.ico'); IkonNaPZSozdat(Form1, Application.Icon, 1, 'Иконка приложения'); IkonNaPZSozdat(Form1, Image1.Picture.Icon, 5, 'Иконка файла *.ico'); Items[0]:=TMenuItem.Create(PopupMenu1); Items[0].Caption:='Скрыть окно'; Items[0].OnClick:=Form1.N1Click; PopupMenu1.Items.Add(Items[0]); Items[1]:=TMenuItem.Create(PopupMenu1); Items[1].Caption:='Отобразить окно'; Items[1].OnClick:=Form1.N2Click; PopupMenu1.Items.Add(Items[1]); Items[2]:=TMenuItem.Create(PopupMenu1); Items[2].Caption:='-'; PopupMenu1.Items.Add(Items[2]); Items[3]:=TMenuItem.Create(PopupMenu1); Items[3].Caption:='Закрыть программу'; Items[3].OnClick:=Form1.N3Click; PopupMenu1.Items.Add(Items[3]); end; procedure TForm1.WMICON(var msg: TMessage); var P: TPoint; begin If (msg.WParam=1) and (msg.LParam=1028) then MessageBox(0, 'Вы щелкнули правой кнопкой мыши по всплывающему сообщению', 'Окно', 0); If (msg.WParam=5) and ((msg.LParam=WM_LBUTTONDBLCLK) or (msg.LParam=WM_RBUTTONDBLCLK)) then Show; If (msg.WParam=5) and (msg.LParam=WM_RBUTTONDOWN) then begin GetCursorPos(P); PopupMenu1.Popup(P.X, P.Y); end; end; procedure TForm1.Button1Click(Sender: TObject); begin IkonNaPZIzmenit(Form1, Image1.Picture.Icon, 1, 'Обмен иконок (ID = 1)'); IkonNaPZIzmenit(Form1, Application.Icon, 5, 'Обмен иконок (ID = 5)'); end; procedure TForm1.Button2Click(Sender: TObject); begin IkonNaPZSoobschenie(Form1, Image1.Picture.Icon, 1, 2, 'Сообщение', 'Образец сообщения. Можно щелкнуть по нему правой кнопкой мыши...'); end; procedure TForm1.Button3Click(Sender: TObject); begin Hide; IkonNaPZSoobschenie(Form1, Application.Icon, 5, 1, 'Окно невидимо!', 'Для отображения окна кликните ДВОЙНЫМ щелчком мыши на значок. Левая и правая '+ 'кнопка мыши не имеет значения!'); end; procedure TForm1.Button4Click(Sender: TObject); begin IkonNaPZUdalit(Form1, 1); IkonNaPZUdalit(Form1, 5); Close; end; procedure TForm1.N1Click(Sender: TObject); begin Button3Click(nil); end; procedure TForm1.N2Click(Sender: TObject); begin Show; end; procedure TForm1.N3Click(Sender: TObject); begin Button4Click(nil); end; end. В этой программе рекомендуется нажимать кнопки по порядку. Примечание. При запуске программы необходимо наличие файла-иконки *.ico. Список процессов uses TLHelp32; procedure TForm1.Button1Click(Sender: TObject); var PE32: TProcessEntry32; ME32: TModuleEntry32; H, H1: THandle; s: string; begin Memo1.Clear; H:=CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0); try PE32.dwSize:=SizeOf(PE32); ME32.dwSize:=SizeOf(ME32); If Process32First(H, PE32) then Repeat H1:=CreateToolhelp32Snapshot(TH32CS_SNAPALL, PE32.th32ProcessID); try s:=Format('PID: %d, PPID: %d', [PE32.th32ProcessID, PE32.th32ParentProcessID]); If Module32First(H1, ME32) and (PE32.th32ProcessID<>0) then s:=Format('%s, %s (%s)', [s, ME32.szExePath, ME32.szModule]) else s:=Format('%s, %s', [s, PE32.szExeFile]); finally CloseHandle(H1); end; Memo1.Lines.Add(s); Until not Process32Next(H, PE32); finally CloseHandle(H); end; end; Например, текст в Memo1 будет выглядеть следующим образом: PID: 0, PPID: 0, [System Process] PID: 4, PPID: 0, System PID: 320, PPID: 4, smss.exe PID: 484, PPID: 476, csrss.exe PID: 540, PPID: 476, wininit.exe PID: 556, PPID: 532, csrss.exe PID: 608, PPID: 532, winlogon.exe PID: 644, PPID: 540, services.exe PID: 652, PPID: 540, lsass.exe PID: 660, PPID: 540, lsm.exe PID: 764, PPID: 644, svchost.exe PID: 824, PPID: 644, nvvsvc.exe PID: 848, PPID: 644, nvSCPAPISvr.exe PID: 896, PPID: 644, svchost.exe PID: 948, PPID: 644, MsMpEng.exe PID: 488, PPID: 644, svchost.exe PID: 380, PPID: 644, svchost.exe PID: 880, PPID: 644, svchost.exe PID: 1056, PPID: 644, svchost.exe PID: 1112, PPID: 488, audiodg.exe PID: 1140, PPID: 644, svchost.exe PID: 1244, PPID: 644, svchost.exe PID: 1436, PPID: 824, nvxdsync.exe PID: 1444, PPID: 824, nvvsvc.exe PID: 1512, PPID: 644, FBAgent.exe PID: 1552, PPID: 380, wlanext.exe PID: 1560, PPID: 484, conhost.exe PID: 1568, PPID: 644, AsLdrSrv.exe PID: 1596, PPID: 644, GFNEXSrv.exe PID: 1744, PPID: 644, spoolsv.exe PID: 1772, PPID: 644, svchost.exe PID: 1796, PPID: 644, svchost.exe PID: 2016, PPID: 644, armsvc.exe PID: 1180, PPID: 644, BTHSAmpPalService.exe PID: 1372, PPID: 644, InsOnSrv.exe PID: 1676, PPID: 644, AVerRemote.exe PID: 2028, PPID: 644, AVerScheduleService.exe PID: 1476, PPID: 644, AVerUpdateServer.exe PID: 2060, PPID: 644, BTHSSecurityMgr.exe PID: 2112, PPID: 644, SkypeC2CAutoUpdateSvc.exe PID: 2172, PPID: 644, taskhost.exe PID: 2192, PPID: 1568, HControl.exe PID: 2208, PPID: 1372, InsOnWMI.exe PID: 2344, PPID: 1056, taskeng.exe PID: 2396, PPID: 380, dwm.exe PID: 2420, PPID: 2384, explorer.exe PID: 2448, PPID: 2344, sensorsrv.exe PID: 2460, PPID: 2344, LiveUpdate.exe PID: 2472, PPID: 1056, taskeng.exe PID: 2480, PPID: 644, SkypeC2CPNRSvc.exe PID: 2520, PPID: 2472, C:\Program Files (x86)\ASUS\ATK Package\ATKOSD2\ATKOSD2.exe (ATKOSD2.exe) PID: 2584, PPID: 644, svchost.exe PID: 2688, PPID: 644, EvtEng.exe PID: 2728, PPID: 1744, CNAB4RPD.EXE PID: 2876, PPID: 2344, BatteryLife.exe PID: 2932, PPID: 644, MDM.EXE PID: 2960, PPID: 644, mbbService.exe PID: 2412, PPID: 644, RegSrvc.exe PID: 1564, PPID: 644, SeaPort.EXE PID: 3308, PPID: 644, sftvsa.exe PID: 3368, PPID: 644, svchost.exe PID: 3432, PPID: 644, WLIDSVC.EXE PID: 3524, PPID: 644, sftlist.exe PID: 3560, PPID: 3432, WLIDSVCM.EXE PID: 3672, PPID: 1676, C:\Program Files (x86)\Common Files\AVerMedia\AVerQuick\AVerHIDReceiver.exe (AVerHIDReceiver.exe) PID: 4000, PPID: 644, CVHSVC.EXE PID: 2316, PPID: 764, WmiPrvSE.exe PID: 3992, PPID: 644, NisSrv.exe PID: 4424, PPID: 764, unsecapp.exe PID: 4692, PPID: 2192, ATKOSD.exe PID: 4816, PPID: 2420, SynTPEnh.exe PID: 4828, PPID: 2420, AmIcoSinglun64.exe PID: 4840, PPID: 2420, RAVBg64.exe PID: 4868, PPID: 2420, iFrmewrk.exe PID: 4964, PPID: 2420, networx.exe PID: 5004, PPID: 2420, hkcmd.exe PID: 5012, PPID: 2420, igfxpers.exe PID: 4584, PPID: 2420, msseces.exe PID: 4516, PPID: 1436, nvtray.exe PID: 4612, PPID: 2420, sidebar.exe PID: 4384, PPID: 4816, SynTPHelper.exe PID: 4880, PPID: 2420, C:\Users\Неверов\AppData\Roaming\Mail.Ru\Agent\magent.exe (magent.exe) PID: 112, PPID: 644, SearchIndexer.exe PID: 4604, PPID: 1512, C:\Program Files (x86)\ASUS\Splendid\ACMON.exe (ACMON.exe) PID: 2356, PPID: 1512, C:\windows\AsScrPro.exe (AsScrPro.exe) PID: 1576, PPID: 2420, C:\Program Files (x86)\Common Files\AVerMedia\AVerQuick\AVerQuick.exe (AVerQuick.exe) PID: 5200, PPID: 764, C:\Windows\SysWOW64\ACEngSvr.exe (ACEngSvr.exe) PID: 5520, PPID: 1512, C:\Program Files (x86)\CyberLink\Power2Go\CLMLSvc.exe (CLMLSvc.exe) PID: 5552, PPID: 4600, C:\Program Files (x86)\ASUS\ASUS Sonic Focus\SonicFocusTray.exe (SonicFocusTray.exe) PID: 5576, PPID: 4600, C:\Program Files (x86)\ASUS\ATK Package\ATK Media\DMedia.exe (DMedia.exe) PID: 5640, PPID: 4600, C:\Program Files (x86)\ASUS\ATK Package\ATK Hotkey\HControlUser.exe (HControlUser.exe) PID: 5668, PPID: 4600, C:\Program Files (x86)\ASUS\Wireless Console 3\wcourier.exe (wcourier.exe) PID: 5704, PPID: 4600, C:\Program Files (x86)\CyberLink\PowerDVD10\PDVD10Serv.exe (PDVD10Serv.exe) PID: 5996, PPID: 1512, RAVCpl64.exe PID: 5956, PPID: 2192, KBFiltr.exe PID: 5388, PPID: 764, unsecapp.exe PID: 5488, PPID: 2192, WDC.exe PID: 300, PPID: 4924, ps64ldr.exe PID: 4332, PPID: 556, conhost.exe PID: 6076, PPID: 764, explorer.exe PID: 5716, PPID: 644, LMS.exe PID: 6072, PPID: 644, UNS.exe PID: 6120, PPID: 2420, networx.exe PID: 1404, PPID: 644, PresentationFontCache.exe PID: 4560, PPID: 5972, taskmgr.exe PID: 3380, PPID: 644, svchost.exe PID: 8252, PPID: 7480, C:\Program Files (x86)\Common Files\microsoft shared\virtualization handler\cvh.exe (cvh.exe) PID: 4940, PPID: 8252, C:\Program Files (x86)\Common Files\microsoft shared\virtualization handler\OfficeVirt.exe (OfficeVirt.exe) PID: 6844, PPID: 644, OSPPSVC.EXE PID: 8468, PPID: 4516, C:\Program Files (x86)\NVIDIA Corporation\Update Core\NvBackend.exe (NvBackend.exe) PID: 5604, PPID: 6076, C:\Program Files (x86)\Adobe\Acrobat Reader DC\Reader\AcroRd32.exe (AcroRd32.exe) PID: 9428, PPID: 764, dllhost.exe PID: 2088, PPID: 2420, C:\Program Files (x86)\Borland\Delphi6\Bin\delphi32.exe (delphi32.exe) PID: 10328, PPID: 6076, notepad.exe PID: 10468, PPID: 2088, E:\Мои программы\Newerow1989\Delphi\Project1.exe (Project1.exe) Безопасное открытие и закрытие файла 1. Открытие файла function slLoadFromFile(var sl: TStringList; f: string): boolean; const MaxBufSize=$F000; var H, Count: integer; Buffer: pChar; Text: string; begin Result:=false; sl.Clear; H:=FileOpen(f, 64); If H=-1 then Exit; Result:=true; Text:=''; FileSeek(H, 0, 0); GetMem(Buffer, MaxBufSize); Repeat Count:=FileRead(H, Buffer^, MaxBufSize); If Count>0 then Text:=Text+Copy(Buffer, 1, Count); Until Count<=0; FreeMem(Buffer, MaxBufSize); FileClose(H); sl.Text:=Text; end; где sl - переменная типа TStringList, в которую загружают файл f; f - полное имя открываемого файла. 2. Сохранение файла function slSaveToFile(var sl: TStringList; f: string): boolean; const MaxBufSize=$F000; var H, Count: integer; Buffer: pChar; Text: string; begin Result:=false; H:=FileCreate(f); If H=-1 then Exit; Result:=true; Text:=sl.Text; FileSeek(H, 0, 0); Repeat Buffer:=pChar(Copy(Text, 1, MaxBufSize)); Count:=Length(Buffer); If Count>0 then begin FileWrite(H, Buffer^, Count); Text:=Copy(Text, Count+1, Length(Text)); end; Until Count<=0; FileClose(H); end; procedure TForm1.Button1Click(Sender: TObject); const f1='E:\Delphi.txt'; f2='E:\Delphi2.txt'; var sl: TStringList; begin sl:=TStringList.Create; slLoadFromFile(sl, f1); Memo1.Text:=sl.Text; slSaveToFile(sl, f2); sl.Free; end; При нажатии на данную кнопку открывается файл, его содержимое загружается в компонент Memo1 (он служит в качестве блокнота), затем сохраняется в новом файле. Загрузка HTML-текста в браузер компонента TWebBrowser uses ActiveX; procedure WebBrowserText(var WebBrowser: TWebBrowser; TextHTML: string); var sl: TStringList; ms: TMemoryStream; begin If Assigned(WebBrowser.Document) then begin sl:=TStringList.Create; ms:=TMemoryStream.Create; sl.Text:=TextHTML; sl.SaveToStream(ms); ms.Seek(0, 0); (WebBrowser.Document as IPersistStreamInit).Load(tStreamAdapter.Create(ms)); FreeAndNil(ms); FreeAndNil(sl); end; end; procedure TForm1.FormCreate(Sender: TObject); var OLEHtmlText: OLEVariant; begin OLEHtmlText:='about:'; WebBrowser1.Navigate2(OLEHtmlText); end; procedure TForm1.Button1Click(Sender: TObject); var s: string; begin s:=FormatDateTime('dd.mm.yyyy hh:nn:ss', Now); s:=Format('Date / Time: %s', [s]); WebBrowserText(WebBrowser1, s); end; Примечание. Компонент TWebBrowser находится на вкладке "Internet". Сетевое имя компьютера function WinComputerName: string; var i: cardinal; begin SetLength(Result, 16); GetComputerName(PChar(Result), i); SetLength(Result, i); While (Result<>'') and (Result[Length(Result)]=#0) do Delete(Result, Length(Result), 1); end; Имя пользователя function WinUserName: string; var i: cardinal; begin SetLength(Result, 255); GetUserName(PChar(Result), i); SetLength(Result, i); While (Result<>'') and (Result[Length(Result)]=#0) do Delete(Result, Length(Result), 1); end; Чтение системного реестра 1. Название операционной системы uses Registry; function WinInfo: string; var Registry: TRegistry; rd: TRegDataType; Key_Open, Key_Read: string; begin Key_Open:='Software\Microsoft\Windows\CurrentVersion'; If (GetVersion and $80000000)=0 then Key_Open:='Software\Microsoft\Windows NT\CurrentVersion'; Key_Read:='ProductName'; Registry:=TRegistry.Create; try Registry.RootKey:=HKEY_LOCAL_MACHINE; Registry.OpenKey(Key_Open, false); rd:=Registry.GetDataType(Key_Read); If (rd=rdString) or (rd=rdExpandString) then Result:=Registry.ReadString(Key_Read) else Result:=''; finally Registry.Free; end; end; Например, WinInfo выведет 'Windows 7 Home Basic'. 2. Список часовых поясов uses Registry; procedure TForm1.Button1Click(Sender: TObject); var Registry: TRegistry; sl: TStringList; i: integer; Key_Open: string; begin Memo1.Clear; Key_Open:='Software\Microsoft\Windows\CurrentVersion\Time Zones'; If (GetVersion and $80000000)=0 then Key_Open:='Software\Microsoft\Windows NT\CurrentVersion\Time Zones'; Registry:=TRegistry.Create; try Registry.RootKey:=HKEY_LOCAL_MACHINE; Registry.OpenKey(Key_Open, false); If Registry.HasSubKeys then begin sl:=TStringList.Create; Registry.GetKeyNames(sl); Registry.CloseKey; For i:=0 to sl.Count-1 do begin Registry.OpenKey(Key_Open+'\'+sl[i], false); Memo1.Lines.Add(sl[i]); Memo1.Lines.Add(Registry.ReadString('Display')); Memo1.Lines.Add(Registry.ReadString('Std')); Memo1.Lines.Add(Registry.ReadString('Dlt')); Memo1.Lines.Add(''); Registry.CloseKey; end; sl.Free; end else Registry.CloseKey; finally Registry.Free; end; end; Например, текст в Memo1 будет выглядеть следующим образом (выборочно): Alaskan Standard Time (UTC-09:00) Аляска Аляскинское время (зима) Аляскинское время (лето) Aleutian Standard Time (UTC-10:00) Алеутские острова Алеутские острова (зима) Алеутские острова (лето) Altai Standard Time (UTC+07:00) Барнаул, Горно-Алтайск Алтайское стандартное время Алтайское летнее время Astrakhan Standard Time (UTC+04:00) Астрахань, Ульяновск Астраханское стандартное время Астраханское летнее время Atlantic Standard Time (UTC-04:00) Атлантическое время (Канада) Атлантическое время (зима) Атлантическое время (лето) Azores Standard Time (UTC-01:00) Азорские о-ва Азорское время (зима) Азорское время (лето) Central America Standard Time (UTC-06:00) Центральная Америка Центральная Америка (зима) Центральная Америка (лето) Dateline Standard Time (UTC-12:00) Линия перемены дат Линия перемены дат (зима) Линия перемены дат (лето) E. South America Standard Time (UTC-03:00) Бразилия Восточное Ю-Ам. время (зима) Восточное Ю-Ам. время (лето) Easter Island Standard Time (UTC-06:00) о. Пасхи о. Пасхи, стандартное время о. Пасхи, летнее время Ekaterinburg Standard Time (UTC+05:00) Екатеринбург RTZ 4 (зима) RTZ 4 (лето) GMT Standard Time (UTC+00:00) Дублин, Эдинбург, Лиссабон, Лондон GMT - время по Гринвичу (зима) GMT - время по Гринвичу (лето) Haiti Standard Time (UTC-05:00) Гаити Гаитянское стандартное время Гаитянское летнее время Kaliningrad Standard Time (UTC+02:00) Калининград RTZ 1 (зима) RTZ 1 (лето) Line Islands Standard Time (UTC+14:00) О-в Киритимати О-ва Лайн (зима) О-ва Лайн (лето) Magadan Standard Time (UTC+11:00) Магадан Магадан (зима) Магадан (лето) N. Central Asia Standard Time (UTC+07:00) Новосибирск Новосибирское стандартное время Новосибирское летнее время North Asia East Standard Time (UTC+08:00) Иркутск RTZ 7 (зима) RTZ 7 (лето) North Asia Standard Time (UTC+07:00) Красноярск RTZ 6 (зима) RTZ 6 (лето) Omsk Standard Time (UTC+06:00) Омск Омское стандартное время Омское летнее время Pacific Standard Time (UTC-08:00) Тихоокеанское время (США и Канада) Тихоокеанское время США (зима) Тихоокеанское время США (лето) Romance Standard Time (UTC+01:00) Брюссель, Копенгаген, Мадрид, Париж Романское время (зима) Романское время (лето) Russia Time Zone 11 (UTC+12:00) Анадырь, Петропавловск-Камчатский RTZ 11 (зима) RTZ 11 (лето) Russia Time Zone 3 (UTC+04:00) Ижевск, Самара RTZ 3 (зима) RTZ 3 (лето) Russian Standard Time (UTC+03:00) Москва, Санкт-Петербург, Волгоград RTZ 2 (зима) RTZ 2 (лето) Sakhalin Standard Time (UTC+11:00) Сахалин Сахалинское стандартное время Сахалинское летнее время Samoa Standard Time (UTC+13:00) Самоа Самоанское время (зима) Самоанское время (лето) Saratov Standard Time (UTC+04:00) Саратов Саратов (зима) Саратов (лето) Tomsk Standard Time (UTC+07:00) Томск Томск (зима) Томск (лето) Transbaikal Standard Time (UTC+09:00) Чита Забайкальское стандартное время Забайкальское летнее время UTC (UTC) Время в формате UTC Время в формате UTC Время в формате UTC Vladivostok Standard Time (UTC+10:00) Владивосток RTZ 9 (зима) RTZ 9 (лето) Yakutsk Standard Time (UTC+09:00) Якутск RTZ 8 (зима) RTZ 8 (лето) Автор: © Неверов Евгений Викторович E-mail: newerow1989@yandex.ru, newerow1989@mail.ru Сайт: newerow1989.narod.ru Дата изменения: 21.01.2018 г.