Как отформатировать флопик из VB?

[BorisSS]

Что-то я не могу найти такой команды
Мож кто знает?

[hCORe]

Вот это вызовет окно "Форматирование: Диск 3,5 (A)"

Код: Выделить всё

'Объявления API
Private Declare Function SHFormatDrive Lib "Shell32" (ByVal hwndOwner As Long, ByVal iDrive As Long, ByVal iCapacity As Long, ByVal iFormatType As Long) As Long

'Вызов форматирования
Private Function ShowFormat(Optional ByVal iDrive As Long, _
Optional ByVal iCapacity As Long, Optional ByVal iFormatType As Long) As Long
On Error Resume Next
    ShowFormat = SHFormatDrive(0, iDrive, iCapacity, _
    iFormatType)

End Function

Private Sub Form_Load()
On Error Resume Next
'Форматнуть диск A: (по умолчанию)
    ShowFormat
End Sub

А вот это сделает то же самое, но из командной строки:

Код: Выделить всё

Shell "format a: /u"

[BorisSS]

Мне надо форматировать без вызова окна.
Что-то второй вариант не работает

[hCORe]

Используй

Код: Выделить всё

Shell Environ("COMSPEC") & " /c format a: /u /y"

или ту же командную строку с CreateProcess:

Код: Выделить всё

Private Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" (ByVal lpApplicationName As String, ByVal lpCommandLine As String, ByVal lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, lpEnvironment As Any, ByVal lpCurrentDirectory As String, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long

В случае CreateProcess API ты даже сможешь задать атрибут CREATE_NO_WINDOW (только для NT), который скорет окно запущенного приложения. Контроль закрытия приложения осуществляй при помощи WaitForSingleObject API:

Код: Выделить всё

Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long

API-Guide тебе в помощь!

[A.A.Z.]

Можно использовать BAT'ы
Не забудь подключить Microsoft Scripting Runtime

Код: Выделить всё

Dim fso As New FileSystemObject
Dim dr As Drive
Dim AppPath As String

Sub Form_Load()
If Right(App.Path, 1) = "\" Then AppPath = App.Path Else AppPath = App.Path & "\"
End Sub

Sub FullFormatDriveA() 'полное форматирование
Set dr = fso.GetDrive("A:")
If dr.IsReady Then
WriteResponseFile
Dim F As Integer
Dim batch As String
batch = AppPath & "qf_a.bat"
F = FreeFile
Open batch For Output As #F
Print #F, "Format A: /U < resp.txt"
Print #F, "del resp.txt"
Print #F, "del %0"
Close #F
Shell batch, vbHide
Else
MsgBox "Я заходил к дисководу, у него никого нет!", vbOKOnly
End If
End Sub

Private Sub QuickFormatDriveA() 'быстрое форматирование
Set dr = fso.GetDrive("A:")
If dr.IsReady Then
WriteResponseFile
Dim F As Integer
Dim batch As String
batch = AppPath & "qf_a.bat"
F = FreeFile
Open batch For Output As #F
Print #F, "Format A: /Q < resp.txt"
Print #F, "del resp.txt"
Print #F, "del %0"
Close #F
Shell batch, vbHide
Else
MsgBox "Я заходил к дисководу, у него никого нет!", vbOKOnly
End If
End Sub


[BorisSS]

Shell Environ("COMSPEC") & " /c format a: /u /y"

почему-то не работает под 98, хотя под ХП все ОК

[hCORe]

Усовершенствуем до такого варианта:

Код: Выделить всё

Dim strCmdPath As String, strWinPath as String
On Error Resume Next
strWinPath = Environ ("WINDIR")
If Len(strWinPath) = 0 Then _
strWinPath = "C:\WINDOWS"
If Mid(strWinPath, Len(strWinPath), _
1) = "\" Then strWinPath = Mid(strWinPath, _
1, Len(strWinPath)-1)
strCmdPath = Environ("COMSPEC")
If Len(strCmdPath) = 0 Then _
strCmdPath = strWinPath & _
"\command.com"
Shell strCmdPath & " /c format a: /u /y"

[BorisSS]

Спасибо!
А все равно под 98 не работает Т.е. сеанс MS-Dos "вспыхивает" на полсекунды, но форматирование не начинается.
Но, если в строке

Shell strCmdPath & " /c format a: /u /y"

удалить "/y", то окно MS-Dos открывается в свернутом виде и надо его разворачивать, а затем нажимать Enter.
Мне бы хотелось, чтобы нажал кнопку и, без всяких подсказок и лишних манипуляций пошло форматирование.
СУВЖ,
Борис.

[hCORe]

Enter можно нажать при помощи keyb_event:

Код: Выделить всё

Declare Sub keybd_event Lib "user32.dll" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)

Описание параметров:

· bVk
Задает код виртуальной клавиши. Код клавиши - это значение от 1 до 254.

· bScan
Задает аппаратный скан-код клавиши. Обычно устанавливается в 0.

· fdwFlags
Набор флагов, которые задают различные параметры операции посылки кода клавиши. Приложение может использовать любую комбинацию из данных предустановленных констант для установки флагов:
KEYEVENTF_EXTENDEDKEY
Если установлен, этот флаг показывает, что скан-код должен быть предварен байтом со значением 0xE0 (224).
KEYEVENTF_KEYUP
Если установлен, этот флаг показывает, что клавиша отпускается. Если нет, то клавиша нажимается.

· dwExtraInfo
Задает дополнительное 32-битное значение (Long), связанное со строкой, посылаемой системе. Обычно устанавливается в 0.

[hCORe]

А чтобы окно появлялось сразу, используй:

Код: Выделить всё

Shell strCmdPath & " /c format a: /u", vbNormalFocus