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/