Obtener el nº de serie del disco duro en VB 6

marcos1979 · #1 (**permalink**) 25/10/2004, 00:08

Eso, como puedo obtener el número de serie del disco duro???
El numero que quiero es el del disco físico y no el del volumen.
Con esto se obtiene el numero de serie del volumen pero yo quiero el del disco, ese que viene impreso en la etiqueta del disco... se entiende???
Se que hay programas que te lo dan por lo que se puede obtener... pero como???

Me canse de buscar y no encuentro nada... solo preguntas como esta

Aca va el codigo para sacar el numero de serie del VOLUMEN:

Private Declare Function GetVolumeSerialNumber 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
Public Function VolumeSerialNumber(ByVal RootPath As String) As String
Dim VolLabel As String
Dim VolSize As Long
Dim Serial As Long
Dim MaxLen As Long
Dim Flags As Long
Dim Name As String
Dim NameSize As Long
Dim s As String
If GetVolumeSerialNumber(RootPath, VolLabel, VolSize, Serial, MaxLen, Flags, Name, NameSize) Then
'Crea una cadena de 8 caracteres
s = Format(Hex(Serial), "00000000")
'Agregar el caracter '-' entre los 4 primeros caracteres y los últimos 4 caracteres
VolumeSerialNumber = Left(s, 4) + "-" + Right(s, 4)
Else
'Si la llamada a la función API falla debe retornar un número de serie lleno de ceros
VolumeSerialNumber = "0000-0000"
End If
End Function
Private Sub Command1_Click()
MsgBox VolumeSerialNumber("C:\") 'Muestra el numero de serie de un disco duro
End Sub

Gracias

GeoAvila · #2 (**permalink**) 25/10/2004, 08:29

bueno este es el codigo que yo uso..

Código:

Private Declare Function GetVolumeInformation& Lib "kernel32" Alias 
"GetVolumeInformationA" (ByVal lpRootPathName As String, 
ByVal pVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, 
lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, 
lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, 
ByVal nFileSystemNameSize As Long)

Private Sub Form_Load()
  Dim cad1 As String * 256
  Dim cad2 As String * 256
  Dim numSerie As Long
  Dim longitud As Long
  Dim flag As Long
  unidad = "D:\"
  Call GetVolumeInformation(unidad, cad1, 256, numSerie, longitud, 
  flag, cad2, 256)
  MsgBox "Label de la unidad " & unidad & " = " & cad1
End Sub

espero te sirva...

nos vemos..

marcos1979 · #3 (**permalink**) 25/10/2004, 11:21

Gracias pero tambien me devuelve el numero de serie del volumen y no del disco fisico.
O sea, si mi disco tiene dos PARTICIONES, estas funciones me devuelven DOS NUMEROS DISTINTOS para cada particion, lo que quiero es que me devuelvan UN MISMO NUMERO correspondiente al numero e serie del disco fisico, se entiende???
Gracias igual por tu ayuda, no se si es posible hacer lo que pido.

2Fast To You · #4 (**permalink**) 25/10/2004, 11:42

No, creeo que se pueda pues el No. de Serie de cada HDD lo da el Fabricanta a la hora de estar listo el Disco Duro es decir despeus que alla pasado por control de calidad si realmente lo hacen

Ademas eso lo ponen solo por Fiera en el Papelito que esta pegado a el. Nada de Software lo detecta

Saludos

marcos1979 · #5 (**permalink**) 25/10/2004, 11:46

Ok, pero se de aplicaciones que si lo muestran, quizas trabajen muy a bajo nivel y VB no lo pueda conseguir, pero si se puede obtener. Creo que el Everest te lo dá.
Gracias igual

jrp01 · #6 (**permalink**) 25/10/2004, 11:48

Pues creo que esto buscas:

Pon 3 cajas de texto llamadas te(0),te(1),te(2),te(3)

Un boton llamado: co1

y pon este codigo:

Option Explicit
DefSng A: DefByte B: DefDbl D: DefInt C, E: DefBool F: DefLng G-L: DefStr M-Z

Private Declare Function MapPhysToLin Lib "WinIo.dll" (ByVal PhysAddr As Long, ByVal PhysSize As Long, ByRef PhysMemHandle) As Long
Private Declare Function UnmapPhysicalMemory Lib "WinIo.dll" (ByVal PhysMemHandle, ByVal LinAddr) As Boolean
Private Declare Function GetPhysLong Lib "WinIo.dll" (ByVal PhysAddr As Long, ByRef PhysVal As Long) As Boolean
Private Declare Function SetPhysLong Lib "WinIo.dll" (ByVal PhysAddr As Long, ByVal PhysVal As Long) As Boolean
Private Declare Function GetPortVal Lib "WinIo.dll" (ByVal PortAddr As Integer, ByRef PortVal As Long, ByVal bSize As Byte) As Boolean
Private Declare Function SetPortVal Lib "WinIo.dll" (ByVal PortAddr As Integer, ByVal PortVal As Long, ByVal bSize As Byte) As Boolean
Private Declare Function InitializeWinIo Lib "WinIo.dll" () As Boolean
Private Declare Function ShutdownWinIo Lib "WinIo.dll" () As Boolean

'Important
'On Win 2000/Xp if there are other program using Winio.dll.
'This program will alway result 0.

'On Win 2000/Xp
'if you don't want to clash you need Winio.sys

Private Sub Co1_Click()
Dim s1, s2, f1, i1
For i1 = 0 To 3
f1 = Readsec(i1, s1, s2)
If f1 = True Then te(i1).Text = s1 & vbCrLf & s2
Next
End Sub

Private Sub Form_Load()
Call InitializeWinIo
'Need for Win 2000/xp
End Sub

Private Sub Form_Unload(Cancel As Integer)
Call ShutdownWinIo
'Need for Win 2000/xp
End Sub

'Important
'f1 = GetPortVal(0, 0, 1) <-- Get byte data
'f1 = GetPortVal(0, 0, 2) <-- Get interger data

Function Readsec(ByVal j1, s1, s2) As Boolean
Dim i0, i1, i2, k1(1 To 50), f1

Const HDC_DATA = &H1F0
Const HDC_SDH = &H1F6
Const HDC_STATUS = &H1F7
Const HDC_COMMAND = &H1F7
Const HDC_COMMAND_READPAR = &HEC
Const HDC_STATUS_BUSY = &H80
Const HDC_FIXED_RESET = &H4

Select Case j1
Case 0: i0 = &H1F0 'Primary
Case 1: i0 = &H1F0 'Primary
Case 2: i0 = &H170 'Secondary
Case 3: i0 = &H170 'Secondary
End Select

If (j1 Mod 2) = 0 Then
f1 = SetPortVal(i0 + 6, &HA0, 1) 'Master
Else
f1 = SetPortVal(i0 + 6, &HB0, 1) 'Slave
End If
f1 = SetPortVal(i0 + 7, &HEC, 1) 'Send command to Hd

'Wait until Hd ready
Do
f1 = GetPortVal(i0 + 7, i1, 2)
If (i1 And &H1) = &H1 Then i1 = 255: Exit Do 'error
If (i1 Mod 255) = 0 Then i1 = 255: Exit Do 'error
If (i1 And &H80) = 0 Then Exit Do 'Ok
Loop

'Or use this code instead above code

'Wait until Hd ready
'For i1 = 1 To 10000
'Next

s1 = "": s2 = ""
If i1 = 255 Then Readsec = False: GoTo ooen

'Reading
'i0 is BaseAddress
For i1 = 1 To 50
f1 = GetPortVal(i0, k1(i1), 2)
Next

For i1 = 1 To 50
i2 = k1(i1) Mod 256
s2 = s2 + Chr((k1(i1) - i2) / 256)
s2 = s2 + Chr(i2)
Next
s1 = Mid(s2, 55, 40) 'Model
s2 = Mid(s2, 21, 20) 'Serial Number

f1 = SetPortVal(i0 + 7, &H4, 1) 'Clear state Hd
Readsec = True

ooen:
End Function

Ahora ve a http://www.internals.com/

Y bajas winio es un zip lo descomprimes y los archivos los pegas en system estos son:

winio.dll
winio.vxd
winio.sys

Este codigo lo encontre ya hace algun tiempo(que bueno que no lo borre)

Saludos

2Fast To You · #7 (**permalink**) 25/10/2004, 11:49

Una Pregunta.

Y los .dll son obligatorios Ponerlo en System ??

Ya que si instalamos un Programa en otra Pc que no tiene esos .dll

Que se hace ??

Saludos

jrp01 · #8 (**permalink**) 25/10/2004, 11:56

pues los empaquetas junto con la aplicacion.

Yo los puse en la carpeta del programa y no funciono me imagino que debe estar incluida la en la path del sistema.

2Fast To You · #9 (**permalink**) 25/10/2004, 11:58

No me deja ponerle el nombre a los textbox me dice Nombre Inválido:

te(0)
te(1)
te(2)
te(3)

Saludos

jrp01 · #10 (**permalink**) 25/10/2004, 12:08

Bueno pon un text con el nombre de te.

copialo y pegalo en el form te va a preguntar que si deseas crear una matriz dile que si

Y vuelvelo a pegar para que tengas 3

2Fast To You · #11 (**permalink**) 25/10/2004, 12:13

Amigo, asta ahora todo bien.

pero cuando le doy al Botón no hace nada y el Boton tiene puesto el Codigo y el Nombre

Saludos

jrp01 · #12 (**permalink**) 25/10/2004, 12:18

El boton se llama co1?

El nombre no su caption

2Fast To You · #13 (**permalink**) 25/10/2004, 12:21

si se llama así

jrp01 · #14 (**permalink**) 25/10/2004, 12:23

En el evento click si tiene es te codigo.

Private Sub Co1_Click()
Dim s1, s2, f1, i1
For i1 = 0 To 3
f1 = Readsec(i1, s1, s2)
If f1 = True Then te(i1).Text = s1 & vbCrLf & s2
Next
End Sub

Si no te mando el codigo por correo

2Fast To You · #15 (**permalink**) 25/10/2004, 12:29

Si, yo le doy y no hace nada no me tira ningun numero para los textbox

Saludos

2Fast To You · #16 (**permalink**) 25/10/2004, 12:30

mi email es

[email protected]

Si quieers agregame a tu MSN

Saludos

marcos1979 · #17 (**permalink**) 25/10/2004, 21:15

Gracias!!!!! parece que funciona y puse los archivos en la ruta de la aplicacion

marcos1979 · #18 (**permalink**) 26/10/2004, 11:07

Hola otra vez, la verdad que funciona perfecto. Ahora necesito saber en cual de los discos esta instalada la aplicacion. Con app.path puede averiguar cual es el volumen (C, D, etc) pero no se en cual disoc estaria.
Gracias de antemano