Dim objR As Rtfm32.Sound
<...>
Private Sub Form_Load()
Set objR = New Rtfm32.Sound
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set objR = Nothing
End Sub
<...>
'таймер tmrMain надо поставить на форму
Private Sub tmrMain_Timer()
If objR.Compare(objR.GetWaveData, _
objR.SoundLib.Extract(rt32_ModemSound)) = 0 Then
MsgBox "Дозвон!", vbInformation
End If
End Sub
hCORe писал(а):Можно, конечно, "ловить" команды с COM-порта (MSComm или API).
Option Explicit
'на форму положить:
'Timer (таймер) с именем "tmrTimer";
'Label (надпись) с именем "lblInfo";
Private Declare Function RasEnumConnections Lib "RasApi32.DLL" _
Alias "RasEnumConnectionsA" (lpRasCon As Any, lpcb As _
Long, lpcConnections As Long) As Long
Private Declare Function RasGetConnectStatus Lib "RasApi32.DLL" _
Alias "RasGetConnectStatusA" (ByVal hRasCon As Long, _
lpStatus As Any) As Long
Const RAS_MaxEntryName = 256
Const RAS_MaxDeviceType = 16
Const RAS_MaxDeviceName = 32
Private Type RASType
dwSize As Long
hRasCon As Long
szEntryName(RAS_MaxEntryName) As Byte
szDeviceType(RAS_MaxDeviceType) As Byte
szDeviceName(RAS_MaxDeviceName) As Byte
End Type
Private Type RASStatusType
dwSize As Long
RasConnState As Long
dwError As Long
szDeviceType(RAS_MaxDeviceType) As Byte
szDeviceName(RAS_MaxDeviceName) As Byte
End Type
Private Sub Form_Load()
tmrMain.Interval = 10
End Sub
Private Function ConnectStatus() As Boolean
Dim RAS(255) As RASType, RASStatus As RASStatusType
Dim lg, lpconnection, Result
RAS(0).dwSize = 412
lg = 256 * RAS(0).dwSize
Result = RasEnumConnections(RAS(0), lg, lpconnection)
If lpconnection = 0 Then
ConnectStatus = False
lblInfo.Caption = "Offline"
Else
RASStatus.dwSize = 160
Result = RasGetConnectStatus(RAS(0).hRasCon, RASStatus)
If RASStatus.RasConnState = &H2000& Then
ConnectStatus = True
lblInfo.Caption = "Online"
Else
ConnectStatus = False
lblInfo.Caption = "Unknown Status"
End If
End If
End Function
Private Sub tmrMain_Timer()
ConnectStatus
End Sub
Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 125