Отправляет email-рассылки с помощью сервиса Sendsay

Советы по Delphi

Рассылка закрыта

При закрытии подписчики были переданы в рассылку "Delphi - проблемы и решения" на которую и рекомендуем вам подписаться.

Вы можете найти рассылки сходной тематики в Каталоге рассылок.

←   Ноябрь 2001   →
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
Автор
Сергей

Статистика

13.545 подписчиков
-22 за неделю
←   Все выпуски   →

Советы по Delphi - Inet Resident


Служба Рассылок Subscribe.Ru

Здравствуйте, уважаемые подписчики! Сегодня поговорим об отлавливании события входа и выхода из Интернета. Но вначале я хочу попросить вас указать, какими версиями Delphi вы пользуетесь - опрос проводится на program.dax.ru/delver.htm. Вам нужно только зайти по этому адресу и установить флажок рядом с теми версиями 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'; // Имя класса
  WM_NOTIFYTRAYICON = WM_USER + 1; { Это сообщение будет
                      генерироваться при событиях с tray }
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.


Полезные мелочи
Функция StrToInt позволяет очень удобно преобразовывать строку '123' в число 123. Но если строка не содержит число (например, 'абв'), будет выдано сообщение об ошибке. Чтобы этого избежать, можно воспользоваться процедурой val, которая, впрочем, не очень удобна. В некоторых же случаях возможно использование StrToIntDef. В случае неверной строки функция вернет значение, переданное ей со вторым параметром. Пример:
procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
  v: integer;
begin
  if key = VK_RETURN then begin
    v := StrToIntDef(Edit1.Text, 0);
    Edit1.Text := IntToStr(v);
    Edit1.SelectAll;
  end;
end;


Все советы и замечания, пожалуйста, присылайте на program@dax.ru

Всего доброго,
Даниил Карапетян.




http://subscribe.ru/
E-mail: ask@subscribe.ru 		Отписаться
Убрать рекламу
В избранное