asked on

VB Script to do an unattended format of a drive

I am trying to write a VB script to do an unattended quick format of a drive. I can get the format box to appear but i can't get it to autostart and complete. Ideally I just want a message to say that its done. Listed below is the code i have used

Private Declare Function SHFormatDrive Lib "Shell32.dll" (ByVal hWnd As Long, _
ByVal Drive As Integer, ByVal fmtID As Integer, ByVal Options As Integer) _
As Long

Private Sub Command1_Click()
Dim ret As Long
ret = SHFormatDrive(hMainWnd, 6, -1, 1)
End Sub

Does anyone have any ideas? I would also like to be able to specify a volume name?

Many thanks,

Mark

c0ldfyr3

http://msdn.microsoft.com/en-us/library/bb762169.aspx

"The format is controlled by the dialog interface. That is, the user must click the OK button to actually begin the formatthe format cannot be started programmatically."

Easiest way to do it would be...

Dim sDrive As String
 
sDrive = "D:"
 
Call Shell ("format.com " & sDrive & " /Q /Y")

Open in new window

BenthamLtd

ASKER

the problem with doing that is that VB cannot tell when the format has completed. The next part of the program copies data to the formated drive. Obviously if the format hasn't completed the copy can't start.

c0ldfyr3

Aha my dearest Watson you should have said so :)

http://www.freevbcode.com/ShowCode.Asp?ID=99

Option Explicit
 
Private Declare Function OpenProcess Lib "kernel32" _
(ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, _
ByVal dwProcessId As Long) As Long
 
Private Declare Function GetExitCodeProcess Lib "kernel32" _
(ByVal hProcess As Long, lpExitCode As Long) As Long
 
Private Const STATUS_PENDING = &H103&
Private Const PROCESS_QUERY_INFORMATION = &H400
 
 
Public Function ShellandWait(ExeFullPath As String, _
Optional TimeOutValue As Long = 0) As Boolean
    
    Dim lInst As Long
    Dim lStart As Long
    Dim lTimeToQuit As Long
    Dim sExeName As String
    Dim lProcessId As Long
    Dim lExitCode As Long
    Dim bPastMidnight As Boolean
    
    On Error GoTo ErrorHandler
 
    lStart = CLng(Timer)
    sExeName = ExeFullPath
 
    'Deal with timeout being reset at Midnight
    If TimeOutValue > 0 Then
        If lStart + TimeOutValue < 86400 Then
            lTimeToQuit = lStart + TimeOutValue
        Else
            lTimeToQuit = (lStart - 86400) + TimeOutValue
            bPastMidnight = True
        End If
    End If
 
    lInst = Shell(sExeName, vbMinimizedNoFocus)
    
lProcessId = OpenProcess(PROCESS_QUERY_INFORMATION, False, lInst)
 
    Do
        Call GetExitCodeProcess(lProcessId, lExitCode)
        DoEvents
        If TimeOutValue And Timer > lTimeToQuit Then
            If bPastMidnight Then
                 If Timer < lStart Then Exit Do
            Else
                 Exit Do
            End If
    End If
    Loop While lExitCode = STATUS_PENDING
    
    ShellandWait = True
   
ErrorHandler:
ShellandWait = False
Exit Function
End Function

Open in new window

BenthamLtd

ASKER

Dear god that seems like a lot of code for a fairly simple command. Is there no simpler way?

c0ldfyr3

Umm, it's one function that calls Shell and loops until it's finished, all of the code is just for waiting for Shell to exit.
I don't think there is a simpler way to be honest.

nffvrxqgrcfqvvc

Undocumented API

Option Explicit
 
Public Enum MEDIATYPE
    Removable_Disk = &H8
    Hard_Disk = &HC
End Enum
 
Public Declare Sub FormatEx Lib "fmifs.dll" ( _
    ByVal cDriveRoot As Long, _
    ByVal cMediaFlag As Long, _
    ByVal cFSType As Long, _
    ByVal cLabel As Long, _
    ByVal cQuickFormat As Long, _
    ByVal cClusterSize As Long, _
    ByVal cCallbackFunc As Long)
 
Public Sub SetFormatOptionsAndFormat(ByVal strDriveRoot As String, lngMediaType As MEDIATYPE, ByVal strFormatType As String, ByVal strLabel As String, ByVal lngQuickFormat As Long)
'// Usage:
'Call SetFormatOptionsAndFormat("F:\", Removable_Disk, "FAT32", "MY USB", 0)          ' Format removable thumbdrive
'Call SetFormatOptionsAndFormat("E:\", Hard_Disk, "NTFS", "Local Disk E", 1)          ' Format fixed drive (quick format)
 
    Call FormatEx(StrPtr(strDriveRoot), _
        lngMediaType, _
        StrPtr(strFormatType), _
        StrPtr(strLabel), _
        lngQuickFormat, _
        0&, _
        AddressOf FormatCallback)
        
End Sub
 
Public Function FormatCallback(ByVal Command As Long, ByVal SubAction As Long, ByVal ActionInfo As Long) As Long
    
    ' info
    Debug.Print Command; SubAction; ActionInfo
    
    ' push
    FormatCallback = 1
   
End Function

Open in new window

ASKER CERTIFIED SOLUTION

clarkscott

membership

Create a free account to see this answer

Signing up is free and takes 30 seconds. No credit card required.

See answer

nffvrxqgrcfqvvc

<< Obviously if the format hasn't completed the copy can't start.>>

Code from previous post updated.

' Module1.bas
 
Option Explicit
 
Private Const CB_PROGRESS As Long = 0
Private Const CB_FINISHED As Long = 11
 
Public Enum MediaType
    Removable_Disk = &H8
    Hard_Disk = &HC
End Enum
 
Private Declare Sub FormatEx Lib "fmifs.dll" (ByVal cDriveRoot As Long, ByVal cMediaFlag As Long, ByVal cFSType As Long, ByVal cLabel As Long, ByVal cQuickFormat As Long, ByVal cClusterSize As Long, ByVal cCallbackFunc As Long)
Private Declare Sub RtlMoveMemory Lib "kernel32" (Destination As Any, Source As Any, ByVal Length As Long)
 
Dim lngPercent  As Long
Dim bStatus     As Byte
 
Public Sub SetFormatOptionsAndFormat(ByVal strDriveRoot As String, lngMediaType As MediaType, ByVal strFormatType As String, ByVal strLabel As String, ByVal lngQuickFormat As Long)
    ' // usage
    'Call SetFormatOptionsAndFormat("F:\", Removable_Disk, "FAT32", "USB", 0)          ' Format removable thumbdrive
    'Call SetFormatOptionsAndFormat("E:\", Hard_Disk, "NTFS", "Local Disk", 1)         ' Format fixed drive (quick format)
    Call FormatEx(StrPtr(strDriveRoot), lngMediaType, StrPtr(strFormatType), StrPtr(strLabel), lngQuickFormat, 0&, AddressOf FormatCallback)
        
End Sub
 
Public Function FormatCallback(ByVal Command As Long, ByVal SubAction As Long, ByVal ActionInfo As Long) As Long
   '// info
    Select Case Command
        Case CB_PROGRESS
            RtlMoveMemory lngPercent, ByVal ActionInfo, SubAction
            Debug.Print lngPercent & "%"
        Case CB_FINISHED
            RtlMoveMemory bStatus, ByVal ActionInfo, SubAction
            If bStatus Then
                Debug.Print "Format Complete: Begin write operations here."
            Else
                Debug.Print "Format Failed!"
            End If
    End Select
    ' // push
    FormatCallback = 1
   
End Function

Open in new window