Помогите разобраться с мониторингом модемных подключений отключений
Пытаюсь получать события подключения\отключения любых зарегистрированных в системе модемных подключений
Вот это я пишу в обработчике создания формы:
Код:
...
...
HCDEvent := CreateEvent(NIL, TRUE, FALSE, 'CDEvent');
if HCDEvent = 0 then ShowMessage('Чёто ... какая то в функции CreateEvent');
Error := RasConnectionNotification(INVALID_HANDLE_VALUE, @HCDEvent, RASCN_DISCONNECTION);
if Error <> ERROR_SUCCESS then ShowMessage('Чёто ... какая то в функции RasConnectionNotification');
Error := CreateThread(NIL, 0, @RasNotificationThread, NIL, 0, TId);
if Error = 0 then ShowMessage('Чёто ... какая то в функции CreateThread');
...
HCDEvent := CreateEvent(NIL, TRUE, FALSE, 'CDEvent');
if HCDEvent = 0 then ShowMessage('Чёто ... какая то в функции CreateEvent');
Error := RasConnectionNotification(INVALID_HANDLE_VALUE, @HCDEvent, RASCN_DISCONNECTION);
if Error <> ERROR_SUCCESS then ShowMessage('Чёто ... какая то в функции RasConnectionNotification');
Error := CreateThread(NIL, 0, @RasNotificationThread, NIL, 0, TId);
if Error = 0 then ShowMessage('Чёто ... какая то в функции CreateThread');
Ну и собственно код потока:
Код:
function RasNotificationThread(Data: POINTER): INTEGER; stdcall;
begin
if WaitForSingleObject(HCDEvent, INFINITE) = WAIT_OBJECT_0 then ShowMessage('Разъединились');
end;
begin
if WaitForSingleObject(HCDEvent, INFINITE) = WAIT_OBJECT_0 then ShowMessage('Разъединились');
end;
Код:
function RasConnectionNotification(hrasconn: THRASConn; hEvent: POINTER; dwFlags: LONGINT): LONGINT; stdcall; external 'Rasapi32.dll' name 'RasConnectionNotificationA';
Ожидаемое поведение программы:
Когда я отключаю соединение то должен увидеть сообщение на экране "Разъединились", но этого не происходит.
Код пока самый примитивный, расчитан на одно разъединение, потом(когда получится) сделаю на постоянку.
Сразу попрошу не советовать делать это в таймере, прога не из сильно простеньких и лишняя нагрузка на проц ни к чему.
В то же время прога должна очень быстро получать событие подклю\откл. и большие интервалы в таймере не подходят.
Читал что ожидание события в отдельном потоке не сильно напрягает проц
Вот так всё пашет:
Код:
function RasConnectionNotification(hrasconn: THRASConn; hEvent: CARDINAL; dwFlags: CARDINAL): CARDINAL; stdcall; external 'Rasapi32.dll' name 'RasConnectionNotificationA';
Отслеживание событий отключения\подключения с использованием двух потоков.
Глобальные переменные и константы:
Код:
const
RASCN_CONNECTION = 1;
RASCN_DISCONNECTION = 2;
RASCN_BANDWIDTHADDED = 4;
RASCN_BANDWIDTHREMOVED = 8;
RASCN_DORMANT = 16;
RASCN_RECONNECTION = 32;
var
Form1: TForm1;
...
...
DisconnectEvent, ConnectEvent: CARDINAL;
RASCN_CONNECTION = 1;
RASCN_DISCONNECTION = 2;
RASCN_BANDWIDTHADDED = 4;
RASCN_BANDWIDTHREMOVED = 8;
RASCN_DORMANT = 16;
RASCN_RECONNECTION = 32;
var
Form1: TForm1;
...
...
DisconnectEvent, ConnectEvent: CARDINAL;
Функции потоков:
Код:
// ФУНКЦИЯ ПОТОКА ОТСЛЕЖИВАЮЩЕГО ПОДКЛЮЧЕНИЯ
function RASConnectionThread(Data: POINTER): INTEGER; stdcall;
begin
repeat
WaitForSingleObject(ConnectEvent, INFINITE);// Ожидать постоянно
ResetEvent(ConnectEvent);
// Form1.Panel1.Color := clGreen;
Application.ProcessMessages;
until ConnectEvent = 0;
end;
// ФУНКЦИЯ ПОТОКА ОТСЛЕЖИВАЮЩЕГО ОТКЛЮЧЕНИЯ
function RASDisconnectionThread(Data: POINTER): INTEGER; stdcall;
var
ConnArray: Array[0..MaxEntries] of TRASConn;
Connections, ConnSize: INTEGER;
begin
repeat
WaitForSingleObject(DisconnectEvent, INFINITE);// Ожидать постоянно
ResetEvent(DisconnectEvent);
ConnArray[0].dwSize := SizeOf(TRASConn);
ConnSize := Length(ConnArray) * SizeOf(TRasConn);
RasEnumConnections(@ConnArray, ConnSize, Connections);
if Connections < 1 then
begin
// Form1.Panel1.Color := clRed;
// Код при отсутствии подключений
end;
// Или тут при каждом отключении
Application.ProcessMessages;
until DisconnectEvent = 0;
end;
function RASConnectionThread(Data: POINTER): INTEGER; stdcall;
begin
repeat
WaitForSingleObject(ConnectEvent, INFINITE);// Ожидать постоянно
ResetEvent(ConnectEvent);
// Form1.Panel1.Color := clGreen;
Application.ProcessMessages;
until ConnectEvent = 0;
end;
// ФУНКЦИЯ ПОТОКА ОТСЛЕЖИВАЮЩЕГО ОТКЛЮЧЕНИЯ
function RASDisconnectionThread(Data: POINTER): INTEGER; stdcall;
var
ConnArray: Array[0..MaxEntries] of TRASConn;
Connections, ConnSize: INTEGER;
begin
repeat
WaitForSingleObject(DisconnectEvent, INFINITE);// Ожидать постоянно
ResetEvent(DisconnectEvent);
ConnArray[0].dwSize := SizeOf(TRASConn);
ConnSize := Length(ConnArray) * SizeOf(TRasConn);
RasEnumConnections(@ConnArray, ConnSize, Connections);
if Connections < 1 then
begin
// Form1.Panel1.Color := clRed;
// Код при отсутствии подключений
end;
// Или тут при каждом отключении
Application.ProcessMessages;
until DisconnectEvent = 0;
end;
И в создании формы пишем:
Код:
DisconnectEvent := CreateEvent(NIL, TRUE, FALSE, 'Disconnect');
ConnectEvent := CreateEvent(NIL, TRUE, FALSE, 'Connect');
RASError := RasConnectionNotification(INVALID_HANDLE_VALUE, DisconnectEvent, RASCN_DISCONNECTION);
Error := CreateThread(NIL, 0, @RASDisconnectionThread, NIL, 0, TId);
RASError := RasConnectionNotification(INVALID_HANDLE_VALUE, ConnectEvent, RASCN_CONNECTION);
Error := CreateThread(NIL, 0, @RASConnectionThread, NIL, 0, TId);
Ошибки всех функций обрабатываем сами
ConnectEvent := CreateEvent(NIL, TRUE, FALSE, 'Connect');
RASError := RasConnectionNotification(INVALID_HANDLE_VALUE, DisconnectEvent, RASCN_DISCONNECTION);
Error := CreateThread(NIL, 0, @RASDisconnectionThread, NIL, 0, TId);
RASError := RasConnectionNotification(INVALID_HANDLE_VALUE, ConnectEvent, RASCN_CONNECTION);
Error := CreateThread(NIL, 0, @RASConnectionThread, NIL, 0, TId);
Ошибки всех функций обрабатываем сами
Встречались советы типа через шелекзекут запустить rasdial с какимито там параметрами, и например сделать чтоб окно не отображалось. Работает конечно прекрасно, но есть одна проблемка. Шелекзекут возвращает управление программой следующему за ней коду до полного(корректного )отключения. В этой ситуации при попытках подключиться получим ошибку в функции RasDial.
Вот функция которая ждёт полного отключения всех активных подключений:
Код:
// ФУНКЦИЯ ОТКЛЮЧАЕТ ВСЕ ПОДКЛЮЧЕНИЯ
function Disconnection(): BOOL; stdcall;
var
ConnArray: Array[0..MaxEntries] of TRASConn;
ConStatus: TRASConnStatus;
Error, Connections, ConnSize, I: INTEGER;
begin
result := FALSE;
ConnArray[0].dwSize := SizeOf(TRASConn);
ConnSize := Length(ConnArray) * SizeOf(TRasConn);
Error := RasEnumConnections(@ConnArray, ConnSize, Connections);
if Error = ERROR_SUCCESS then
begin
ConStatus.dwSize := SizeOf(TRASConnStatus);
for I := 0 to Connections - 1 do
begin
RASHangUp(ConnArray[I].hrasconn);
repeat
Application.ProcessMessages;
Sleep(0);
until RasGetConnectStatus(ConnArray[I].hrasconn, ConStatus) = ERROR_INVALID_HANDLE;
end;
// Form1.Panel1.Color := clRed;
// Application.ProcessMessages;
result := TRUE;
end;
end;
function Disconnection(): BOOL; stdcall;
var
ConnArray: Array[0..MaxEntries] of TRASConn;
ConStatus: TRASConnStatus;
Error, Connections, ConnSize, I: INTEGER;
begin
result := FALSE;
ConnArray[0].dwSize := SizeOf(TRASConn);
ConnSize := Length(ConnArray) * SizeOf(TRasConn);
Error := RasEnumConnections(@ConnArray, ConnSize, Connections);
if Error = ERROR_SUCCESS then
begin
ConStatus.dwSize := SizeOf(TRASConnStatus);
for I := 0 to Connections - 1 do
begin
RASHangUp(ConnArray[I].hrasconn);
repeat
Application.ProcessMessages;
Sleep(0);
until RasGetConnectStatus(ConnArray[I].hrasconn, ConStatus) = ERROR_INVALID_HANDLE;
end;
// Form1.Panel1.Color := clRed;
// Application.ProcessMessages;
result := TRUE;
end;
end;
Если хочешь, чтоб управление возвращалось только после полного завершения вызываемого процесса, просто вызывай CreateProcess и жди его с помощью WaitForSingleObject
Это уже ни к чему. Я вообще не знаю как работает этот расдиал и какие там параметры. Учитывая что написанна фунька(которую вы видели выше) я и не хочу знать как он работает.
Тем более не факт что завершение той консольной проги = корректное отключение, и полагаться на такие вещи я не могу.
Да и вообще не люблю в своих программах вызывать всякие проги, где вполне можно справиться с АПИ.