Dim rsEquipos As New ADODB.Recordset

rsEquipos.Open "SELECT * FROM EQUIPOS", gCnn, adOpenDynamic, adLockOptimistic
If Not (rsEquipos.BOF) And Not (rsEquipos.EOF) Then
    tdbgEquipos.DataSource = rsEquipos
    rsEquipos.MoveFirst
    Do While Not rsEquipos.EOF
        tdbgEquipos.Columns(0).DataField = rsEquipos(0)
        tdbgEquipos.Columns(1).DataField = rsEquipos(1)
        tdbgEquipos.Columns(2).DataField = Trim(rsEquipos(2))
        rsEquipos.MoveNext
    Loop
    tdbgEquipos.Refresh
End If
End Sub

MDIForm1.MaxButton = False 
MDIForm1.MinButton = False
MDIForm1.ControlBox = False

sql =
 "SELECT * FROM VistaLogIn"
dte1.cn1.Execute sql
TDBGridLog.ReOpen
TDBGridLog.Refresh

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

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

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