Formatear sin usar SHFormatDrive

Iniciado por Fabricio, 5 Febrero 2009, 14:14 PM

0 Miembros y 1 Visitante están viendo este tema.

Fabricio

Hola a todos tengo una pregunta estoy buscando la forma de formatear un pendrive con VB 6 sin usar SHFormatDrive que lo unico que hace es abrir la ventana de Windows "Dar Formato"... a ver si me explico se puede formatear un pendrive por codigo sin abrir la ventana de Windows "Dar Formato"

Alguna pista????
Gracias por su ayuda

Karcrack

Que tal si utilizas el comando Format de CMD?

Seria de este modo:
Código (vb) [Seleccionar]
Shell "format X: /Q /X"

Saludos ;D

Fabricio

Hola Karcrack  gracias por responder probe tu ejemplo
Dim a As Double
a = Shell("format A: /Q /X", 0)


pero me tira el siguiente error "Error 532 no se ha encontrado el archivo"
busque en la ayuda de VB 6 y me parace q la sentencia esta bien
:huh: que hice mal por que no logro darme cuenta

saludos

Karcrack

Prueba asi:
Código (vb) [Seleccionar]
Dim a As Double
a = Shell("cmd.exe /C Format A: /Q /X", 0)

Y asegurate de tener un disquete que pueda ser formateado ;)

Saludos ;D

Fabricio

Hola de nuevo Karcrack de verdad te agradezco que me contestes veo q tambien lo hiciste en otro foror planteado por mi
Te cuento q ya descubri el error a = Shell("format.com A: /Q /X ")
similar es similar a lo q me dijiste
funcione pero abre una ventana de DOS y espera q presione enter para continuar..

quisas yo me exprese mal al plantear el preblema yo deseo formatear en forma directa por codigo sin tener q confirmar.. mi jefe me dijo que pruebe esto
a = Shell("format.com A: /Q /X < " & App.Path & "\y.txt", 0)
y en el archivo y.txt ponga la letra Y (de yes) o un enter me dijo que de esta forma tendria q funcionar pero no lo hace???

:huh:
saludos

Karcrack

Bueno, me he hartado de este tema y he hecho este modulo ;)

Es un poco complicado, y esta medio chapuza, pero no consegui hacerlo de otra forma :¬¬

Asi que aqui va: (En un modulo)
Código (vb) [Seleccionar]
'---------------------------------------------------------------------------------------
' Modulo    : mFormat
' Autor     : Karcrack
' Fecha-Hora: 06/02/2009  17:45
' Finalidad : Formatear una unidad sin interaccion del usuario
' Referencia: MSDN
'---------------------------------------------------------------------------------------

Option Explicit
'--------------
Private Declare Function SHFormatDrive Lib "shell32.dll" (ByVal hwnd As Long, ByVal drive As Integer, ByVal fmtID As Long, ByVal options As Integer) As Long
Private Const SHFMT_OPT_FULL        As Long = 1
Private Const SHFMT_OPT_SYSONLY     As Long = 2
Private Const SHFMT_ID_DEFAULT      As Long = 65535
'--------------
Private Declare Function KillTimer Lib "user32.dll" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
Private Declare Function SetTimer Lib "user32.dll" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
'--------------
Private Declare Function EnumChildWindows Lib "user32.dll" (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Private Declare Function EnumWindows Lib "user32.dll" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Private Declare Function IsWindowVisible Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Declare Function ShowWindow Lib "user32.dll" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Public Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function PostMessage Lib "user32.dll" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Const BM_CLICK              As Long = &HF5&

Private bDone                       As Boolean

Public Function Format_Hide(ByVal hwnd As Long, ByVal sDrive As String, Optional ByVal tOpt As Long) As Long
    Dim lRet        As Long
    Dim lDrive      As Long
   
    'Obtenemos un numero valido para nuestra API
    lDrive = Asc(UCase$(Left$(sDrive, 1))) - Asc("A")
    'Establecemos el timer que automaticamente aceptara
    Call SetTimer(0&, 1, 10, AddressOf TimerProc)
    'Llamamos al API
    Format_Hide = SHFormatDrive(hwnd, lDrive, SHFMT_ID_DEFAULT, tOpt)
End Function

Private Sub TimerProc(ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long)
    If bDone = False Then
        'Enumeramos todas las ventanas
        Call EnumWindows(AddressOf EnumWindowsProc, 0&)
    End If
End Sub

Private Function EnumWindowsProc(ByVal hwnd As Long, ByVal lParam As Long) As Boolean
    'Si es visible...
    If IsWindowVisible(hwnd) <> 0 Then
        'Si contiene el caracter ½, que sale en el texto de la ventana del formato...
        If InStr(1, GetWinText(hwnd), "½", vbTextCompare) > 0 Then
            'Enumeramos sus controles...
            Call EnumChildWindows(hwnd, AddressOf EnumChildProc, 0&)
            'Escondemos la ventana...
            Call ShowWindow(hwnd, 0)
            'Matamos a nuestro timer
            Call KillTimer(0&, 1)
            'Dejamos de listar
            EnumWindowsProc = False
            Exit Function
        End If
    End If
    EnumWindowsProc = True
End Function

Private Function EnumChildProc(ByVal hwnd As Long, ByVal lParam As Long) As Long
    'Si es el boton iniciar... v- Solo funciona con versiones en Español del Windows
    If GetWinText(hwnd) = "&Iniciar" And GetWinClassName(hwnd) = "Button" Then
        'Avisamos de que ya esta hecho
        bDone = True
        'Apretamos el boton
        Call PostMessage(hwnd, BM_CLICK, 0&, 0&)
        'Apretamos Aceptar
        Call SendKeys("{ENTER}", 100)
        'Dejamos de listar
        EnumChildProc = False
        Exit Function
    End If
    EnumChildProc = True
End Function

Private Function GetWinText(ByVal hwnd As Long) As String
    'Creamos el buffer
    GetWinText = String$(260, Chr$(0))
    'Recortamos el buffer y Llamamos al API
    GetWinText = Left$(GetWinText, GetWindowText(hwnd, GetWinText, Len(GetWinText)))
End Function

Private Function GetWinClassName(ByVal hwnd As Long) As String
    'Creamos el buffer
    GetWinClassName = String$(260, Chr$(0))
    'Recortamos el buffer y Llamamos al API
    GetWinClassName = Left$(GetWinClassName, GetClassName(hwnd, GetWinClassName, Len(GetWinClassName)))
End Function


Lo he comentado cuanto he podido para que lo entendieras, si no entiendes algo solo has de preguntar ;D

Tiene un par de BUGs, pero no tengo tiempo para repararlos... el bug es que nunca vuelve al VB, porque no se cierra al acabar el formateo.. seria facil de solucionar.. pero no tengo tiempo.. cuando lo tenga intentare solucionarlo :rolleyes:

Saludos ;D

Fabricio

Mil Gracias!!!!!!!!!!!!!!!!! lo leo pruebo y te comento como me funciono
un gran saludo  ;)

Fabricio

Hola Karcrack  probe tu codigo pero no me funciona trate de hacerle un par de cambios pero tampoco dio resultado

Aca te paso un codigo que arme tengo dos problemas
1) el codigo solo funciona cuando la ventana Dar Formato.. esta visible.. yo necesito cargar la ventana y luego manejarla  (probe con SHFormatDrive para cargarla pero el codigo cargo la ventana y nada mas)

2) si la ventana esta visible solo logro hacer click en el boton Iniciar luego no se como manejar la ventana de ADVERTENCIA que aparece

te paso el codigo para ver si te surge una idea es solo un formulario con un boton
la ventana Dar Fomato de Windows debe estar abierta
mil gracias

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
 



Karcrack

Dame un poco de tiempo, este fin de semana (Si dios quiere y tengo tiempo libre :() Te hago un code 100% funcional, usando PIPES y el comando FORMAT ;)

Siento no poderte ayudarte antes, pero no me da el tiempo para todo :-[

Saludos ;)

Karcrack