API funkce pro formßtovßnφ disku

'***************************************************************
'Windows API/Global Declarations for :cmdFormatDrive
'***************************************************************


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



'***************************************************************
' Name: cmdFormatDrive
' Description:Format Floppy Disk using API:Here is the code on How
' to Format Floppy Disk using API.
' By: Duncan Diep
'***************************************************************

Do formulß°e p°idejte dv∞ tlaΦφtka:
cmdFormat a 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

Do formulß°e nynφ p°idejte prvek ListDrive pojmenovan² 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



Michal Blßha (SPRINX)
blaha@sprinx.cz
23.6.1999