API kullanarak bir diskete format atmak için visual basicc kod

API kullanarak bir diskete format atmak için aşağıdaki kodu kullanabilirsiniz.
Not: Bu kod harddiske format atabilir, bu nedenle dikkatli olmalısınız.

Önce, Bu kodu bir formun General Declarations bölümüne kopyalayın:


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


Forma iki CommandButtons ekleyin:
Birincinin adı: "cmdFormatDrive"
İkincinin adı: "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
' UnComment to do it...
'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



Forma birde Drive1 adlı ListDrive ekleyin:



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