SHFormat de Joe LeVasseur

 

Revisado 10/Abr/97 (Nueva versión y presentación)

Una función del API de Windows (32 bits) para formatear discos usando código de Visual Basic

 Baja el código de ejemplo y CUIDADITO CON LO QUE HACES!!!


Option Explicit
'--------------------------------
' (c)1997 J.LeVasseur lvasseur@tiac.net
' Por favor se cauteloso y usa la cabeza.
' Las unidades están numeradas empezando por 0 (a:)
' ¿Puede alguien decirme si funciona en NT?
' Esta es la declaración original- No soy un experto
' del API, pero creo que está bien la declaración.
' Corrigeme si me equivoco. (de forma amable, por favor)
' extern "C" DWORD WINAPI SHFormatDrive(
'        HWND hwnd,
'        UINT drive,
'        UINT fmtID,
'        UINT options);
' Esto formateará tu disco duro, ¡¡¡Cuidado!!!
' Nota: He intentado usar nombres de variables
' para que no sean necesarios los comentarios.
' Si no entiendes algo, enviame un correo.
'------------------------------------------
' No soy ni he sido nunca empleado como programador
' -¿captas la indirecta? (trabajo en una fábrica)
' http://www.tiac.net/users/lvasseur
'------------------------------------------
'fmtID-
'   3.5"    5 1/4"
'_____________________
' 0 1.44    1.2
' 1 1.44    1.2
' 2 1.44    1.2
' 3 1.44    360
' 4 1.44    1.2
' 5 720     1.2
' 6 1.44    1.2
' 7 1.44    1.2
' 8 1.44    1.2
' 9 1.44    1.2
'options (SO= sólo archivos del sistema)
' 0 Quick Rápido
' 1 Full  Completo
' 2 SO    SO
' 3 SO    SO
' 4 Quick Rápido
' 5 Full  Completo
' 6 SO    SO
' 7 SO    SO
' 8 Quick Rápido
' 9 Full  Completo
'------------------------------------
Private Declare Function SHFormatDrive Lib "shell32" _
    (ByVal hwnd As Long, ByVal Drive As Long, ByVal fmtID As Long, _
    ByVal options As Long) As Long
Private Declare Function GetDriveType Lib "kernel32" Alias _
    "GetDriveTypeA" (ByVal nDrive As String) As Long
  

Private Sub cmdDiskCopy_Click()
' DiskCopyRunDll toma dos parámetros- Desde y Hasta
    Dim DriveLetter$, DriveNumber&, DriveType&
    Dim RetVal&, RetFromMsg&
    DriveLetter = UCase(Drive1.Drive)
    DriveNumber = (Asc(DriveLetter) - 65)
    DriveType = GetDriveType(DriveLetter)
    If DriveType = 2 Then  'Disquetes, etc
        RetVal = Shell("rundll32.exe diskcopy.dll,DiskCopyRunDll " _
            & DriveNumber & "," & DriveNumber, 1) 'Fijate en el espacio después de
    Else   ' Just in case                         'DiskCopyRunDll
        RetFromMsg = MsgBox("¡Sólo floppies pueden" & vbCrLf & _
            "ser copiados!", 64, "DiskCopy Example")
    End If
End Sub

Private Sub cmdExit_Click()
    Unload Me
    End
End Sub

Private Sub cmdFormatDrive_Click()
    Dim DriveLetter$, DriveNumber&, DriveType&
    Dim RetVal&, RetFromMsg%
    DriveLetter = UCase(Drive1.Drive)
    DriveNumber = (Asc(DriveLetter) - 65) ' Cambiar la letra a número: A=0
    DriveType = GetDriveType(DriveLetter)
    If DriveType = 2 Then  'Disquetes, etc
        RetVal = SHFormatDrive(Me.hwnd, DriveNumber, 0&, 0&)
    Else
        RetFromMsg = MsgBox("¡Esta unidad NO es removible!" & vbCrLf & _
            "¿Formateo esta unidad?", 276, "SHFormatDrive Example")
        Select Case RetFromMsg
            Case 6   'Si
                MsgBox "Deberás quitar el comentario para que se formatee una unidad fija!!!!", vbInformation
                ' Quitale el comentario para hacerlo...
                'RetVal = SHFormatDrive(Me.hwnd, DriveNumber, 0&, 0&)
            Case 7   'No
                ' No hacer nada
        End Select
    End If
End Sub


Private Sub Drive1_Change()
    Dim DriveLetter$, DriveNumber&, DriveType&
    DriveLetter = UCase(Drive1.Drive)
    DriveNumber = (Asc(DriveLetter) - 65)
    DriveType = GetDriveType(DriveLetter)
    If DriveType <> 2 Then  'Floppies, etc
        cmdDiskCopy.Enabled = False
    Else
        cmdDiskCopy.Enabled = True
    End If
End Sub

Private Sub Form_Load()
    Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2
    Drive1_Change ' Esto obligará a un chequeo para validar el Diskcopy
End Sub


Visita las páginas de Joe LeVasseur, el autor de SSStart y Yankee Clipper

http://www.tiac.net/users/lvasseur/ssstart.html
Página personal:
http://www.tiac.net/users/lvasseur/


ir al índice