[SRC]mFormat - Formatea Unidades desde VB {De forma oculta}

[Karcrack]

Bueno, hasta las narices de este post:

Código [Seleccionar] Expandir

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:

Código (vb) [Seleccionar] Expandir

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

Código (vb) [Seleccionar] Expandir

Call AltFormat("A:", True)

NOTA: Solo funciona con W$ en español

Saludos

PD:Odio el nuevo 'xD' ( = )

[Dessa]

Hola, hay muchas maneras de hacerlo, aca dejo otra

Código [Seleccionar] Expandir



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

[Karcrack]

Buen code

Lo unico 'bueno' que tiene mi code es que puedes asignar el nombre a la unidad

Saludos y gracias por el aporte

[Dessa]

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

[el_c0c0]

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

[Dessa]

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   

[Dessa]

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

Código [Seleccionar] Expandir



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

Saludos y espero que sirva

EDIT: Agregué el comando "/X" de format.

[el_c0c0]

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

[Fabricio]

Deseo Expresar mi agradecimiento a Karcrack y a Dessa por haberme ayudado a resolver el problema que tenia
muchas gracias a los dos 

[bizco]

http://msdn.microsoft.com/en-us/library/aa365161(VS.85).aspx