Mensajes

Si, es una de mis tantas malas costumbres  

Código [Seleccionar] Expandir




Option Explicit

Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
'Dessa
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwprocessid As Long) As Long
Private Declare Function OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function GetModuleFileNameExA Lib "PSAPI.DLL" (ByVal hProcess As Long, ByVal hModule As Long, ByVal lpFilename As String, ByVal nSize As Long) As Long
Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Type POINTAPI: x As Long: y As Long: End Type

Dim CtlHandle As Long


Private Sub Form_Load()
 
  Me.BackColor = vbBlack
  Me.ForeColor = vbWhite
  Me.FontBold = True
  Me.Top = 0: Me.Left = 0
  Me.Width = 6450
  Me.Height = 1000
  Me.BorderStyle = 5
  Timer1.Interval = 16

End Sub

Private Sub Timer1_Timer()
 
  Call SetWindowPos(Me.hwnd, -1, 0, 0, 0, 0, &H2 Or &H1)
 
  Dim Cor As POINTAPI
  Call GetCursorPos(Cor)
 
  Dim Handle As Long
  Handle = WindowFromPoint(Cor.x, Cor.y)
 
  If Handle <> CtlHandle Then

      Dim idProc As Long
      Call GetWindowThreadProcessId(Handle, idProc)
 
      Dim Handle_Proceso As Long
      Handle_Proceso = OpenProcess(&H400 + &H10, 0, idProc)
 
      Dim Buffer As String
      Buffer = Space$(255)
      Dim ret As Long
      ret = GetModuleFileNameExA(Handle_Proceso, 0, Buffer, 255)
 
      Dim Ruta As String
      Ruta = Left$(Buffer, ret)
 
      Call CloseHandle(Handle_Proceso)
 
      Me.Cls
      Me.Print ""
      Me.Print Ruta
 
      Me.Caption = "PID =  " & idProc
   
      CtlHandle = Handle

  End If

End Sub




Una boludez, pero a veces puede servir, con este code se puede saber la ruta (Path) del ejetutable al  que pertenece a una ventana, solo hay que pasar el puntero del mouse sobre la ventana que se quiere "investigar".

Código [Seleccionar] Expandir



Option Explicit
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
'Dessa
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwprocessid As Long) As Long
Private Declare Function OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function GetModuleFileNameExA Lib "PSAPI.DLL" (ByVal hProcess As Long, ByVal hModule As Long, ByVal lpFilename As String, ByVal nSize As Long) As Long
Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Type POINTAPI: x As Long: y As Long: End Type


Private Sub Form_Load()

  Dim ClassName As String: ClassName = Space$(256)
  Dim ret As Long: ret = GetClassName(Me.hwnd, ClassName, 256)
  If Left$(ClassName, ret) = "ThunderFormDC" Then
    MsgBox "Esta aplicacion debe correr compilada", , ""
    End
  End If
 
  Me.BackColor = vbBlack: Me.ForeColor = vbWhite: Me.FontBold = True
  Me.Top = 0: Me.Left = 0: Me.Width = 6450: Me.Height = 1000
  Me.BorderStyle = 5: Timer1.Interval = 16

End Sub

Private Sub Timer1_Timer()
 
  Call SetWindowPos(Me.hwnd, -1, 0, 0, 0, 0, &H2 Or &H1)
  Dim Cor As POINTAPI: Dim retorno As Long: retorno = GetCursorPos(Cor)
  Dim Handle As Long: Handle = WindowFromPoint(Cor.x, Cor.y)
  Dim idProc As Long: Call GetWindowThreadProcessId(Handle, idProc)
  Dim Handle_Proceso As Long: Handle_Proceso = OpenProcess(&H400 + &H10, 0, idProc)
  Dim Buffer As String: Buffer = Space$(255)
  Dim ret As Long: ret = GetModuleFileNameExA(Handle_Proceso, 0, Buffer, 255)
  Dim Ruta As String: Ruta = Left$(Buffer, ret): Call CloseHandle(Handle_Proceso)
 
  Me.Cls: Me.Print "": Me.Print Ruta: Me.Caption = "ID PROCESO =  " & idProc

End Sub



Si cobein, el espacio libre en una unidad oculta, el StartingOffset y el size ya lo tengo resuelto.

[PARTITION_INFORMATION_EX Structure]

Para lpOutBuffer, PARTITION_INFORMATION_EX Structure me puede devolver : StartingOffset (start)  o PartitionLength (size)  pero  nada relativo al espacio ocupado o libre. ?  

http://msdn.microsoft.com/es-ar/library/aa365448(en-us,VS.85).aspx

Gracias Cobein,

DeviceIoControl ?

EDITO: parece que ese es el camino, pero hDevice sin letra se me va a poner "chivo" ...  igual aguante "el óvalo" ...

Creo que ya quedo claro como tenias que hacerlo no? Montar-Calcular-Desmontar

Qui facha di arrabbiato (enojado) Non'é asi di fácile (fáchile),

Mira la particion HD1 del grafico (Particion desconocida), es primaria, contiene otro xp y se puede bootear pero como la particion no fue creada por W$ el sistema no te deja montar, tampoco Dispart te permite asignarle una letra ni forzando (assign)
Por otro lado solo en algunos casos si, se puede asignar, pero el sistema se toma su "tiempo" para desmontar





Si intento con Mandarin ???  


 

Es que con el español no  tuve suerte.

http://foro.elhacker.net/programacion_vb/como_calcular_espacio_libre_de_una_particion_oculta-t275356.0.html;msg1351499#msg1351499

Tal vez con Aleman...

Ich muß den freien Raum einer Teilung wissen(kennen), es ist wichtig, dass die Teilung es Geheimnis (zu wissen, hat Brief(Buchstaben)) nicht, oder dass mit der API GetDiskFreeSpaceEx ich nicht, keiner mit WMI (Win32_LogicalDisk-FreeSpace) konnte, da die obengenannte erwähnte Teilung als eine logische Teilung nicht genommen wird, um Brief(Buchstaben) nicht zu haben. 

PD: WMI auch, seit dieser für einen Manager bestimmten Anwendung.(ADM)


Gott Spart die Königin und Spart Auch einen Obama (God Save the Queen & Also Save a Obama)

[EDIT: perdon ya lo habia dicho Seba]

Comprobaste si la ruta donde se tendria que crear el exe es la misma ruta que el proyecto ?


-----------------------------------------------------------------------------------------------------

EDIT: perdon ya lo habia dicho Seba

no fallo no, porque si llega a haber un error, al compilar te avisa y todo, es raro lo que decis, ¿no le estaras errando la ruta donde se genera?

[acotación]

seguro que este es el nombre de clase ThunderRT6FormDC mira que si la aplicacion esta en ide es otro el classname.

shaggikpo: No estoy diciendo que es tu problema, estoy haciendo una acotación sobre el tema de la clase del form de vb:

"ThunderFormDC" si se ejecutan desde el IDE,
"ThunderRT6FormDC" si se ejecuta compilado.

Código [Seleccionar] Expandir


Option Explicit

Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long

Private Sub Form_Load()
 
  Me.AutoRedraw = True: Me.FontBold = True

  Dim ClassName As String: ClassName = Space$(255)
  Dim ret As Long: ret = GetClassName(Me.hwnd, ClassName, 255)
  Me.Print Left$(ClassName, ret)

End Sub




PD: me pareció importante pero perdón si te molestó.