БОЛЬШОЙ FAQ ПО DELPHI



Считываем информацию из реестра о наличии соединения с интернетом

Звонит любовник любовнице:
- Давай встретимся.
- Давай.
- А где?
- Давай у меня дома.
- А муж?
- А его сейчас нет, он в интернете.

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

Для работы с реестром здесь используются непосредственно функции WinAPI. Это позволяет сэкономить память и ускорить проверку соединения. При изменении соединения вызывается процедура InetConnectionChange. Таким образом, чтобы изменить действия программы, достаточно переписать эту процедуру. Эта программа при соединении с Интернетом создает tray. В его меню включены пункты открыть страницу http://program.dax.ru и послать письмо на program@dax.ru с темой subscribe. При выходе из Интернета tray исчезае


 program Project1;
 
 uses
   Windows, ShellAPI, Messages;
 
 const
   ClassName = 'MyResident'; // Имя класса
   { Это сообщение будет генерироваться при событиях с tray }
   WM_NOTIFYTRAYICON = WM_USER + 1;
 var
   menu: hMenu = 0; // Всплывающее меню
   mywnd: hWnd; // Окно программы
   reg: HKEY;
   connection: longint;
 
 // Создание всплывающего меню:
 function CreateMyMenu: hMenu;
 begin
   result := CreatePopupMenu;
   if result = 0 then
     Exit;
   AppendMenu(result, MF_STRING, 0, 'site');
   AppendMenu(result, MF_STRING, 1, 'letter');
   AppendMenu(result, MF_SEPARATOR, 2, nil);
   AppendMenu(result, MF_STRING, 3, 'Exit');
 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(0, IDI_ASTERISK);
     szTip := ('My Resident');
   end;
   Shell_NotifyIcon(NIM_ADD, @tray);
 end;
 
 // Удаление tray:
 procedure DeleteTray;
 var
   tray: TNotifyIconData;
 begin
   with tray do
   begin
     cbSize := sizeof(TNotifyIconData);
     wnd := mywnd;
     uID := 0;
   end;
   Shell_NotifyIcon(NIM_DELETE, @tray);
 end;
 
 // Изменение соединения
 procedure InetConnectionChange(connecting: boolean);
 begin
   if connecting then
   begin
     CreateTray; // Создание tray
     menu := CreateMyMenu; // Создание муню
   end
   else
   begin
     DestroyMenu(menu); // удалить мнею
     DeleteTray; // удалить tray
     menu := 0;
   end;
 end;
 
 // Главная оконная процедура:
 function MyWndProc(wnd: hWnd; msg, wParam,
 lParam: longint): longint; stdcall;
 var
   p: TPoint;
   DataType, DataSize: cardinal;
 begin
   case msg of
   WM_TIMER:
   begin
     // проверка соединения:
     DataSize := 4;
     if RegQueryValueEx(reg, 'Remote Connection', nil, @DataType,
     @connection, @DataSize) <> ERROR_SUCCESS then
       MessageBeep(0);
     if (connection = 0) <> (menu = 0) then
       InetConnectionChange(connection > 0);
     result := 0;
   end;
   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 // Выбран пункт меню
   { В зависимости от выбранного пункта меню открывается
   program.dax.ru в браузере или создается письмо или
   закрывается программа: }
     case loword(wparam) of
       0: ShellExecute(hinstance, nil, 'http://program.dax.ru/',
         nil, nil, SW_SHOWNORMAL);
       1: ShellExecute(hinstance, nil,
         'mailto:program@dax.ru?subject=subscribe',
         nil, nil, SW_SHOWNORMAL);
       else
         SendMessage(mywnd, WM_CLOSE, 0, 0);
     end;
     result := 0;
   end;
   WM_DESTROY:
   begin // Закрытие программы
     DeleteTray; // Удаление 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,
   'My Window', WS_POPUP, 100, 100, 200, 200, 0, 0, hInstance, nil);
   if result = 0 then
     halt(0);
 end;
 
 var
   msg: TMsg;
 begin
   mywnd := CreateMyWnd; // Создание окна
   // Установка низкого приоритета:
   SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_IDLE);
   if RegOpenKeyEx(HKEY_LOCAL_MACHINE,
   'System\CurrentControlSet\Services\RemoteAccess', 0,
   KEY_NOTIFY, reg) <> ERROR_SUCCESS then
     halt(0);
   SetTimer(mywnd, 0, 1000, nil); // Создание таймера
   // Распределение сообщений:
   while (GetMessage(msg, 0, 0, 0)) do
   begin
     TranslateMessage(msg);
     DispatchMessage(msg);
   end;
   KillTimer(mywnd, 0); // Удаление таймера
   RegCloseKey(reg); // Закрытие раздела реестра
 end.
 




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



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



Видеокурс ВЗЛОМ