Отследить перехват фокуса приложения

Private Declare Function GetForegroundWindow Lib "user32" () As Long

Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long

Declare Function GetForegroundWindow Lib "user32" () As Long
Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
 Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
Sub TimerProc()
Ret = GetForegroundWindow()
Form1.Caption = Str(Ret)
End Sub

Private Sub Form_Load()
'Create an API-timer
    SetTimer Me.hwnd, 0, 10, AddressOf TimerProc
End Sub
Private Sub Form_Unload(Cancel As Integer)
    'Kill our API-timer
    KillTimer Me.hwnd, 0
    
End Sub

Option Explicit
Private Declare Function GetForegroundWindow Lib "user32" () As Long
 
      Declare Function SetTimer Lib "user32" _
            (ByVal hwnd As Long, _
            ByVal nIDEvent As Long, _
            ByVal uElapse As Long, _
            ByVal lpTimerFunc As Long) As Long
 
      Declare Function KillTimer Lib "user32" _
            (ByVal hwnd As Long, _
            ByVal nIDEvent As Long) As Long
 
      Global iCounter As Integer
Public hwnd_i As Long
 
      Sub TimerProc(ByVal hwnd As Long, _
                     ByVal uMsg As Long, _
                     ByVal idEvent As Long, _
                     ByVal dwTime As Long)
 
          iCounter = iCounter + 1
          If hwnd_i <> GetForegroundWindow Then
              hwnd_i = GetForegroundWindow
              If hwnd_i <> 0 Then
              Form1.List1.AddItem hwnd_i
          End If
          End If
      End Sub

 Option Explicit
      Dim lngTimerID As Long
      Dim BlnTimer As Boolean
 
      Private Sub Form_Load()
         BlnTimer = False
         Command1.Caption = "Start Timer"
      End Sub
 
      Private Sub Command1_Click()
      'Starts and stops the timer.
 
         If BlnTimer = False Then
         hwnd_i = 0
            lngTimerID = SetTimer(0, 0, 200, AddressOf TimerProc)
            If lngTimerID = 0 Then
              MsgBox "Timer not created. Ending Program"
              Exit Sub
            End If
            BlnTimer = True
            Command1.Caption = "Stop Timer"
         Else
            lngTimerID = KillTimer(0, lngTimerID)
            If lngTimerID = 0 Then
               MsgBox "couldn't kill the timer"
            End If
            BlnTimer = False
            Command1.Caption = "Start Timer"
          End If
 
      End Sub
 
Private Sub Form_Unload(Cancel As Integer)
If BlnTimer = True Then Cancel = 1
End Sub

Option Explicit
Declare Function GetWindowText Lib "user32.dll" Alias "GetWindowTextA" _
(ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
 
Private Declare Function GetForegroundWindow Lib "user32" () As Long
 
      Declare Function SetTimer Lib "user32" _
            (ByVal hwnd As Long, _
            ByVal nIDEvent As Long, _
            ByVal uElapse As Long, _
            ByVal lpTimerFunc As Long) As Long
 
      Declare Function KillTimer Lib "user32" _
            (ByVal hwnd As Long, _
            ByVal nIDEvent As Long) As Long
 
      Global iCounter As Integer
Public hwnd_i As Long
Dim titlebar As String
Dim slength As Long
 
      Sub TimerProc(ByVal hwnd As Long, _
                     ByVal uMsg As Long, _
                     ByVal idEvent As Long, _
                     ByVal dwTime As Long)
 
          iCounter = iCounter + 1
          If hwnd_i <> GetForegroundWindow Then
              hwnd_i = GetForegroundWindow
              If hwnd_i <> 0 Then
 
 
 
titlebar = String(256, " ")
slength = GetWindowText(hwnd_i, titlebar, 255)
titlebar = Left(titlebar, InStr(titlebar, vbNullChar) - 1)
 
              Form1.List1.AddItem hwnd_i & vbTab & vbTab & titlebar
          End If
          End If
      End Sub

Declare Function GetForegroundWindow Lib "user32" () As Long
Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long
Declare Function Module32First Lib "kernel32" (ByVal hSnapshot As Long, uProcess As MODULEENTRY32) As Long
Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
 
Private Type MODULEENTRY32
  dwSize As Long
  th32ModuleID As Long
  th32ProcessID As Long
  GlblcntUsage As Long
  ProccntUsage As Long
  modBaseAddr As Long
  modBaseSize As Long
  hModule As Long
  szModule As String * 256
  szExePath As String * 260
End Type
Sub TimerProc()
Dim uProcess As MODULEENTRY32
Static OldName$
Ret = GetForegroundWindow()
GetWindowThreadProcessId Ret, pid
 
hSnapshot = CreateToolhelp32Snapshot(8, pid)
uProcess.dwSize = Len(uProcess)
n = Module32First(hSnapshot, uProcess)
Name$ = Left(uProcess.szModule, InStr(uProcess.szModule, Chr(0)) - 1)
If Name$ <> OldName$ Then
 Form1.Print Name$
 OldName$ = Name$
End If
End Sub

Private Sub Form_Load()
Form1.AutoRedraw = True
'Create an API-timer
    SetTimer Me.hwnd, 0, 100, AddressOf TimerProc
End Sub
Private Sub Form_Unload(Cancel As Integer)
    'Kill our API-timer
    KillTimer Me.hwnd, 0
    
End Sub

Form1.Text1.Text = Form1.Text1.Text & Name$ & vbNewLine