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

Информация о том, есть ли в данный момент соединение с Интернетом, лежит в реестре. Если каждую секунду считывать это значение, то можно определить, когда соединение было установлено и разорвано. При этом чтение их реестра не будет сильно загружать компьютер - весь 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,
  'SystemCurrentControlSetServicesRemoteAccess', 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.

Другое по теме:

• Get ALL Ip
• FTP - докачка файлов
• Присоединиться к FTP серверу и загрузить с него файл