PDA

View Full Version : سوال: فرمت كردن درايو با كليك بروي يك دكمه!



linktaz
شنبه 11 آبان 1392, 20:09 عصر
سلام.
آيا ميشه يه دكمه تعبيه كرد كه با اون بشه درايو رو فرمت كرد؟
مثلا cmd باز بشه و شروع به فرمت كنه.اما ديگه Y/N رو نپرسه.و مستقيم شروع به فرمت كنه.يه از روشي ديگه.
امكانش هست؟

Abbas Amiri
شنبه 11 آبان 1392, 21:24 عصر
سلام.
آيا ميشه يه دكمه تعبيه كرد كه با اون بشه درايو رو فرمت كرد؟
مثلا cmd باز بشه و شروع به فرمت كنه.اما ديگه Y/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

Private Const FORMAT_FULL = &H1

Public Function FormatDrive(ByVal DriveLetter As String, _
Optional PermitNonRemovableFormat As Boolean = False) As _
Boolean

'************************************************* *
'Formats a drive specified by Drive Letter.
'Confirmation box will appear

'Set PermitNonRemovableFormat to true if you want to allow for _
formating of fixed drive or other non-removable drive (e.g., C:\)


'Returns true if successful, false otherwise

'EXAMPLE 1: FormatDrive "A:\"
'formats drive A:

'EXAMPLE 2: FormatDrive "C:\"
'Will fail because PermitNonRemovableFormat is not set
'to true

'I have not tested formatting fixed drives because there
'are no fixed drives I want to format

'USE WITH CAUTION: IF YOU DON'T FOLLOW INSTRUCTIONS
'YOU CAN WIPE OUT SOMEONE'S HARD DRIVE

'************************************************* *
Dim sDrive As String
Dim lDrive As Long
Dim iDriveType As Integer
Dim iAns As Integer
Dim sDriveLetter
Dim lRet As Long

sDrive = UCase(DriveLetter)
sDriveLetter = sDrive
'format as [Letter]:/ if not done already
If Len(sDrive) = 1 Then sDriveLetter = sDriveLetter & ":\"
If Len(sDrive) = 2 And Right$(sDrive, 1) = ":" _
Then sDriveLetter = sDrive & "\"


lDrive = Asc(Left(sDrive, 1)) - 65
iDriveType = DriveType(sDrive)
'حذف تائید فرمت
SendKeys "{ENTER}"
SendKeys "{ENTER}"
Select Case iDriveType
Case 2
lRet = SHFormatDrive(hWndAccessApp, lDrive, HFFFF, FORMAT_FULL)
FormatDrive = lRet = 0
Case 3, 4, 5, 6
If Not PermitNonRemovableFormat Then Exit Function
lRet = SHFormatDrive(hWndAccessApp, lDrive, HFFFF, FORMAT_FULL)
FormatDrive = lRet = 0
Case Else 'no such drive
Exit Function
End Select

End Function

Private Function DriveType(Drive As String) As Integer

Dim sAns As String, lAns As Long

'fix bad parameter values
If Len(Drive) = 1 Then Drive = Drive & ":\"
If Len(Drive) = 2 And Right$(Drive, 1) = ":" _
Then Drive = Drive & "\"

DriveType = GetDriveType(Drive)

End Function

'Example:
FormatDrive "H",True

اگر مقدار True در مثال فوق False شود درایوهای هارد را فرمت نخواهد کرد