Gracias! Vaya que manojo de variaciones. Probaré algunas =)
Esta sección te permite ver todos los mensajes escritos por este usuario. Ten en cuenta que sólo puedes ver los mensajes escritos en zonas a las que tienes acceso en este momento.
Mostrar Mensajes MenúCita de: Yoghurt en 15 Noviembre 2012, 00:14 AM
Busca como puedes obtener una captura de la imagen del sector que quieres analizar, en VB6 yo usaba (si recuerdo bien y corriganme si me equivoco) getDIBits() para obtener los pixeles en un array de bits. Una vez tengas los pixeles te ayudo.
También puedes usar la api getPixel() pero es mas lento que usar la api getDIBits(). Suerte.
'
' mExplore
' Araon - 19/11/2012
'
Option Explicit
'declares para buscar ventanas y enviar mensajes
Declare Function GetActiveWindow Lib "user32" () As Long
Declare Function GetForegroundWindow Lib "user32" () As Long
Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hwnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
'declares para enviar texto y teclas
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Declare Function SendMessageByNum Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'declares para ejecutar el explorador en caso de no poder navegar
Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
'para esperar hasta que aparezca la barra de dirección (W7)
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
'declare para Ac Browser ¬¬
Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Const VK_F2 = &H71
Const VK_MENU = &H12
Const KEYEVENTF_KEYUP = &H2
'sendKeys "%({F2})" no funciona
Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
'
' La constante:
Const WM_CHAR = &H102
'Const WM_SYSCHAR = &H106
Const WM_COMMAND = &H111
'Const WM_SYSCOMMAND = &H112
Const WM_KEYUP = &H101
'Const WM_SYSKEYUP = &H105
Const WM_KEYDOWN = &H100
'Const WM_SYSKEYDOWN = &H104
Const WM_SETTEXT = &HC
Const WM_LBUTTONDOWN = &H201
Const WM_LBUTTONUP = &H202
'Const WM_RBUTTONDOWN = &H204
'Const WM_RBUTTONUP = &H205
' lParam para WM_SYSCOMMAND
'Const SC_CLOSE = &HF060&
'Const SC_MAXIMIZE = &HF030&
'Const SC_MINIMIZE = &HF020&
'Const SC_RESTORE = &HF120&
Private hwnd As Long
Sub Main()
Dim sPath As String
sPath = App.Path
If (Right$(sPath, 1) <> "\") Then sPath = sPath & "\"
Call go(sPath & App.EXEName)
End Sub
Public Sub go(ByVal sPath As String)
'NOTA: Cuidado con SendKeys puede interferir en otra ventana
' no relacionada con un explorer. Asegurarse primero de
' que se envia a la ventana correcta.
If goExplorerXP(sPath) Then Exit Sub 'solo con barra de direcciones
If goExplorerW7(sPath) Then Exit Sub
If goXYplorer(sPath) Then Exit Sub 'con o sin barra de direcciones OK
If goAcBrowser(sPath) Then Exit Sub 'no se puede desactivar la barra OK
If goCubicExplorer(sPath) Then Exit Sub 'con o sin barra de direcciones OK
If goA43(sPath) Then Exit Sub 'solo con barra de direcciones
If goTotalCommander(sPath) Then Exit Sub 'solo primer bloque de carpetas
'default
Call ShellExecute(0&, "open", "explorer", sPath, App.Path, vbNormalFocus)
End Sub
Function gethWnd() As Long
'obtiene el hWnd de la ventana que tiene el foco
'o la que tiene en el titulo el texto App.Path
'NOTA: Si se ejecuta en un Form usar GetParent()??
hwnd = 0
hwnd = GetActiveWindow()
If (hwnd = 0) Then hwnd = GetForegroundWindow()
'If (hwnd = 0) Then hwnd = FindWindow(vbNullString, App.Path)
'If (hwnd = 0) Then hwnd = FindWindow(vbNullString, Mid$(App.Path, InStrRev(App.Path, "\") + 1))
gethWnd = hwnd
End Function
'-------------------------------------------------------------------------------
' EXPLORER FUNCTIONS TO USE ACTUAL WINDOW EXPLORER
'-------------------------------------------------------------------------------
Function goExplorerXP(ByVal sPath As String) As Boolean
'explorer XP
Dim lRet As Long
hwnd = gethWnd()
If (hwnd <> 0) Then
lRet = FindWindowEx(hwnd, 0, "WorkerW", vbNullString)
If (lRet <> 0) Then lRet = FindWindowEx(lRet, 0, "ReBarWindow32", vbNullString) Else Exit Function
If (lRet <> 0) Then lRet = FindWindowEx(lRet, 0, "ComboBoxEx32", vbNullString) Else Exit Function
If (lRet <> 0) Then lRet = FindWindowEx(lRet, 0, "ComboBox", vbNullString) Else Exit Function
If (lRet <> 0) Then lRet = FindWindowEx(lRet, 0, "Edit", vbNullString) Else Exit Function
If (lRet <> 0) Then
Call SendMessage(lRet, WM_SETTEXT, 0, ByVal sPath)
Call PostMessage(lRet, WM_KEYDOWN, &HD&, ByVal &H1C0001)
SendKeys "{TAB}", True 'enviar el foco al "FolderView"
goExplorerXP = True
End If
End If
End Function
Function goExplorerW7(ByVal sPath As String) As Boolean
'explorer W7
Dim lRet As Long
hwnd = gethWnd()
If (hwnd <> 0) Then
lRet = FindWindowEx(hwnd, 0, "WorkerW", vbNullString)
If (lRet <> 0) Then lRet = FindWindowEx(lRet, 0, "ReBarWindow32", vbNullString) Else Exit Function
If (lRet <> 0) Then lRet = FindWindowEx(lRet, 0, "Address Band Root", vbNullString) Else Exit Function
'abrir la barra de direcciones
If (lRet <> 0) Then Call SendKeys("{F4}{F4}", True) Else Exit Function
If (lRet <> 0) Then lRet = FindWindowEx(lRet, 0, "msctls_progress32", vbNullString) Else Exit Function
If (lRet <> 0) Then lRet = FindWindowEx(lRet, 0, "ComboBoxEx32", vbNullString) Else Exit Function
If (lRet <> 0) Then
lRet = FindWindowEx(lRet, 0, "ComboBox", vbNullString)
If (lRet <> 0) Then lRet = FindWindowEx(lRet, 0, "Edit", vbNullString) Else Exit Function
If (lRet <> 0) Then
Call SendMessage(lRet, WM_SETTEXT, 0, ByVal sPath)
Call PostMessage(lRet, WM_KEYDOWN, &HD&, ByVal &H1C0001)
goExplorerW7 = True
End If
End If
End If
End Function
Function goXYplorer(ByVal sPath As String) As Boolean
'XYplorer v11.70.0100
Dim lRet As Long
hwnd = gethWnd()
If (hwnd <> 0) Then
lRet = FindWindowEx(hwnd, 0, "ThunderRT6PictureBoxDC", vbNullString)
If (lRet <> 0) Then
'XYplorer (debe buscar el edit)
Dim hwnd2 As Long
Do While (lRet <> 0)
lRet = FindWindowEx(lRet, 0, "Edit", vbNullString)
If (lRet <> 0) Then
Call SendMessage(lRet, WM_SETTEXT, 0, ByVal sPath)
Call PostMessage(lRet, WM_KEYDOWN, &HD&, ByVal &H1C0001)
goXYplorer = True
Else
lRet = FindWindowEx(hwnd, hwnd2, "ThunderRT6PictureBoxDC", vbNullString)
If (lRet <> 0) Then hwnd2 = lRet
End If
Loop
End If
End If
End Function
Function goAcBrowser(ByVal sPath As String) As Boolean
'AcBrowser Plus v4.13 sub version "a"
Dim lRet As Long, buff As String
hwnd = gethWnd()
'hwnd = GetForegroundWindow() 'AcBrowser usa MDI, obtener hWnd maestro
If (hwnd <> 0) Then
buff = String$(150, " ")
lRet = GetClassName(hwnd, buff, Len(buff))
buff = Left$(buff, lRet)
buff = Mid$(buff, 1, 13) & "b" & Mid$(buff, 15)
buff = Mid$(buff, 1, 31) & "6" & Mid$(buff, 33)
lRet = FindWindowEx(hwnd, 0, "MDIClient", vbNullString)
If (lRet <> 0) Then lRet = FindWindowEx(lRet, 0, buff, vbNullString) Else Exit Function
'hay que enviarle ALT+F2 para que aparezca le barra de direcciones
If (lRet <> 0) Then
'con SendKeys no funciona "%({F2})"
keybd_event VK_MENU, 0, 0, 0
keybd_event VK_F2, 0, 0, 0
keybd_event VK_F2, 0, KEYEVENTF_KEYUP, 0
keybd_event VK_MENU, 0, KEYEVENTF_KEYUP, 0
Else
Exit Function
End If
If (lRet <> 0) Then lRet = FindWindowEx(lRet, 0, "#32770", vbNullString) Else Exit Function
If (lRet <> 0) Then lRet = FindWindowEx(lRet, 0, "#32770", vbNullString) Else Exit Function
If (lRet <> 0) Then lRet = FindWindowEx(lRet, 0, "ComboBoxEx32", vbNullString) Else Exit Function
If (lRet <> 0) Then lRet = FindWindowEx(lRet, 0, "ComboBox", vbNullString) Else Exit Function
If (lRet <> 0) Then lRet = FindWindowEx(lRet, 0, "Edit", vbNullString) Else Exit Function
If (lRet <> 0) Then
Call SendMessage(lRet, WM_SETTEXT, 0, ByVal sPath)
Call PostMessage(lRet, WM_KEYDOWN, &HD&, ByVal &H1C0001)
Call PostMessage(lRet, WM_KEYUP, &HD&, ByVal &H1C0001)
goAcBrowser = True
End If
End If
End Function
Function goTotalCommander(ByVal sPath As String) As Boolean
'TotalCommander v8.01
' * solo soporta un lado de las carpetas (IZQ). Mal uso de Sleep
' una fea forma de acceder.
Dim lRet As Long
hwnd = gethWnd()
If (hwnd <> 0) Then
lRet = FindWindowEx(hwnd, 0, "TMyPanel", vbNullString)
If (lRet <> 0) Then
'TotalCommander (debe buscar el edit)
Dim hwnd2 As Long
Do While (lRet <> 0)
lRet = FindWindowEx(lRet, 0, "TPathPanel", vbNullString)
If (lRet <> 0) Then
Call PostMessage(lRet, WM_LBUTTONDOWN, &H1&, ByVal &H80166)
Call PostMessage(lRet, WM_LBUTTONUP, &H0&, ByVal &H80166)
Sleep 1000&
lRet = FindWindowEx(lRet, 0, "TInEdit", vbNullString)
If (lRet <> 0) Then
Call SendMessage(lRet, WM_SETTEXT, 0, ByVal sPath)
Call PostMessage(lRet, WM_KEYDOWN, &HD&, ByVal &H1C0001)
goTotalCommander = True
Exit Function
End If
Else
lRet = FindWindowEx(hwnd, hwnd2, "TMyPanel", vbNullString)
If (lRet <> 0) Then hwnd2 = lRet
End If
Loop
End If
End If
End Function
Function goA43(ByVal sPath As String) As Boolean
'A43 v3.30
Dim lRet As Long
hwnd = gethWnd()
If (hwnd <> 0) Then
lRet = FindWindowEx(hwnd, 0, "TPanel", vbNullString)
If (lRet <> 0) Then lRet = FindWindowEx(hwnd, lRet, "TPanel", vbNullString) Else Exit Function
If (lRet <> 0) Then lRet = FindWindowEx(lRet, 0, "TPTSplitter", vbNullString) Else Exit Function
If (lRet <> 0) Then
'A43 Explorer
lRet = FindWindowEx(lRet, 0, "TPTPane", vbNullString)
If (lRet <> 0) Then lRet = FindWindowEx(lRet, 0, "TJamShellCombo", vbNullString) Else Exit Function
If (lRet <> 0) Then lRet = FindWindowEx(lRet, 0, "TEdit", vbNullString) Else Exit Function
If (lRet <> 0) Then
Call SendMessage(lRet, WM_SETTEXT, 0, ByVal sPath)
Call PostMessage(lRet, WM_KEYDOWN, &HD&, ByVal &H1C0001)
goA43 = True
Else
'A43 sin barra de direcciones
'activar barra
'SendKeys "%(V{DOWN}~)", True 'SenKeys y keybd_event FALLAN
End If
End If
End If
End Function
Function goCubicExplorer(ByVal sPath As String) As Boolean
'CubicExplorer v0.95.1.1494
Dim lRet As Long
hwnd = gethWnd()
If (hwnd <> 0) Then
lRet = FindWindowEx(hwnd, 0, "TSpTBXDock", vbNullString)
If (lRet <> 0) Then lRet = FindWindowEx(lRet, 0, "TCEAddressBarToolbar.UnicodeClass", vbNullString) Else Exit Function
If (lRet <> 0) Then lRet = FindWindowEx(lRet, 0, "TCEAddressBar", vbNullString) Else Exit Function
If (lRet <> 0) Then lRet = FindWindowEx(lRet, 0, "TCE_AMemo.UnicodeClass", vbNullString) Else Exit Function
If (lRet <> 0) Then
Call SendMessage(lRet, WM_SETTEXT, 0, ByVal sPath)
Call PostMessage(lRet, WM_KEYDOWN, &HD&, ByVal &H1C0001)
goCubicExplorer = True
End If
End If
End Function
Private Declare Function ProcessFirst Lib "kernel32" Alias "Process32First" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function ProcessNext Lib "kernel32" Alias "Process32Next" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function CreateToolhelpSnapshot Lib "kernel32" Alias "CreateToolhelp32Snapshot" (ByVal lFlags As Long, lProcessID As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Const MAX_PATH = 260
Private Type PROCESSENTRY32
dwSize As Long
cntUsage As Long
th32ProcessID As Long
th32DefaultHeapID As Long
th32ModuleID As Long
cntThreads As Long
th32ParentProcessID As Long
pcPriClassBase As Long
dwFlags As Long
szexeFile As String * MAX_PATH
End Type
Public Sub appList()
Const PROCESS_ALL_ACCESS = 0
Dim uProcess As PROCESSENTRY32
Dim rProcessFound As Long
Dim hSnapshot As Long
Dim szExename As String
Dim exitCode As Long
Dim myProcess As Long
Dim AppKill As Boolean
Dim appCount As Integer
Dim i As Integer
On Local Error GoTo Finish
appCount = 0
Const TH32CS_SNAPPROCESS As Long = 2&
uProcess.dwSize = Len(uProcess)
hSnapshot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0&)
rProcessFound = ProcessFirst(hSnapshot, uProcess)
Do While rProcessFound
i = InStr(1, uProcess.szexeFile, Chr(0))
szExename = LCase$(Left$(uProcess.szexeFile, i - 1))
List1.AddItem szExename
rProcessFound = ProcessNext(hSnapshot, uProcess)
Loop
Call CloseHandle(hSnapshot)
Finish:
End Sub
Private Sub Form_Load()
appList
End Sub
Cita de: alembuy en 14 Noviembre 2012, 05:37 AMGracias buen buscador de archivos ^^ que por cierto no me tomó mi microSD (C:\) y lo extraño es que sí me tomó mis 2 unidades virtuales (X:\ y B:\) que son RamDisk.
explorer de windows, pero bajate el Everything
http://www.voidtools.com/Everything-1.2.1.371.exe
http://www.voidtools.com/Everything.lng.exe
Cita de: drvy | BSM en 13 Noviembre 2012, 18:57 PMGracias, aunque no pude hacerlo compatible por el método común o no invasivo asi que requerirá mas tiempo. Alguien usa otro Explorador de Archivos?
Yo solía utilizar Total Commander. ::http://www.ghisler.com/