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

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??? :neurotico
Me canse de buscar y no encuentro nada... solo preguntas como esta :borracho:

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 :adios:

bueno este es el codigo que yo uso..

espero te sirva...

nos vemos..

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.

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 :borracho:

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

Saludos :adios:

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

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)
:-D

Saludos :adios:

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

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.

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

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

Saludos

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

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

El boton se llama co1?

El nombre no su caption

si se llama así

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

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

Saludos

mi email es

[email protected]

Si quieers agregame a tu MSN

Saludos

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

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