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
