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 [email protected]
' 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