Acceso a sectores desde VB

[wyxchari]

Saludos a todos.

Estoy interesado en hacer un programa en VB para leer sectores de un pendrive que está como unidad G: . He leido muchísimo por Google, por foros, en inglés y español, pero no se encuentra casi nada. Hasta aquí llego. Creo que me falla algo en el copymemory o similar.

¿Podría alguien ayudarme a seguir? Sólo me falta una línea.

Me defiendo bastante bien con la APIs pero nunca he entendido del todo el puto copymemory, los buffers y los byval.

Gracias de antemano.


Private Declare Function CreateFile Lib "kernel32" _
Alias "CreateFileA" _
(ByVal lpFileName As String, _
ByVal dwDesiredAccess As Long, _
ByVal dwShareMode As Long, _
ByVal lpSecurityAttributes As Any, _
ByVal dwCreationDisposition As Long, _
ByVal dwFlagsAndAttributes As Long, _
ByVal hTemplateFile As Long) As Long

Private Declare Function SetFilePointer Lib "kernel32" _
(ByVal hFile As Long, _
ByVal lDistanceToMove As Long, _
lpDistanceToMoveHigh As Long, _
ByVal dwMoveMethod As Long) As Long

Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
(Destination As Any, _
Source As Any, _
ByVal Length As Long)

Private Declare Function ReadFile Lib "kernel32" _
(ByVal hFile As Long, _
lpBuffer As Any, _
ByVal nNumberOfBytesToRead As Long, _
lpNumberOfBytesRead As Long, _
lpOverlapped As Long) As Long

Private Declare Function WriteFile Lib "kernel32" _
(ByVal hFile As Long, _
lpBuffer As Any, _
ByVal nNumberOfBytesToWrite As Long, _
lpNumberOfBytesWritten As Long, _
lpOverlapped As Long) As Long

Private Declare Function CloseHandle Lib "kernel32" _
(ByVal hObject As Long) As Long

Private Sub Form_Activate()

Dim ret As Long
Dim espacio As String * 512

hDevice = CreateFile("\\.\G:", &HC0000000, 3, 0&, 3, 0&, 0&)
Print "Handle "; hDevice
If hDevice = -1 Then GoTo sale

inicio = 0
q = SetFilePointer(hDevice, inicio, 0&, 0&)
Print "Pointer "; q
If q <> inicio Then GoTo error

q = ReadFile(hDevice, ByVal espacio, 512, ret, ByVal 0&)
Print "Bytes leidos "; ret
If ret = 0 Then GoTo error

'CopyMemory ByVal ss(0), ByVal espacio, 512

GoTo sale
error:
CloseHandle hDevice
sale:
End Sub

[wyxchari]

Weno, lo arreglé solito sin poner copymemory ni nada.
Ya no hace falta que me respondáis.
Chao.

Estructura básica en VisualBasic para leer un sector pasado en variable sector:
Private Declare Function CreateFile Lib "kernel32" _
Alias "CreateFileA" _
(ByVal lpFileName As String, _
ByVal dwDesiredAccess As Long, _
ByVal dwShareMode As Long, _
ByVal lpSecurityAttributes As Any, _
ByVal dwCreationDisposition As Long, _
ByVal dwFlagsAndAttributes As Long, _
ByVal hTemplateFile As Long) As Long

Private Declare Function SetFilePointer Lib "kernel32" _
(ByVal hFile As Long, _
ByVal lDistanceToMove As Long, _
lpDistanceToMoveHigh As Long, _
ByVal dwMoveMethod As Long) As Long

Private Declare Function ReadFile Lib "kernel32" _
(ByVal hFile As Long, _
lpBuffer As Any, _
ByVal nNumberOfBytesToRead As Long, _
lpNumberOfBytesRead As Long, _
lpOverlapped As Long) As Long

Dim q As Long 'temporal
Dim q2 As Double 'temporal
Dim hdevice As Long 'identificador de la unidad abierta
Dim espa As String * 512 'cadena lectura o grabación
Dim ret As Long 'bytes leidos o grabados
Dim sector As double 'sector desplazamiento desde inicio unidad
Dim byt As Long 'bytes de desplazamiento desde inicio unidad
Dim byt2 As Long 'bytes de desplazamiento2 desde inicio unidad

Private Sub Form_Activate()
hdevice = CreateFile("\\.\D:, &HC0000000, 3, 0&, 3, 0&, 0&)
sector=0 'Sector a leer
q2 = sector * 512#
byt2 = Fix(q2 / 4294967296#)
byt = q2 - byt2 * 4294967296#
q = SetFilePointer(hdevice, byt, byt2, 0&)
If q <> byt Then goto error
ReadFile hdevice, ByVal espa, 512, ret, ByVal 0&
If ret <> 512 Then GoTo error
'Salida del sector en variable de cadena: espa
End sub

[David]

Iniciado por wyxchari

Weno, lo arreglé solito sin poner copymemory ni nada.
Ya no hace falta que me respondáis.
Chao.

¿Podrías explicarnos cómo lo has solucionado?. Así, podrá ser de utilidad si otros usuarios llegan con la misma duda.
Gracias.

[wyxchari]

Os dejo el procedimiento. Pero ya lo tengo muy desarrollado.

Busca y marca clusters defectuosos en unidades FAT12 (disquetes), FAT (o FAT16, pendrives, discos duros pequeños) y FAT32 (discos duros grandes).

Sólo busca clusters defectuosos en NTFS. No los marca. Estoy en el tema de marcar. Aunque siempre queda la posiblilidad de formatear a FAT32, buscar y marcar clusters defectuosos y luego convertir a NTFS poniendo: convert u: /fs:NTFS. Los clusters defectuosos cambian de número pero la posición exacta en el disco sigue siendo la misma.

Se trata de grabar clusters a la unidad y luego leerlos comprobando que existe lo que se grabó originalmente. La grabación se hace originando una cadena aleatoria del tamaño de cluster.

La finalidad es comprobar el estado de la unidad (disco duro, pendrive, disquete...) y marcar los clusters defectuosos.

Consejo: si no entiendes el código, no lo uses, puedes joder algún disco.
------------------------------------------------------------------------
Aunque no borra los datos de la unidad, haz antes una copia de seguridad, pero recomiendo:
¡¡¡¡¡¡ NO LO USES NUNCA SOBRE EL DISCO C: O EL DEL SISTEMA !!!!!!!!!!!
-------------------------------------------------------------------------
Puede darse el caso de que mientras se graba sobre zonas del sistema, éste acceda a las mismas zonas y encuentre datos corruptos, o que el sistema aborte el programa por acceso a zonas del disco protegidas.

La unidad de trabajo se elige directamente editando el código para evitar errores y joder la unidad C:.
Usa 1 CommandButton, 3 Label, 1 ListBox, 2 OptionButton, 2 TextBox y 1 Timer.
Esta hecho en VisualBasic 5.0. Sólo hay que copiar y pegar. Funciona a la primera, sin hacer ajustes de codigo de declaraciones, ni librerías, etc... para reconvertir código de otros lenguajes a VB. No borres ninguna apóstrofe de marca de comentario (').

[David]

Gracias por tu aportación, quizás como te dije en un futuro sea de utilidad a algún usuario con la misma dudad...

[wyxchari]

Option Explicit

Private Declare Function CreateFile Lib "kernel32" _
Alias "CreateFileA" _
(ByVal lpFileName As String, _
ByVal dwDesiredAccess As Long, _
ByVal dwShareMode As Long, _
ByVal lpSecurityAttributes As Any, _
ByVal dwCreationDisposition As Long, _
ByVal dwFlagsAndAttributes As Long, _
ByVal hTemplateFile As Long) As Long

Private Declare Function SetFilePointer Lib "kernel32" _
(ByVal hFile As Long, _
ByVal lDistanceToMove As Long, _
lpDistanceToMoveHigh As Long, _
ByVal dwMoveMethod As Long) As Long

Private Declare Function ReadFile Lib "kernel32" _
(ByVal hFile As Long, _
lpBuffer As Any, _
ByVal nNumberOfBytesToRead As Long, _
lpNumberOfBytesRead As Long, _
lpOverlapped As Long) As Long

Private Declare Function WriteFile Lib "kernel32" _
(ByVal hFile As Long, _
lpBuffer As Any, _
ByVal nNumberOfBytesToWrite As Long, _
lpNumberOfBytesWritten As Long, _
lpOverlapped As Long) As Long

Private Declare Function CloseHandle Lib "kernel32" _
(ByVal hObject As Long) As Long

Dim acc As Long 'flag de estar trabajando
Dim linea As String 'nueva linea
Dim q As Long 'temporal

Dim conta As Long 'contador de segundos
Dim qqa As Double, qqb As Double 'cálculos del timer
Dim qqcade As String 'unidades del timer

Dim hdevice As Long 'identificador de la unidad abierta
Const cbxc = 32768 'buffer de cadena para lectura o grabación
Dim espa As String * cbxc 'cadena lectura o grabación
Dim cadeo As String 'cadena original
Dim cadeg As String 'cadena grabar
Dim cadele As String 'cadema leída
Dim ret As Long 'bytes leidos o grabados

Dim tfat As String 'tipo de fat
Dim bxs As Double 'bytes por sector
Dim sxc As Double 'sectores por cluster
Dim bxc As Double 'bytes por cluster
Dim sxf As Double 'sectores por fat
Dim res As Double 'sectores reservados
Dim scd As Double 'primer sector de datos
Dim mft As Double 'cluster inicio MFT
Dim mftm As Double 'cluster inicio MFT mirror
Dim stt As Double 'sectores totales

Dim cluster As Double 'cluster actual
Dim cluini As Double 'cluster inicial
Dim clufin As Double 'cluster final
Dim byt As Long 'bytes de desplazamiento desde inicio unidad
Dim byt2 As Long 'bytes de desplazamiento2 desde inicio unidad
Dim q2 As Double 'temporal de byt
Dim nfat As Double 'sectores de desplazamiento de FAT para FAT1 y FAT2
Dim des As Double 'bytes de desplazamiento dentro de FAT
Const unidad = "G:" ' Unidad lógica del disco a abrir <<--------------------

[wyxchari]

Private Sub Form_Activate()
Randomize
linea = Chr(13) + Chr(10)
Label1.Caption = "Unidad: " & unidad & linea
'Abrir disco
hdevice = CreateFile("\\.\" & unidad, &HC0000000, 3, 0&, 3, 0&, 0&)
If hdevice = -1 Then MsgBox "Error abriendo disco": End
'Leer boot
q = SetFilePointer(hdevice, 0&, 0&, 0&)
If q <> 0 Then MsgBox "Error pointer Boot": sale
ReadFile hdevice, ByVal espa, 512, ret, ByVal 0&
If ret <> 512 Then MsgBox "Error leyendo Boot": sale
'Disco formateado
If Mid(espa, &H1FF, 2) <> (Chr(&H55) + Chr(&HAA)) Then MsgBox "Unidad sin formato": sale
'Tipo FAT
tfat = Mid(espa, &H37, 5): If tfat = "FAT12" Then GoTo buenafat
tfat = Mid(espa, &H37, 5): If tfat = "FAT16" Then GoTo buenafat
tfat = Mid(espa, &H53, 5): If tfat = "FAT32" Then GoTo buenafat
tfat = Mid(espa, &H4, 4): If tfat = "NTFS" Then GoTo buenafat
MsgBox "Error: FAT no soportada": sale
'Cálculo punteros
buenafat:
Label1.Caption = Label1.Caption & "Tipo de FAT: " & tfat & linea

bxs = Asc(Mid(espa, &HC, 1)) + 256# * Asc(Mid(espa, &HD, 1))
Label1.Caption = Label1.Caption & "Bytes por sector: " & bxs & linea

sxc = Asc(Mid(espa, &HE, 1))
Label1.Caption = Label1.Caption & "Sectores por cluster: " & sxc & linea

bxc = sxc * bxs
Label1.Caption = Label1.Caption & "Bytes por cluster: " & bxc & linea
If bxc > cbxc Then MsgBox "Se soporta hasta 32768 bytes por cluster": sale

If tfat <> "NTFS" Then
If tfat = "FAT12" Or tfat = "FAT16" Then sxf = Asc(Mid(espa, &H17, 1)) + 256# * Asc(Mid(espa, &H18, 1))
If tfat = "FAT32" Then sxf = Asc(Mid(espa, &H25, 1)) + 256# * Asc(Mid(espa, &H26, 1)) + 256# ^ 2 * Asc(Mid(espa, &H27, 1)) + 256# ^ 3 * Asc(Mid(espa, &H28, 1))
Label1.Caption = Label1.Caption & "Sectores por FAT: " & sxf & linea
End If

res = Asc(Mid(espa, &HF, 1)) + 256# * Asc(Mid(espa, &H10, 1))
Label1.Caption = Label1.Caption & "Sectores reservados: " & res & linea

If tfat = "FAT12" Then scd = res + 2# * sxf + (Asc(Mid(espa, &H12, 1)) + 256# * Asc(Mid(espa, &H13, 1))) * 32# / bxs
If tfat = "FAT16" Or tfat = "FAT32" Then scd = res + 2# * sxf + sxc
If tfat = "NTFS" Then scd = 0
Label1.Caption = Label1.Caption & "Primer sector de datos: " & scd & linea

If tfat = "FAT12" Or tfat = "FAT16" Then cluini = 2
If tfat = "FAT32" Then cluini = 3
If tfat = "NTFS" Then cluini = 0
Label1.Caption = Label1.Caption & "Primer cluster de datos: " & cluini & linea

If tfat = "NTFS" Then
mft = Asc(Mid(espa, &H31, 1)) + 256# * Asc(Mid(espa, &H32, 1)) + 256# ^ 2 * Asc(Mid(espa, &H33, 1)) + 256# ^ 3 * Asc(Mid(espa, &H34, 1)) + 256# ^ 4 * Asc(Mid(espa, &H35, 1)) + 256# ^ 5 * Asc(Mid(espa, &H36, 1)) + 256# ^ 6 * Asc(Mid(espa, &H37, 1)) + 256# ^ 7 * Asc(Mid(espa, &H38, 1))
Label1.Caption = Label1.Caption & "Cluster inicio MFT: " & mft & cadeg
mftm = Asc(Mid(espa, &H39, 1)) + 256# * Asc(Mid(espa, &H3A, 1)) + 256# ^ 2 * Asc(Mid(espa, &H3B, 1)) + 256# ^ 3 * Asc(Mid(espa, &H3C, 1)) + 256# ^ 4 * Asc(Mid(espa, &H3D, 1)) + 256# ^ 5 * Asc(Mid(espa, &H3E, 1)) + 256# ^ 6 * Asc(Mid(espa, &H3F, 1)) + 256# ^ 7 * Asc(Mid(espa, &H40, 1))
Label1.Caption = Label1.Caption & "Cluster inicio MFTmirror: " & mftm & linea
End If

If tfat = "FAT12" Then stt = Asc(Mid(espa, &H14, 1)) + 256# * Asc(Mid(espa, &H15, 1))
If tfat = "FAT16" Or tfat = "FAT32" Then stt = Asc(Mid(espa, &H21, 1)) + 256# * Asc(Mid(espa, &H22, 1)) + 256# ^ 2 * Asc(Mid(espa, &H23, 1)) + 256# ^ 3 * Asc(Mid(espa, &H24, 1))
If tfat = "NTFS" Then stt = Asc(Mid(espa, &H29, 1)) + 256# * Asc(Mid(espa, &H2A, 1)) + 256# ^ 2 * Asc(Mid(espa, &H2B, 1)) + 256# ^ 3 * Asc(Mid(espa, &H2C, 1)) + 256# ^ 4 * Asc(Mid(espa, &H2D, 1)) + 256# ^ 5 * Asc(Mid(espa, &H2E, 1)) + 256# ^ 6 * Asc(Mid(espa, &H2F, 1)) + 256# ^ 7 * Asc(Mid(espa, &H30, 1))
Label1.Caption = Label1.Caption & "Sectores totales: " & stt & linea

q = stt / 1048576# * bxs
cadeo = "Mb": If q > 1024# Then cadeo = "Gb": q = q / 1024#
q = Fix(q): Label1.Caption = Label1.Caption & "Tamaño en " & cadeo & ": " & q & linea

If tfat <> "NTFS" Then
clufin = Fix((stt - scd) / sxc) + 1
Else
clufin = Fix(stt / sxc) - 1
End If
Label1.Caption = Label1.Caption & "Último cluster: " & clufin & linea

Text1.Text = cluini: Text2.Text = clufin
End Sub
Private Sub hace()
If Text1.Text < cluini Or Text1.Text > clufin Then MsgBox "Error cluster inicial": GoTo final
If Text2.Text < cluini Or Text2.Text > clufin Then MsgBox "Error cluster final": GoTo final

otravuelta:
'Prepara cadena aleatoria
cadeg = ""
For q = 1 To bxc
cadeg = cadeg + Chr(Fix(Rnd * 256))
Next q

acc = 0
conta = 0
cluster = Text1.Text
Timer1_Timer
Timer1.Enabled = True

'Bucle
For cluster = Text1.Text To Text2.Text
q2 = (scd + (cluster - cluini) * sxc) * bxs
byt2 = Fix(q2 / 4294967296#)
byt = q2 - byt2 * 4294967296#

'Lee original
q = SetFilePointer(hdevice, byt, byt2, 0&)
If q <> byt Then MsgBox "Error pointer leyendo original": sale
ReadFile hdevice, ByVal espa, bxc, ret, ByVal 0&
If ret <> bxc Then GoTo marcar
cadeo = espa
If Option1.Value Then GoTo otroclu
'Graba aleatorio
espa = cadeg
q = SetFilePointer(hdevice, byt, byt2, 0&)
If q <> byt Then MsgBox "Error pointer grabando aleatorio": sale
WriteFile hdevice, ByVal espa, bxc, ret, ByVal 0&
If ret <> bxc Then GoTo marcar
'Lee aleatorio
q = SetFilePointer(hdevice, byt, byt2, 0&)
If q <> byt Then MsgBox "Error pointer leyendo aleatorio": sale
ReadFile hdevice, ByVal espa, bxc, ret, ByVal 0&
If ret <> bxc Then GoTo marcar
cadele = espa
'Graba original
espa = cadeo
q = SetFilePointer(hdevice, byt, byt2, 0&)
If q <> byt Then MsgBox "Error pointer grabando original": sale
WriteFile hdevice, ByVal espa, bxc, ret, ByVal 0&
If ret <> bxc Then GoTo marcar

If Left(cadele, bxc) = cadeg Then GoTo otroclu
'------------------------------------------------------------------------------------
'Marcar cluster defectuoso
marcar:
List1.AddItem cluster
If tfat = "NTFS" Then GoTo otroclu
nfat = 0
GoSub gfat
nfat = sxf
GoSub gfat

otroclu:
DoEvents
If acc Then GoTo final
Next cluster
conta = 0
GoTo otravuelta
'------------------------------------------------------------------------------------
'Marcar defectuoso en FAT
gfat:
If tfat = "FAT12" Then q = cluster * 3# / 2#
If tfat = "FAT16" Then q = cluster * 2#
If tfat = "FAT32" Then q = cluster * 4#
des = q Mod bxs
q2 = (res + nfat + Fix(q / bxs)) * bxs
byt2 = Fix(q2 / 4294967296#)
byt = q2 - byt2 * 4294967296#
q = SetFilePointer(hdevice, byt, byt2, 0&)
If q <> byt Then MsgBox "Error pointer leyendo FAT": sale
ReadFile hdevice, ByVal espa, bxs, ret, ByVal 0&
If ret <> bxs Then MsgBox "Error leyendo FAT": sale
cadeo = espa

cadeg = Left(cadeo, des)
If tfat = "FAT12" Then
q = cluster Mod 2
If q Then 'impar
cadeg = cadeg + Chr((Asc(Mid(cadeo, des + 1, 1)) And &HF) Or &H70) + Chr(&HFF)
cadeg = cadeg + Mid(cadeo, des + 3, bxs - des - 2)
Else 'par
cadeg = cadeg + Chr(&HF7) + Chr(Asc(Mid(cadeo, des + 2, 1)) Or &HF)
cadeg = cadeg + Mid(cadeo, des + 3, bxs - des - 2)
End If
End If
If tfat = "FAT16" Then
cadeg = cadeg + Chr(&HF7) + Chr(&HFF)
cadeg = cadeg + Mid(cadeo, des + 3, bxs - des - 2)
End If
If tfat = "FAT32" Then
cadeg = cadeg + Chr(&HF7) + Chr(&HFF) + Chr(&HFF) + Chr(&HFF)
cadeg = cadeg + Mid(cadeo, des + 5, bxs - des - 4)
End If

espa = cadeg
q = SetFilePointer(hdevice, byt, byt2, 0&)
If q <> byt Then MsgBox "Error pointer grabando FAT": sale
WriteFile hdevice, ByVal espa, bxs, ret, ByVal 0&
If ret <> bxs Then MsgBox "Error grabando FAT": sale
Return

final:
Timer1.Enabled = False
Timer1_Timer
Command1.Caption = "Empezar"
End Sub
Private Sub Timer1_Timer()
Label2.Caption = cluster & " de " & Text2.Text & linea
qqa = (cluster - Text1.Text) / (Text2.Text - Text1.Text) * 100#
Label2.Caption = Label2.Caption & Fix(qqa) & "%" & " "

If qqa = 0 Then GoTo tt2
qqb = conta / qqa * 100# - conta
qqcade = " segundos"
If qqb >= 60 Then qqcade = " minutos": qqb = qqb / 60#
If qqb >= 60 Then qqcade = " horas": qqb = qqb / 60#
Label2.Caption = Label2.Caption & "Quedan " & Fix(qqb) & qqcade

tt2:
conta = conta + 1
End Sub
Private Sub Command1_Click()
If Command1.Caption = "Empezar" Then
Command1.Caption = "Parar"
hace
Else
Command1.Caption = "Empezar"
acc = 1
End If
End Sub
Private Sub sale()
CloseHandle hdevice
End
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
sale
End Sub
Private Sub Form_Unload(Cancel As Integer)
sale
End Sub