| |
|
81
|
Programación / Programación Visual Basic / ESN Pendrive
|
en: 11 Marzo 2009, 17:07 pm
|
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
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 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 !!! |
|
|
|
|
83
|
Programación / Programación Visual Basic / Manejo de la ventana Dar Formato de Windows
|
en: 12 Febrero 2009, 15:03 pm
|
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
|
|
|
|
|
84
|
Programación / Programación Visual Basic / Re: Formatear sin usar SHFormatDrive
|
en: 12 Febrero 2009, 14:54 pm
|
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
|
|
|
|
|
85
|
Programación / Programación Visual Basic / Re: Enviar Instrucciones a una ventana
|
en: 11 Febrero 2009, 13:17 pm
|
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 |
|
|
|
|
88
|
Programación / Programación Visual Basic / Re: Formatear sin usar SHFormatDrive
|
en: 6 Febrero 2009, 15:53 pm
|
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??? saludos |
|
|
|
|
89
|
Programación / Programación Visual Basic / Asociar letra de unidad con tipo de dispositivo
|
en: 6 Febrero 2009, 13:54 pm
|
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 |
|
|
|
|
90
|
Programación / Programación Visual Basic / Re: Formatear sin usar SHFormatDrive
|
en: 6 Febrero 2009, 13:45 pm
|
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 que hice mal por que no logro darme cuenta saludos |
|
|
|
|
|
| |
|
Mostrar Mensajes
