كود عمل فورمات للقرص المرن

السلام عليكم ورحمة الله وبركاته

Private Sub Command1_Click()
Shell "Command.com /c Format A:\"

اشكرك على التجاوب اخي GHOST2010

ولكن الكود لم يعمل فورمات ارجو منك التأكد

السلام عليكم و رحمة الله و بركاته

هذه الاكواد للفرمته والتسخ سواء القرص المرن او القرص الصلب

Add 2 command buttons named :

cmdFormat and 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, DriveNu

' mber, 0&, 0&)

Case 7'No

' Do nothing

End Select

End If

End Sub

Private Sub cmdDiskCopy_Click()

' DiskCopyRunDll takes two parameters- F

' rom 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

Add 1 ListDrive name 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

ارجو التوضيح اكثر لم افهم شيء :(

:(

هاوي! كتب:

ارجو  التوضيح اكثر  لم  افهم  شيء :(

:(

←

هذا البرنامج كامل لتفهم كل شىء

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

'**************************************************

اجعل قيمة الوسيط الثاني الى 1  في حالة اذا اردت عمل فورمات لقسم ثايت مثل السي او الدي
والا لعمل فورمات للفلوبي اترك القيمة فارغة

'**************************************************
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
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)
Select Case iDriveType

Case 2

lRet = SHFormatDrive(Me.hWnd, lDrive, HFFFF, FORMAT_FULL)
FormatDrive = lRet = 0
Case 3, 4, 5, 6
    If Not PermitNonRemovableFormat Then Exit Function
    lRet = SHFormatDrive(Me.hWnd, lDrive, HFFFF, FORMAT_FULL)
    FormatDrive = lRet = 0
Case Else 
    Exit Function
End Select

End Function

Private Function DriveType(Drive As String) As Integer

Dim sAns As String, lAns As Long

If Len(Drive) = 1 Then Drive = Drive & ":\"
If Len(Drive) = 2 And Right$(Drive, 1) = ":" _
    Then Drive = Drive & "\"

DriveType = GetDriveType(Drive)

End Function