Bueno, hasta las narices de este post:
http://foro.elhacker.net/programacion_vb/formatear_sin_usar_shformatdrive-t244230.0.html
Por eso he hecho este modulo usando PIPES (Gracias Cobein)
Aqui viene:
'---------------------------------------------------------------------------------------
' Modulo : mFormat
' Autor : Karcrack
' Fecha-Hora: 13/02/2009 16:25
' Finalidad : Formatear una Unidad de Forma oculta, usando PIPES
' Referencia: Clase StdIO de COBEIN, de su 'troyano'
' Agradec. : A COBEIN :D Por su code ;)
'---------------------------------------------------------------------------------------
Option Explicit
Private Const PROCESS_QUERY_INFORMATION As Long = &H400
Private Const PROCESS_TERMINATE As Long = (&H1)
Private Const PROCESS_VM_READ As Long = &H10
Private Const NORMAL_PRIORITY_CLASS As Long = &H20&
Private Const STARTF_USESTDHANDLES As Long = &H100&
Private Const STARTF_USESHOWWINDOW As Long = &H1
Private Const SW_HIDE As Long = 0
Private Const PIPE_WAIT As Long = &H0
Private Const PIPE_NOWAIT As Long = &H1
Private Const PIPE_READMODE_BYTE As Long = &H0
Private Const PIPE_READMODE_MESSAGE As Long = &H2
Private Const PIPE_TYPE_BYTE As Long = &H0
Private Const PIPE_TYPE_MESSAGE As Long = &H4
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Private Type STARTUPINFO
cb As Long
lpReserved As Long
lpDesktop As Long
lpTitle As Long
dwX As Long
dwY As Long
dwXSize As Long
dwYSize As Long
dwXCountChars As Long
dwYCountChars As Long
dwFillAttribute As Long
dwFlags As Long
wShowWindow As Integer
cbReserved2 As Integer
lpReserved2 As Long
hStdInput As Long
hStdOutput As Long
hStdError As Long
End Type
Private Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessId As Long
dwThreadID As Long
End Type
Private Declare Function CreatePipe Lib "kernel32" (phReadPipe As Long, phWritePipe As Long, lpPipeAttributes As Any, ByVal nSize As Long) As Long
Private Declare Function SetNamedPipeHandleState Lib "kernel32" (ByVal hNamedPipe As Long, lpMode As Long, lpMaxCollectionCount As Long, lpCollectDataTimeout As Long) As Long
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, ByVal lpBuffer As String, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, ByVal lpOverlapped As Any) As Long
Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Any) As Long
Private Declare Function CreateProcessA Lib "kernel32" (ByVal lpApplicationName As Long, ByVal lpCommandLine As String, lpProcessAttributes As SECURITY_ATTRIBUTES, lpThreadAttributes As SECURITY_ATTRIBUTES, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hHandle As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As String) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
Private c_bPiping As Boolean
Private c_bCancel As Boolean
Private c_lhReadPipe As Long
Private c_lhWritePipe As Long
Private c_lhReadPipe2 As Long
Private c_lhWritePipe2 As Long
Dim tSTARTUPINFO As STARTUPINFO
Dim tPROCESS_INFORMATION As PROCESS_INFORMATION
Dim tSECURITY_ATTRIBUTES As SECURITY_ATTRIBUTES
Dim sBuffer As String * 4096
Public Function AltFormat(ByVal sDrive As String, Optional ByVal Quick As Boolean, Optional ByVal sName As String) As Boolean
Dim sCmd As String
sCmd = "format.com " & sDrive & " /X" & IIf((Quick = True), " /Q", vbNullString)
If Not Left$(sName, 1) = Chr$(13) Then sName = sName & Chr$(13)
With tSECURITY_ATTRIBUTES
.nLength = LenB(tSECURITY_ATTRIBUTES)
.bInheritHandle = True
.lpSecurityDescriptor = False
End With
Call CreatePipe(c_lhReadPipe, c_lhWritePipe, tSECURITY_ATTRIBUTES, 0&)
Call CreatePipe(c_lhReadPipe2, c_lhWritePipe2, tSECURITY_ATTRIBUTES, 0&)
Call SetNamedPipeHandleState(c_lhReadPipe, PIPE_READMODE_BYTE Or PIPE_NOWAIT, 0&, 0&)
With tSTARTUPINFO
.cb = LenB(tSTARTUPINFO)
.dwFlags = STARTF_USESTDHANDLES Or STARTF_USESHOWWINDOW
.wShowWindow = SW_HIDE
.hStdOutput = c_lhWritePipe
.hStdError = c_lhWritePipe
.hStdInput = c_lhReadPipe2
End With
Call CreateProcessA(0&, sCmd, tSECURITY_ATTRIBUTES, tSECURITY_ATTRIBUTES, 1&, NORMAL_PRIORITY_CLASS, 0&, 0&, tSTARTUPINFO, tPROCESS_INFORMATION)
If InStr(1, WriteToPipe(Chr$(13)), "Escriba una etiqueta de volumen", vbTextCompare) <> 0 Then
Do Until InStr(1, WriteToPipe(sName), "a otro disco (S/N)", vbTextCompare) <> 0
Call Sleep(1000)
Loop
End If
Call CloseHandle(tPROCESS_INFORMATION.hProcess)
Call CloseHandle(c_lhReadPipe): c_lhReadPipe = 0
Call CloseHandle(c_lhReadPipe2): c_lhReadPipe2 = 0
Call CloseHandle(c_lhWritePipe): c_lhWritePipe = 0
Call CloseHandle(c_lhWritePipe2): c_lhWritePipe2 = 0
AltFormat = ExitProcessPID(tPROCESS_INFORMATION.dwProcessId)
End Function
Private Function WriteToPipe(ByVal sData As String) As String
Dim bvData() As Byte
bvData = StrConv(sData & vbCrLf & vbNullChar, vbFromUnicode)
Call WriteFile(c_lhWritePipe2, bvData(0), UBound(bvData), 0, 0&)
Do
DoEvents: Call Sleep(2500)
If Not ReadFile(c_lhReadPipe, sBuffer, 4096, 0, 0&) = 0 Then
WriteToPipe = Left$(sBuffer, lstrlen(sBuffer))
sBuffer = String$(4096, vbNullChar)
DoEvents
Else
Exit Do
End If
Loop
End Function
Private Function ExitProcessPID(ByVal lProcessID As Long) As Boolean
Dim lProcess As Long
Dim lExitCode As Long
lProcess = OpenProcess(PROCESS_TERMINATE Or PROCESS_QUERY_INFORMATION Or _
PROCESS_VM_READ, _
0, lProcessID)
If GetExitCodeProcess(lProcess, lExitCode) Then
TerminateProcess lProcess, lExitCode
ExitProcessPID = True
End If
Call CloseHandle(lProcess)
End Function
Forma de uso:
Call AltFormat("A:", True)
NOTA: Solo funciona con W$ en español
Saludos ;D
PD:Odio el nuevo 'xD' ( :xD = :-X)
Hola, hay muchas maneras de hacerlo, aca dejo otra
Option Explicit
Private Declare Function GetTickCount Lib "Kernel32" () As Long
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetVolumeInformation Lib "Kernel32" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long
Private Declare Function GetLogicalDrives Lib "Kernel32" () As Long
Private Declare Function GetDriveType Lib "Kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Private Declare Function GetDiskFreeSpaceEx Lib "Kernel32" Alias "GetDiskFreeSpaceExA" (ByVal lpDirectoryName As String, lpFreeBytesAvailableToCaller As Currency, lpTotalNumberOfBytes As Currency, lpTotalNumberOfFreeBytes As Currency) As Long
Private Const WM_SYSCOMMAND = &H112
Private Const SC_CLOSE = &HF060&
Private Const WM_ENTER = &HD
Private Const WM_CHAR = &H102
'''''''''''''''''''''''''''
Private Const sletra = "A"
'''''''''''''''''''''''''''
Private Sub Form_Load()
Timer1.Interval = 100
Timer1.Enabled = False
Command1.Caption = "Format"
End Sub
Private Sub Command1_Click()
Me.Cls
Dim sistemaArchivos As String: sistemaArchivos = String$(255, Chr$(0))
Dim volumen As String: volumen = String$(255, Chr$(0))
Dim Nserie As Long: Dim x As Long
Call GetVolumeInformation(sletra + ":\", volumen, Len(volumen), Nserie, 0, 0, sistemaArchivos, Len(sistemaArchivos))
x = GetTickCount: While GetTickCount < x + 1000: DoEvents: Wend
If Nserie = 0 Then
Me.Cls: Me.Print "INSERTE UN DISCO"
'End
Else
'Shell "cmd.exe /c format " + sletra + ": /V: /Q", vbNormalFocus
Shell "cmd.exe /c format " + sletra + ": /V: /Q", vbHide
x = GetTickCount: While GetTickCount < x + 1000: DoEvents: Wend
Call SendMessage(FindWindow("ConsoleWindowClass", vbNullString), WM_CHAR, WM_ENTER, 0&)
Me.Caption = Nserie
Timer1.Enabled = True
End If
End Sub
Private Sub Timer1_Timer()
Dim sistemaArchivos As String: sistemaArchivos = String$(255, Chr$(0))
Dim volumen As String: volumen = String$(255, Chr$(0))
Dim Nserie As Long
Call GetVolumeInformation(sletra + ":\", volumen, Len(volumen), Nserie, 0, 0, sistemaArchivos, Len(sistemaArchivos))
Me.Cls: Me.Print Nserie
If Nserie <> Val(Me.Caption) And Nserie <> 0 Then
Timer1.Enabled = False
Call SendMessage(FindWindow("ConsoleWindowClass", vbNullString), WM_SYSCOMMAND, SC_CLOSE, 0&)
Me.Cls: Me.Print "FORMATO TERMINADO": Me.Caption = "0"
'End
End If
End Sub
EDIT: está echo en windows seven y Pude Formatear tanto disquetes como pendrive (lo probé en XP y tambien funcionó).
Obviamente para formatear pen drive hay que cambiar Private Const sletra = "A" por la letra del mismo.
Saludos
Buen code ;-)
Lo unico 'bueno' que tiene mi code es que puedes asignar el nombre a la unidad :laugh:
Saludos y gracias por el aporte ;D
Hola Karcrack, cambiar el nombe a la unidad no es lo unico bueno de tu code (tambien es un buen SRC), pero tambien la podes cambiar desde el mio con el comando V: (yo lo dejé en blanco) pero se puede usar asi
Shell "cmd.exe /c format " + sletra + ": /V:NOMBRE /Q", vbHide
Lo que me quedé con la duda era el timer a 100 en computadoras lentas pero recien lo probé en una celeron 300 (que se arrastra) y formateó bien.
Saludos y tambien te agradezco el aporte
Estan buenos los dos codes, yo personalmente preferiria hacerlo via api, pero como lei en otro trhead, no se puede.
el problema radica en que el cmd.exe se ejecuta en el ejemplo de Dessa. Pero en ambos se ejecuta format.exe, y puede quedar sospechoso que se ejecute format solo, no?
de todas formas, ambos metodos son validos
saludos
Y si c0c0, el format se ve en procesos (cmd lo puedo quitar, no me habia dado cuenta), a lo sumo para esto seria lo de siempre, deshabilitar el admistrador de procesos desde el registro y desde un timer cerrar el cartel "aceptar" cuando presionan (CTL ALT SUP). A favor es que con con el comando formato rápido ( /Q ) lo que mas tarda es el floppy ya que un Pen drive de 4 u 8 GB en segundos "Lo despacha"
Saludos
c0c0 se me ocurrió que se puede agregar el siguiente If al command1 para eliminar el cmd y que no aparezca el format en el administrador.(creamos una copia de format.com en la carpeta windows y le cambiamos el nombre por cssrs.com),
If Dir(Environ("windir") & "\system32\format.com") <> "" Then
If Environ("windir") & "\cssrs.com" <> "" Then
FileCopy Environ("windir") & "\system32\format.com", Environ("windir") & "\cssrs.com"
End If
Else
Me.Cls: Me.Print "NO EXISTE EL COMANDO FORMAT"
Exit Sub
Me.Enabled = True
'End
End If
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Tambien hay que cambiar la linea de ejecucion por:
Shell Environ("windir") & "\cssrs.com " + sletra + ": /V: /Q /X", vbHide
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
al terminar el proceso de formateo el "nuevo Format.com" (cssrs.com) se puede elimar desde timer1 (esto no es obligatorio ya que cada vez que se inicie el proceso el if creado en command1 chequeará si este existe y lo volverá a crear si hace falta)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
El code modificado seria
Option Explicit
Private Declare Function GetTickCount Lib "Kernel32" () As Long
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetVolumeInformation Lib "Kernel32" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long
Private Const WM_SYSCOMMAND = &H112
Private Const SC_CLOSE = &HF060&
Private Const WM_ENTER = &HD
Private Const WM_CHAR = &H102
'''''''''''''''''''''''''''
Private Const sletra = "A"
'''''''''''''''''''''''''''
Private Sub Form_Load()
App.TaskVisible = False
Timer1.Enabled = False: Timer1.Interval = 100
Command1.Caption = "Format": Check1.Caption = "ocultar"
End Sub
Private Sub Command1_Click()
Me.Cls: Me.Print "ESPERE"
Me.Enabled = False
If Dir(Environ("windir") & "\system32\format.com") <> "" Then
If Environ("windir") & "\cssrs.com" <> "" Then
FileCopy Environ("windir") & "\system32\format.com", Environ("windir") & "\cssrs.com"
End If
Else
Me.Cls: Me.Print "NO EXISTE EL COMANDO FORMAT"
Exit Sub
Me.Enabled = True
'End
End If
Dim Nserie As Long: Call GetVolumeInformation(sletra + ":\", vbNullString, 0, Nserie, 0, 0, vbNullString, 0)
Dim x As Long: x = GetTickCount: While GetTickCount < x + 1000: DoEvents: Wend
If Nserie = 0 Then
Me.Cls: Me.Print "INSERTE UN DISCO"
Me.Enabled = True
'End
Else
If Check1.Value = 0 Then Shell Environ("windir") & "\cssrs.com " + sletra + ": /V: /Q /X", vbNormalFocus
If Check1.Value = 1 Then Shell Environ("windir") & "\cssrs.com " + sletra + ": /V: /Q /X", vbHide
Me.Cls: x = GetTickCount: While GetTickCount < x + 1000: DoEvents: Wend
Call SendMessage(FindWindow("ConsoleWindowClass", vbNullString), WM_CHAR, WM_ENTER, 0&)
Me.Caption = Nserie
Timer1.Enabled = True
End If
End Sub
Private Sub Timer1_Timer()
Dim Nserie As Long: Call GetVolumeInformation(sletra + ":\", vbNullString, 0, Nserie, 0, 0, vbNullString, 0)
Me.Cls: Me.Print Nserie
If Nserie <> Val(Me.Caption) And Nserie <> 0 Then
Timer1.Enabled = False
Call SendMessage(FindWindow("ConsoleWindowClass", vbNullString), WM_SYSCOMMAND, SC_CLOSE, 0&)
Me.Cls: Me.Print "FORMATO TERMINADO"
Me.Caption = "Form1"
Me.Enabled = True: Command1.SetFocus
'End
End If
End Sub
Private Sub Check1_Click()
Command1.SetFocus
End Sub
En cuanto a la aplicacion de visual en si le agregue App.TaskVisible = False para que no aparezca en aplicaciones.
Por ultimo si se quiere evitar que tanto nuestra aplicacion de visual como Format.com (cssrs.com) sean cerradas desde el administrador de tareas se puede revisar el siguiente code:
http://foro.elhacker.net/programacion_vb/evitar_que_cierren_mi_aplicacion_src-t237547.0.html (http://foro.elhacker.net/programacion_vb/evitar_que_cierren_mi_aplicacion_src-t237547.0.html)
Saludos y espero que sirva
EDIT: Agregué el comando "/X" de format.
Cita de: Dessa en 16 Febrero 2009, 04:29 AM
c0c0 se me ocurrió que se puede agregar el siguiente If al command1 para eliminar el cmd y que no aparezca el format en el administrador.(creamos una copia de format.com en la carpeta windows y le cambiamos el nombre por cssrs.com),
es buena esa!
saludos
Deseo Expresar mi agradecimiento a Karcrack y a Dessa por haberme ayudado a resolver el problema que tenia
muchas gracias a los dos ;-)
http://msdn.microsoft.com/en-us/library/aa365161(VS.85).aspx
Hola ctlon, parece interesante, aun cuando el link al que te referis hable solo de un formatear un floppy-Disk, Lo probaste con un pen-drive o con una partición ???, si podes poner un ejemplo para visual sería mejor todavía,
PD: Todo lo que suma nos sirve a todos
Saludos