Szybkie szukanie
Słowo kluczowe:
piątek, 10 luty 2012
Start arrow Tips & Tricks arrow Formatowanie dyskietki z użyciem API.
Formatowanie dyskietki z użyciem API. Drukuj E-mail
Nadesłał mortar   
sobota, 21 styczeń 2006
'W sekcji Declaration

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

'Dodaj 2 commad button i nazwij je

'cmdFormatDrive i cmdDiskCopy

'Dodaj do procedury cmdFormatDrive_click

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

'Dodaj ListDrive o nazwie Drive1
'i w procedurz Drive1_Change wpisz

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

Komentarze

Aby dodać komentarz zaloguj się. Jeśli nie masz konta, załóż je sobie.
Tylko zarejestrowani użytkownicy mogą pisać komentarze.

Powered by AkoComment 2.0!

< Poprzedni   Następny >

Menu główne
Start
Teoria
VB.NET
Api
Tips & Tricks
Warsztat
VBMagazine
Pliki
Forum
Literatura
Ankiety
Linki
Szukaj
Wyślij program
Napisz do nas
Redakcja
Logowanie
Login

Hasło

Zapamiętaj mnie
Nie pamiętasz hasła?
Nie masz konta? Załóż je sobie
Gościmy
Aktualnie jest 21 gości online
Statystyka
Użytkownicy: 11345
Newsy: 237
Odnośniki: 48
Odwiedzających: 4327432
Mambo is Free Software released under the GNU/GPL License.