Foros del Web - Ver Mensaje Individual

wyxchari · #7 (**permalink**) 18/07/2008, 05:42

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