Windows,SysUtils,Shellapi,Messages,Registry


Download 18.85 Kb.
Sana18.08.2020
Hajmi18.85 Kb.
#126687
Bog'liq
Rezident dasturlar yaratish


program ETesterR;

uses


Windows,SysUtils,ShellAPI,Messages,Registry;
const

ClassName = 'ETesterR'; // Имя класса

WM_NOTIFYTRAYICON = WM_USER + 1; { Это сообщение будет генерироваться при событиях с tray }

var


menu: hMenu; // Всплывающее меню

mywnd: hWnd; // Окно программы


{$R ETesterR.res}

// Главная оконная процедура:

procedure SetCurrentETdir;

var


h: TRegistry;

s:string;

i,j,l:integer;

begin


h := TRegistry.Create;

with h do

begin

RootKey := HKEY_LOCAL_MACHINE;



OpenKey('\Software\Microsoft\Windows\CurrentVersion\Run', false);

s:=ReadString('EtesterR');

CloseKey;

Free;


end;

l:=length(s);

for i:=l downto 1 do

if s[i]='\' then begin j:=i; break end;

s:=copy(s,1,j-1);

setcurrentdir(s);

end;
procedure shutdown;

var h: HWND;

begin

h := findwindow(nil, 'ETServer');



if h <> 0 then

PostMessage(h,wm_quit, 0, 0);

end ;
function MyWndProc(wnd: hWnd; msg, wParam,

lParam: longint): longint; stdcall;

var

p: TPoint;



tray: TNotifyIconData;

ProgmanWnd: hWnd;

begin

case msg of



WM_NOTIFYTRAYICON: begin // Событие tray

// Если нажата правая кнопка, показать меню:

if lparam = WM_RBUTTONUP then begin

SetForegroundWindow(mywnd);

GetCursorPos(p);

TrackPopupMenu(menu, TPM_LEFTALIGN, p.x, p.x, 0, wnd, nil);

end;

result := 0;



end;

WM_COMMAND: begin // Выбран пункт меню

{ В зависимости от выбранного пункта меню открывается

записная книжка, запускается ScreenSaver, "усыпляется"

компьютер или закрывается программа: }

case loword(wparam) of

0:WinExec(Pchar('ETester.exe'), SW_Restore);

2:begin SendMessage(mywnd, WM_CLOSE, 0, 0);shutdown end;

end;

result:=0;



end;

WM_DESTROY: begin // Закрытие программы

// Удаление tray:

with tray do begin

cbSize := sizeof(TNotifyIconData);

wnd := mywnd;

uID := 0;

end;


Shell_NotifyIcon(NIM_DELETE, @tray);

PostQuitMessage(0);

result := 0;

end;


else result := DefWindowProc(wnd, msg, WParam, LParam);

end;


end;
// Создание окна:

function CreateMyWnd: hWnd;

var

wc: WndClass;



begin

// Регистрация класса:

wc.style := CS_HREDRAW or CS_VREDRAW;

wc.lpfnWndProc := @MyWndProc;

wc.cbClsExtra := 0;

wc.cbWndExtra := 0;

wc.hInstance := hInstance;

wc.hIcon := LoadIcon(hinstance, IDI_ASTERISK);

wc.hCursor := LoadCursor(hinstance, IDC_ARROW);

wc.hbrBackground := COLOR_INACTIVECAPTION;

wc.lpszMenuName := nil;

wc.lpszClassName := ClassName;

if RegisterClass(wc) = 0 then halt(0);

// Создание окна:

result := CreateWindowEx(WS_EX_APPWINDOW, ClassName,

'ETServerR', WS_POPUP, 100, 100, 200, 200, 0, 0, hInstance, nil);

if result = 0 then halt(0);

SetCurrentETdir;

WinExec(Pchar('ETServer.exe'), SW_Restore);

end;
// Создание Tray:

procedure CreateTray;

var


tray: TNotifyIconData;

begin


with tray do begin

cbSize := sizeof(TNotifyIconData);

wnd := mywnd;

uID := 0;

uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;

uCallBackMessage := WM_NOTIFYTRAYICON;

hIcon := LoadIcon(hInstance,'ETesterR');

szTip := ('ETServerR');

end;

Shell_NotifyIcon(NIM_ADD, @tray);



end;
// Создание всплывающего меню:

function CreateMyMenu: hMenu;

begin

result := CreatePopupMenu;



if result = 0 then Exit;

AppendMenu(result, MF_STRING, 0, 'Hususiyat');

AppendMenu(result, MF_SEPARATOR,1, 'Exit');

AppendMenu(result, MF_STRING, 2, 'Chiqish');

end;
var

msg: TMsg;

begin

mywnd := CreateMyWnd; // Создание окна



CreateTray; // Создание tray

menu := CreateMyMenu; // Создание меню

// Установка низкого приоритета:

SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_IDLE);

// Распределение сообщений:

while (GetMessage(msg, 0, 0, 0)) do begin

TranslateMessage(msg);

DispatchMessage(msg);



end;

end.
Download 18.85 Kb.

Do'stlaringiz bilan baham:




Ma'lumotlar bazasi mualliflik huquqi bilan himoyalangan ©fayllar.org 2024
ma'muriyatiga murojaat qiling