Форматируем дискетку, используя API.

' This code was donated by Duncan Diep (Duncan.Diep@myna.com)

' Объявления

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

' Добавляем 2 кнопки:
' cmdFormat и cmdDiskCopy

Private Sub cmdFormatDrive_Click()
    Dim DriveLetter$, DriveNumber&, DriveType&    Dim RetVal&, RetFromMsg%
    DriveLetter = UCase(Drive1.Drive)
    DriveNumber = (Asc(DriveLetter) - 65) ' Change letter to Number: A=0
    DriveType = GetDriveType(DriveLetter)
    If DriveType = 2 Then  'Floppies, etc
        RetVal = SHFormatDrive(Me.hwnd, DriveNumber, 0&, 0&)
    Else
        RetFromMsg = MsgBox("This drive is NOT a removeable" & vbCrLf & _
            "drive! Format this drive?", 276, "SHFormatDrive Example")
        Select Case RetFromMsg
            Case 6   'Yes
                ' Без комментариев ...
                'RetVal = SHFormatDrive(Me.hwnd, DriveNumber, 0&, 0&)
            Case 7   'No
                ' Do nothing
        End Select
    End If
End Sub

Private Sub cmdDiskCopy_Click()
' DiskCopyRunDll takes two parameters- From and To
    Dim DriveLetter$, DriveNumber&, DriveType&
    Dim RetVal&, RetFromMsg&
    DriveLetter = UCase(Drive1.Drive)
    DriveNumber = (Asc(DriveLetter) - 65)
    DriveType = GetDriveType(DriveLetter)
    If DriveType = 2 Then  'Floppies, etc
        RetVal = Shell("rundll32.exe diskcopy.dll,DiskCopyRunDll " _
            & DriveNumber & "," & DriveNumber, 1) 'Notice space after
    Else   ' Just in case                         'DiskCopyRunDll
        RetFromMsg = MsgBox("Only floppies can" & vbCrLf & _
            "be diskcopied!", 64, "DiskCopy Example")
    End If
End Sub

' Добавляем один ListDrive с именем Drive1

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

 

 

 

                                                                   ОБСУДИТЬ СТАТЬЮ НА ФОРУМЕ