Mensajes

[EDIT:poner titulos descriptivos a los post !!!]

el frm tiene un listbox y dos botones detectar y extraer
el problema surge cuando inserto dos pendrives en ocasiones no muestra los datos en forma correcta o sea el ESN no coincide con la letra y el volumen
codigo del frm

NO LEAN ESTE CODGIGO LEAN EL SEGUNDO

Código [Seleccionar] Expandir



Option Explicit

Dim matriz_Volume(1 To 26, 1 To 26) As String
Dim matriz_ESN(1 To 26) As String


Private Sub cmdExtraer_Click()

If lst1.ListIndex > -1 Then

    EjectDevice (lst1.List(lst1.ListIndex))
    lst1.RemoveItem (lst1.ListIndex)
    lst1.Refresh
Else
    MsgBox "No hay dispositivos USB instalados"
End If


End Sub

Private Sub cmdDetectar_Click()

Call Dame_Unidad_USB
Call Numero_de_Serie
Call Mostrar

End Sub


Public Sub Numero_de_Serie()

    Dim Disco As Object
    Dim cadena As String
    Dim largo As Integer
    Dim contador As Integer
    Dim i As Integer
    Dim posicion As Integer
    Dim resultado As String
    Dim largo_Res As Integer
    Dim contador2 As Integer
    Dim j As Integer
    Dim posicion2 As Integer
    Dim ESN As String
    Dim k As Integer
   
    k = 1
With GetObject("WinMgmts:")

    For Each Disco In .InstancesOf("Win32_DiskDrive") ' 3 objetos 2 usb + ide
   
        If Disco.InterfaceType = "USB" Then ' detecto si son usb

            cadena = Disco.PNPDeviceID 'tiene embebido el ESN
           

            largo = Len(cadena)
            contador = 0
   
            For i = largo To 1 Step -1
       
                posicion = InStr(i, cadena, "\")
                contador = contador + 1
           
                If posicion > 0 Then
                    resultado = Right(cadena, contador - 1)
                    Exit For
               
                End If
            Next
   
            largo_Res = Len(resultado)
            contador2 = 0
       
            For j = largo_Res To 1 Step -1
                posicion2 = InStr(j, resultado, "&")
                contador2 = contador2 + 1
       
                If posicion2 > 0 Then
                    ESN = Left(resultado, largo_Res - contador2)     'resultado2 = Left(resultado, largo_Res - contador2)
                    matriz_ESN(k) = ESN
                    k = k + 1
                    'lst1.AddItem ESN
                    Exit For
                End If
       
            Next
       
    End If ' cierra el primer if el q detecta usb

    Next ' cierra el for q recorre los objetos

End With
       
End Sub



Public Sub Dame_Unidad_USB()

    Dim NumDisco As Integer
    Dim StrDisco As String
    Dim ret As Long
    Dim letra_Unidad As String
    Dim numero_Volume As Long
    Dim bandera As Boolean
    'Dim matriz_Volume(0 To 25, 0 To 25) As String
    Dim i As Integer
   
       
    lst1.Clear
   
    bandera = False
    i = 1
   
    For NumDisco = 0 To 25
       
        StrDisco = Chr(NumDisco + 65) & ":\"   'convierte  a char c/numero del bucle esta es la letra a verificar
        If NumDisco = 0 Then
            ret = GetDriveType(StrDisco)
        ElseIf NumDisco > 0 And GetDriveType(StrDisco) = 2 Then ' si pasa x este if se detecto un USB
            ret = 7
           
            letra_Unidad = StrDisco
            numero_Volume = GetVolumeNumber(StrDisco)    'obtengo el numero de volumen         'lESNUnidad = GetVolumeNumber(StrDisco)
            matriz_Volume(i, 1) = letra_Unidad
            matriz_Volume(i, 2) = Hex(numero_Volume)
            i = i + 1
            'MsgBox matriz_Volume(1, 1) & matriz_Volume(1, 2)
            'lst1.AddItem matriz_Volume(i, 1) & matriz_Volume(i, 2) & matriz_Volume(i, 3)
            'lst1.AddItem letra_Unidad & " " & Hex(numero_Volume)
           
            bandera = True
        ElseIf NumDisco > 0 And GetDriveType(StrDisco) <> 2 Then
            ret = GetDriveType(StrDisco)
        End If
    Next
   
    If bandera = False Then
        MsgBox "No hay dispositivos USB instalados"
    End If


End Sub

Public Sub Mostrar()
Dim i As Integer
For i = 1 To 26
    lst1.AddItem matriz_Volume(i, 1) & " " & matriz_ESN(i) & " " & matriz_Volume(i, 2)
Next
End Sub


Function GetVolumeNumber(strDrive As String) As Long ' obtengo el numero de volumen de la letra q le paso

Dim SerialNum As Long
Dim res As Long
Dim Temp1 As String
Dim Temp2 As String

Temp1 = String$(255, Chr$(0))
Temp2 = String$(255, Chr$(0))

res = GetVolumeInformation(strDrive, Temp1, _
Len(Temp1), SerialNum, 0, 0, Temp2, Len(Temp2))
GetVolumeNumber = SerialNum


End Function



codigo del modulo

Código [Seleccionar] Expandir


Option Explicit

Declare Function GetVolumeInformation Lib "kernel32.dll" Alias _
"GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal _
lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Integer, _
lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, _
lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal _
nFileSystemNameSize As Long) As Long

Public Declare Function GetLogicalDrives Lib "kernel32" () As Long
Public Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long




EDIT:poner titulos descriptivos a los post !!!

Deseo Expresar mi agradecimiento a Karcrack y a Dessa por haberme ayudado a resolver el problema que tenia
muchas gracias a los dos 

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

Código [Seleccionar] Expandir



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
 



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

Código [Seleccionar] Expandir


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
 




Hola a todos les cuento lo que qiero hacer para que puedas ayudarme... necesito formatear un pen drive con VB 6 sin interaccion del usuario tengo una idea de las apis que hay que usar pero como no se mucho de programacion se me complica

se me ocurrio manejar la ventana de windows Dar fomato pero no se como hacer para manejarla en forma oculta y apretar el boton iniciar poor codigo tambien voy a tener que apretar el boton aceptar cuando me pida confirmacion de que se van a borrar los datos 

pyeden ayudarme

muchas gracias su tu tiempo
saludos

Hola a todos el tema me parecio muy interesante... podrian explicar un poco mas sobre las funciones  FindWindows para obtener el Hwnd de la ventana y FindWindowsEx 

gracias saludos

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

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

Código [Seleccionar] Expandir

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

Código [Seleccionar] Expandir

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???


saludos

Hola a todos hace varios dias que trato de crear una función que haga lo siguiente:
cuando yo le paso como parametro la letra de cualquier unidad (la letra la cargo en un txt) me devuelva el tipo de dispositivo ej USB IDE SATA etc

ya busque informacion y tambien probe usar GetDriveType pero esto me devulbe si el dispositivo es fijo remobible etc

y tambien probe Win32_DiskDrive InterfaceType = "USB"  pero aca no le puedo pasar la letra como parametro

Alguna idea
PD NO quiero generar letras en forma automatica e ir comprobando

Gracias Saludos

Hola Karcrack  gracias por responder probe tu ejemplo

Código [Seleccionar] Expandir

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
que hice mal por que no logro darme cuenta

saludos