 Autor
|
Tema: Manejo de la ventana Dar Formato de Windows (Leído 3,152 veces)
|
Fabricio
 Desconectado
Mensajes: 115
|
Hola a todos estoy tratando de manejar la ventana Dar Formato de Windows desde VB 6 todo por codigo sin interaccion del usuario para formatear un pen drive pero tengo dos problemas 1) el codigo que tengo solo se ejecuta si la ventana Dar Formato esta abierta yo quiero cargarla desde codigo y luego manejarla probe con SHFormatDrive pero carga la ventana y el codigo no sigui su ejecucion 2) con la ventana visible solo logre controlar el boton Iniciar ... no se como controlar la ventana de ADVERTENCIA que aparece a continuacion Alguna ayuda  muchas gracias!!! les paso el codigo es un formulario y un boton
Option Explicit
' Funciòn APi para buscar Ventanas de Windows
Private Declare Function FindWindow _
Lib "user32" _
Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
(ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Integer
Private Declare Function ShowWindow _
Lib "user32" _
(ByVal hwnd As Long, _
ByVal nCmdShow As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" ( _
ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, _
ByVal bScan As Byte, _
ByVal dwFlags As Long, _
ByVal dwExtraInfo As Long)
'constantes para SHFormatDrive
Const SHFMT_ID_DEFAULT As Long = 65535
' constantes para las teclas
'Const keyeventf_keyup = &H2
Const KEYEVENTF_KEYUP = &H2
'Const keyeventf_extendedkey = &H1
Const KEYEVENTF_EXTENDEDKEY = &H1
Const VK_RETURN = &HD
Const NOMBRE_VENTANA = "Dar Formato Disco de 3½ (A:)"
'constantes para ShowWindow
Const SW_HIDE = 0
Const SW_SHOWNORMAL = 1
Const SW_SHOWMINIMIZED = 2
Const SW_MAXIMIZE = 3
Const SW_SHOWMAXIMIZED = 3
Const SW_SHOWNOACTIVATE = 4
Const SW_SHOW = 5
Const SW_MINIMIZE = 6
Const SW_SHOWMINNOACTIVE = 7
Const SW_SHOWNA = 8
Const SW_RESTORE = 9
Const SW_SHOWDEFAULT = 10
Const SW_MAX = 10
'constantes para SendMessage
Const BM_SETSTATE = &HF3
Const WM_LBUTTONDOWN = &H201 ' botón izquierdo abajo
Const WM_LBUTTONUP = &H202 ' izquierdo arriba
Const BM_CLICK = &HF5
Private Sub Comprobar(ventana As String)
Dim retorno As Long
Dim boton_iniciar As Long
Dim boton_cerrar As Long
Dim boton_aceptar As Long
Dim retorno2 As Long
' busca la ventana y retorna el Handle
retorno = FindWindow(vbNullString, ventana) ' aca detecta por el nombre de la ventana
boton_iniciar = FindWindowEx(retorno, 0, vbNullString, "&Iniciar") 'identifico el boton iniciar
boton_cerrar = FindWindowEx(retorno, 0, vbNullString, "&Cerrar") 'identifico boton cerrar
' simulo el click al boton
Call SendMessage(boton_iniciar, BM_CLICK, 0, 0)
Call SendMessage(boton_iniciar, BM_CLICK, 0, 0)
Call SendMessage(boton_iniciar, BM_SETSTATE, 0, ByVal 0&)
'esta parte del codigo no funciona
boton_aceptar = FindWindowEx(retorno, 0, vbNullString, "Aceptar") 'identifico boton aceptar
If boton_aceptar <> 0 Then
Call SendMessage(boton_aceptar, BM_CLICK, 0, 0)
Call SendMessage(boton_aceptar, BM_CLICK, 0, 0)
Call SendMessage(boton_aceptar, BM_SETSTATE, 0, ByVal 0&)
End If
End Sub
Private Sub Command1_Click()
' Para comprobar si está abierto el Internet explorer
Comprobar NOMBRE_VENTANA
End Sub
|
|
|
|
|
En línea
|
|
|
|
Dessa
Desconectado
Mensajes: 624
|
Hola fabricio, fijate si asi llegan los mensajes (PostMessage) la letra de la unidad en mayuscula Call SHFormatDrive(Me.hwnd, (Asc(" A:") - 65), 0&, 0&)
Option Explicit
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private 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
Private 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
Private Declare Function SHFormatDrive Lib "shell32" (ByVal hwnd As Long, ByVal Drive As Long, ByVal fmtID As Long, ByVal options As Long) As Long
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONUP = &H202
Private Sub Form_Load()
Timer1.Enabled = True
Timer2.Enabled = False
Timer1.Interval = 100
Timer2.Interval = 100
End Sub
Private Sub Command1_Click()
Call SHFormatDrive(Me.hwnd, (Asc("A:") - 65), 0&, 0&)
End Sub
Private Sub Timer1_Timer()
Dim Hwndl As Long
Hwndl = FindWindow("#32770", vbNullString)
Hwndl = FindWindowEx(Hwndl, 0, "Button", "&Iniciar")
If Hwndl <> 0 Then
Call PostMessage(Hwndl, WM_LBUTTONDOWN, 0, 0)
Call PostMessage(Hwndl, WM_LBUTTONDOWN, 0, 0)
Call PostMessage(Hwndl, WM_LBUTTONUP, 0, 0)
Timer1.Enabled = False
Timer2.Enabled = True
End If
End Sub
Private Sub Timer2_Timer()
Dim Hwndl As Long
Hwndl = FindWindow("#32770", vbNullString)
Hwndl = FindWindowEx(Hwndl, 0, "Button", "Aceptar")
If Hwndl <> 0 Then
Call PostMessage(Hwndl, WM_LBUTTONDOWN, 0, 0)
Call PostMessage(Hwndl, WM_LBUTTONDOWN, 0, 0)
Call PostMessage(Hwndl, WM_LBUTTONUP, 0, 0)
Timer2.Enabled = False
End
End If
End Sub
Saludos
|
|
|
|
|
En línea
|
Adrian Desanti
|
|
|
Krackwar ™
Desconectado
Mensajes: 100
|
Deja de postear como 3 veces cada post  |
|
|
|
|
En línea
|
WHK es mas u17r4m4573r31337 que yo  El error mas grande de el mundo es decir que el ser humano es inteligente. Facismo , antifacismo , etc.. la misma mie rda .. Soy el-> http://tinyurl.com/fantasma-de-krackwarmov ecx,1000 Etiqueta: invoke printf,"No Copiare en clases" loop Etiq
|
|
|
Dessa
Desconectado
Mensajes: 624
|
Para la unidades "discos removibles" proba con este code (estoy con Windows seven y no puedo probar mucho en XP) Agregá un combobox
Option Explicit
Private Declare Function GetLogicalDrives Lib "Kernel32" () As Long
Private Declare Function GetDriveType Lib "Kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Private Declare Function GetDiskFreeSpaceEx Lib "Kernel32" Alias "GetDiskFreeSpaceExA" (ByVal lpDirectoryName As String, lpFreeBytesAvailableToCaller As Currency, lpTotalNumberOfBytes As Currency, lpTotalNumberOfFreeBytes As Currency) As Long
Private Declare Function GetVolumeInformation Lib "Kernel32" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long
Private Sub Form_Load()
Dim LDs As Long, Cnt As Long, sDrives As String
Dim lpFreeBytesAvailableToCaller As Currency, TotalBytes As Currency, FreeBytes As Currency
Dim sistemaArchivos As String: sistemaArchivos = String$(255, Chr$(0))
Dim volumen As String: volumen = String$(255, Chr$(0))
Dim Nserie As Long
LDs = GetLogicalDrives
For Cnt = 0 To 25
If (LDs And 2 ^ Cnt) <> 0 Then
If GetDriveType(Chr$(65 + Cnt) + ":\") = 2 Then
sDrives = sDrives + " " + Chr$(65 + Cnt)
'MsgBox GetDriveType(Chr$(65 + Cnt) + ":\")
End If
End If
Next Cnt
'MsgBox Trim(sDrives)
Dim ssDrives() As String
ssDrives() = Split(Trim(sDrives), " ")
'MsgBox ssDrives(0)
'MsgBox ssDrives(1)
'MsgBox UBound(ssDrives)
If UBound(ssDrives) < 0 Then
MsgBox "No hay Ubidades extraibles"
'End 'Exit Sub
End If
Dim i As Long
For i = 0 To UBound(ssDrives)
Call GetDiskFreeSpaceEx(ssDrives(i) + ":\", lpFreeBytesAvailableToCaller, TotalBytes, FreeBytes)
Call GetVolumeInformation(ssDrives(i) + ":\", volumen, Len(volumen), Nserie, 0, 0, sistemaArchivos, Len(sistemaArchivos))
'MsgBox ssDrives(i) + ":\" & vbTab & Format(TotalBytes / 102400, "0.00") & " GB"
Combo1.AddItem (ssDrives(i) + ":\" & " " & Format(TotalBytes / 102400, "0.00") & " GB") & " " & Trim(volumen)
Next i
If Combo1.ListCount > 0 Then Combo1.ListIndex = 0
End Sub
|
|
|
|
« Última modificación: 12 Febrero 2009, 19:35 pm por Dessa »
|
En línea
|
Adrian Desanti
|
|
|
|
 |
