Option Explicit
Private Declare Function DdeInitialize Lib "user32" Alias "DdeInitializeA" (pidInst As Long, ByVal pfnCallback As Long, ByVal afCmd As Long, ByVal ulRes As Long) As Integer
Private Declare Function DdeCreateStringHandle Lib "user32" Alias "DdeCreateStringHandleA" (ByVal idInst As Long, ByVal psz As String, ByVal iCodePage As Long) As Long
Private Declare Function DdeConnect Lib "user32" (ByVal idInst As Long, ByVal hszService As Long, ByVal hszTopic As Long, pCC As Any) As Long
Private Declare Function DdeFreeStringHandle Lib "user32" (ByVal idInst As Long, ByVal hsz As Long) As Long
Private Declare Function DdeUninitialize Lib "user32" (ByVal idInst As Long) As Long
Private Declare Function DdeClientTransaction Lib "user32.dll" (ByVal pData As Long, ByVal cbData As Long, ByVal hConv As Long, ByVal hszItem As Long, ByVal wFmt As Long, ByVal wType As Long, ByVal dwTimeout As Long, ByRef pdwResult As Long) As Long
Private Declare Function DdeAccessData Lib "user32.dll" (ByVal hData As Long, ByRef pcbDataSize As Long) As Long
Private Declare Function DdeUnaccessData Lib "user32.dll" (ByVal hData As Long) As Long
Private Declare Function DdeFreeDataHandle Lib "user32.dll" (ByVal hData As Long) As Long
Private Declare Function DdeDisconnect Lib "user32.dll" (ByVal hConv As Long) As Long
Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (ByVal lpString1 As String, ByVal lpString2 As Long) As Long
Private Declare Function EnumChildWindows Lib "user32" (ByVal hWndParent As Long, 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 SendMessage Lib "user32" Alias "SendMessageA" (ByVal Hwnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Any) As Long
Private Const FIREFOX As String = "firefox"
Private Const OPERA As String = "opera"
Private Const IEXPLORER As String = "iexplore"
Private Const CHROME As String = "chrome"
Private Const NETCAPTOR As String = "netcaptor"
Private Const XCLASS_DATA As Long = &H2000
Private Const XTYP_REQUEST As Long = (&HB0 Or XCLASS_DATA)
Private Const CP_WINANSI As Long = 1004
Private Const CF_TEXT As Long = 1
Private Const WM_GETTEXT = &HD
Private Type WindowNavegador
Hwnd As Long
Class As String
End Type
Private WindowsNavegadores() As WindowNavegador
Public Function GetBrowserInfo(ByVal Hwnd As Long, Optional ByVal WinCaption As String) As String
On Error Resume Next
Dim lpData As Long, hData As Long, sData As String
Dim hServer As Long, hTopic As Long, hItem As Long
Dim hConv As Long, idInst As Long, sServer As String
Dim Ret As Long, i As Long
Dim sBuffer As String, CLASS_1 As String, CLASS_2 As String
If WinCaption = "" Then
sBuffer = String$(1024, Chr$(0))
SendMessage Hwnd, WM_GETTEXT, Len(sBuffer), sBuffer
WinCaption = Replace$(sBuffer, Chr$(0), "")
If WinCaption = "" Then Exit Function
End If
If InStr(1, LCase$(WinCaption), LCase$(CHROME)) <> 0 Then sServer = CHROME: CLASS_1 = "Chrome_OmniboxView": CLASS_2 = "Chrome_AutocompleteEditView"
If InStr(1, LCase$(WinCaption), LCase$(FIREFOX)) <> 0 Then sServer = FIREFOX
If InStr(1, LCase$(WinCaption), LCase$("INTERNET EXPLORER")) <> 0 Then sServer = IEXPLORER
If InStr(1, LCase$(WinCaption), LCase$(OPERA)) <> 0 Then sServer = OPERA
If InStr(1, LCase$(WinCaption), LCase$(NETCAPTOR)) <> 0 Then sServer = NETCAPTOR: CLASS_1 = "Edit": CLASS_2 = "Edit"
If sServer = "" Then Exit Function
If sServer = FIREFOX Or sServer = OPERA Or sServer = IEXPLORER Then
If DdeInitialize(idInst, 0, 0, 0) <> 0 Then Exit Function
hServer = DdeCreateStringHandle(idInst, sServer, CP_WINANSI)
hTopic = DdeCreateStringHandle(idInst, "WWW_GetWindowInfo", CP_WINANSI)
hItem = DdeCreateStringHandle(idInst, "0xFFFFFFFF", CP_WINANSI)
hConv = DdeConnect(idInst, hServer, hTopic, ByVal 0&)
If hConv Then
hData = DdeClientTransaction(0, 0, hConv, hItem, CF_TEXT, XTYP_REQUEST, 1000, 0)
lpData = DdeAccessData(hData, 500)
sBuffer = String$(500, Chr$(0))
lstrcpy sBuffer, lpData
GetBrowserInfo = Left$(sBuffer, InStr(sBuffer, Chr(0)) - 1)
DdeUnaccessData hData
DdeFreeDataHandle hData
DdeDisconnect hConv
End If
DdeFreeStringHandle idInst, hServer
DdeFreeStringHandle idInst, hTopic
DdeFreeStringHandle idInst, hItem
DdeUninitialize idInst
If GetBrowserInfo <> "" Then GetBrowserInfo = Split(GetBrowserInfo, ",")(0)
If Right$(GetBrowserInfo, 1) = """" Then GetBrowserInfo = Left$(GetBrowserInfo, Len(GetBrowserInfo) - 1)
If Left$(GetBrowserInfo, 1) = """" Then GetBrowserInfo = Right$(GetBrowserInfo, Len(GetBrowserInfo) - 1)
End If
If sServer = CHROME Or sServer = NETCAPTOR Then
ReDim WindowsNavegadores(0)
EnumChildWindows Hwnd, AddressOf EnumChildWndProc, 0&
sBuffer = String$(1024, Chr$(0))
For i = 1 To UBound(WindowsNavegadores)
If WindowsNavegadores(i).Class = CLASS_1 Or WindowsNavegadores(i).Class = CLASS_2 Then
SendMessage WindowsNavegadores(i).Hwnd, WM_GETTEXT, Len(sBuffer), sBuffer
GetBrowserInfo = Replace$(sBuffer, Chr$(0), "")
Exit Function
End If
Next i
End If
End Function
Public Function EnumChildWndProc(ByVal Hwnd As Long, ByVal lParam As Long) As Long
On Error Resume Next
Dim Ret As Long, sText As String * 255
ReDim Preserve WindowsNavegadores(UBound(WindowsNavegadores) + 1)
WindowsNavegadores(UBound(WindowsNavegadores)).Hwnd = Hwnd
Ret = GetClassName(Hwnd, sText, 255)
If Ret <> 0 Then
WindowsNavegadores(UBound(WindowsNavegadores)).Class = Left$(sText, Ret)
End If
EnumChildWndProc = 1
End Function