Friday, May 9, 2008

Find Something

Form

Option Explicit

Private Declare Function GetWindowText Lib “user32″ Alias “GetWindowTextA” (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long

Private Sub cmdActivate_Click()
   Dim nRet As Long
   Dim Title As String

   nRet = AppActivatePartial(Trim(txtTitle.Text), _
          Val(frmMethod.Tag), CBool(chkCase.Value))
   If nRet Then
      lblResults.Caption = “Found: &&H” & Hex$(nRet)
      Title = Space$(256)
      nRet = GetWindowText(nRet, Title, Len(Title))
      If nRet Then
         lblResults.Caption = lblResults.Caption & _
            “, “”" & Left$(Title, nRet) & “”"”
      End If
   Else
      lblResults.Caption = “Search Failed”
   End If
End Sub

Private Sub Form_Load()

   txtTitle.Text = “”
   lblResults.Caption = “”
   optMethod(0).Value = True
End Sub

Private Sub optMethod_Click(Index As Integer)

   frmMethod.Tag = Index
End Sub

Module

Option Explicit

Private Declare Function EnumWindows Lib “user32″ (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Private Declare Function GetClassName Lib “user32″ Alias “GetClassNameA” (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function GetWindowText Lib “user32″ Alias “GetWindowTextA” (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function IsIconic Lib “user32″ (ByVal hWnd As Long) As Long
Private Declare Function IsWindowVisible Lib “user32″ (ByVal hWnd As Long) As Long
Private Declare Function ShowWindow Lib “user32″ (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function SetForegroundWindow Lib “user32″ (ByVal hWnd As Long) As Long

Private Const SW_RESTORE = 9

Private m_hWnd As Long
Private m_Method As FindWindowPartialTypes
Private m_CaseSens As Boolean
Private m_Visible As Boolean
Private m_AppTitle As String

Public Enum FindWindowPartialTypes
   FwpStartsWith = 0
   FwpContains = 1
   FwpMatches = 2
End Enum

Public Function AppActivatePartial(AppTitle As String, Optional Method As FindWindowPartialTypes = FwpStartsWith, Optional CaseSensitive As Boolean = False) As Long
   Dim hWndApp As Long
 
   hWndApp = FindWindowPartial(AppTitle, Method, CaseSensitive, True)
   If hWndApp Then
    
      If IsIconic(hWndApp) Then
         Call ShowWindow(hWndApp, SW_RESTORE)
      End If
      Call SetForegroundWindow(hWndApp)
      AppActivatePartial = hWndApp
   End If
End Function

Public Function FindWindowPartial(AppTitle As String, _
   Optional Method As FindWindowPartialTypes = FwpStartsWith, _
   Optional CaseSensitive As Boolean = False, _
   Optional MustBeVisible As Boolean = False) As Long
  
   m_hWnd = 0
   m_Method = Method
   m_CaseSens = CaseSensitive
   m_AppTitle = AppTitle
 
   If m_CaseSens = False Then
      m_AppTitle = UCase$(m_AppTitle)
   End If
 
   Call EnumWindows(AddressOf EnumWindowsProc, MustBeVisible)
   FindWindowPartial = m_hWnd
End Function

Private Function EnumWindowsProc(ByVal hWnd As Long, ByVal lParam As Long) As Long
   Static WindowText As String
   Static nRet As Long

   If lParam Then
      If IsWindowVisible(hWnd) = False Then
         EnumWindowsProc = True
         Exit Function
      End If
   End If

   WindowText = Space$(256)
   nRet = GetWindowText(hWnd, WindowText, Len(WindowText))
   If nRet Then
   
      WindowText = Left$(WindowText, nRet)
      If m_CaseSens = False Then
         WindowText = UCase$(WindowText)
      End If
  
      Select Case m_Method
         Case FwpStartsWith
            If InStr(WindowText, m_AppTitle) = 1 Then
               m_hWnd = hWnd
            End If
         Case FwpContains
            If InStr(WindowText, m_AppTitle) <> 0 Then
               m_hWnd = hWnd
            End If
         Case FwpMatches
            If WindowText = m_AppTitle Then
               m_hWnd = hWnd
            End If
      End Select
   End If
 
   EnumWindowsProc = (m_hWnd = 0)
End Function

Posted by Administrator at 07:27:08
Comments

One Response to “Find Something”

  1. loveyou says:

    It is amazing…I will follow your instruction.

Leave a Reply