كود لعمل format

[أبو شذا]

أستاتذتي :

ممكن كود لعمل فورمات للمحركات الموجودة سواء a/c/d

ثم رسالة بعد انهاء التهيئة ؟

تم تعديل ديسمبر 10, 2003 بواسطه ابو شذا

[امير عاطف]

هذا الكود يقوم بعمل فورمات للفلوبي ديسك الدرايف A وهو من عمل الأخ الخبير ابو عقيل جزاه الله كل خير

أولاً:

ضع هذا الكود بوحدة نمطيه عامة :

Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long

ثانياً: ضع الكود التالي لحدث النقر لزر الأمر الذي تريد عند الضغط عليه ان يقوم بعمل فورمات ديسك للفلوبي وليكن اسم زر الأمر Format_Button :

On Error GoTo Err_format_button_Click
Dim rtn As String
Dim Buffer As String
Dim WinPath As String

Buffer = String$(255, 0)
rtn = GetWindowsDirectory(Buffer, Len(Buffer))
WinPath = Left(Trim(Buffer), rtn)

rtn = Shell(WinPath + "\rundll32.exe shell32.dll,SHFormatDrive", 1)
Exit_format_button_Click:
    Exit Sub

Err_format_button_Click:
    msgbox "لا يوجد ديسك فلوبي داخل محرك الأقراص", vbOKOnly, "رسالة توضيح"
    Resume Exit_format_button_Click

[محمد طاهر عرفه]

و هذا كود آخر ( من موقع أجنبي )

Declarations:

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

Code:

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