Menú

Mostrar Mensajes

Esta sección te permite ver todos los mensajes escritos por este usuario. Ten en cuenta que sólo puedes ver los mensajes escritos en zonas a las que tienes acceso en este momento.

Mostrar Mensajes Menú

Mensajes - seba123neo

#3231
Hola,aca tenes uno que te dice cuanto ocupa un proceso poniendo su nombre,en este ejemplo es la calculadora de windows....

Private Type PROCESS_MEMORY_COUNTERS
cb As Long
PageFaultCount As Long
PeakWorkingSetSize As Long
WorkingSetSize As Long
QuotaPeakPagedPoolUsage As Long
QuotaPagedPoolUsage As Long
QuotaPeakNonPagedPoolUsage As Long
QuotaNonPagedPoolUsage As Long
PagefileUsage As Long
PeakPagefileUsage As Long
End Type

Private Const PROCESS_QUERY_INFORMATION = 1024
Private Const PROCESS_VM_READ = 16
Private Const MAX_PATH = 260

Private Type LARGE_INTEGER
lowpart As Long
highpart As Long
End Type

Private Type MEMORYSTATUSEX
dwLength As Long
dwMemoryLoad As Long
ullTotalPhys As LARGE_INTEGER
ullAvailPhys As LARGE_INTEGER
ullTotalPageFile As LARGE_INTEGER
ullAvailPageFile As LARGE_INTEGER
ullTotalVirtual As LARGE_INTEGER
ullAvailVirtual As LARGE_INTEGER
ullAvailExtendedVirtual As LARGE_INTEGER
End Type

Private Declare Function EnumProcesses Lib "PSAPI.DLL" (lpidProcess As Long, ByVal cb As Long, cbNeeded As Long) As Long
Private Declare Function EnumProcessModules Lib "PSAPI.DLL" (ByVal hProcess As Long, lphModule As Long, ByVal cb As Long, lpcbNeeded As Long) As Long
Private Declare Function OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccessas As Long, ByVal bInheritHandle As Long, ByVal dwProcId As Long) As Long
Private Declare Function GetModuleFileNameExA Lib "PSAPI.DLL" (ByVal hProcess As Long, ByVal hModule As Long, ByVal ModuleName As String, ByVal nSize As Long) As Long
Private Declare Function GetProcessMemoryInfo Lib "PSAPI.DLL" (ByVal hProcess As Long, ppsmemCounters As PROCESS_MEMORY_COUNTERS, ByVal cb As Long) As Long
Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal Handle As Long) As Long

Private Function GetProcessMemory(ByVal EXEName As String) As Long
Dim lngLength As Long
Dim strProcessName As String
Dim lngCBSize As Long
Dim lngCBSizeReturned As Long
Dim lngNumElements As Long
Dim lngProcessIDs() As Long
Dim lngCBSize2 As Long
Dim lngModules(1 To 200) As Long
Dim lngReturn As Long
Dim strModuleName As String
Dim lngSize As Long
Dim lngHwndProcess As Long
Dim lngLoop As Long
Dim pmc As PROCESS_MEMORY_COUNTERS
Dim lRet As Long
Dim strProcName2 As String
On Error GoTo Error_handler
EXEName = UCase$(Trim$(EXEName))
lngLength = Len(EXEName)
lngCBSize = 8
lngCBSizeReturned = 96
Do While lngCBSize <= lngCBSizeReturned
lngCBSize = lngCBSize * 2
ReDim lngProcessIDs(lngCBSize / 4) As Long
lngReturn = EnumProcesses(lngProcessIDs(1), lngCBSize, lngCBSizeReturned)
Loop
lngNumElements = lngCBSizeReturned / 4
For lngLoop = 1 To lngNumElements
lngHwndProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0, lngProcessIDs(lngLoop))
If lngHwndProcess <> 0 Then
lngReturn = EnumProcessModules(lngHwndProcess, lngModules(1), 200, lngCBSize2)
If lngReturn <> 0 Then
strModuleName = Space(MAX_PATH)
lngSize = 500
lngReturn = GetModuleFileNameExA(lngHwndProcess, lngModules(1), strModuleName, lngSize)
strProcessName = Left$(strModuleName, lngReturn)
strProcName2 = GetExeName(strProcessName)
If strProcName2 = EXEName Then
pmc.cb = LenB(pmc)
lRet = GetProcessMemoryInfo(lngHwndProcess, pmc, pmc.cb)
GetProcessMemory = pmc.WorkingSetSize / 1024
End If
End If
End If
lngReturn = CloseHandle(lngHwndProcess)
Next lngLoop
IsProcessRunning_Exit:
Exit Function
Error_handler:
Resume Next
End Function

Private Function GetExeName(ByVal sPath As String) As String
Dim lPos1 As Long
Dim lPos2 As Long
On Error Resume Next
lPos1 = InStr(1, sPath, Chr$(0))
lPos2 = InStrRev(sPath, "\")
If lPos1 > 0 Then
GetExeName = UCase$(Mid$(sPath, lPos2 + 1, lPos1 - lPos2))
Else
GetExeName = UCase$(Mid$(sPath, lPos2 + 1))
End If
End Function

Private Sub Command1_Click()
MsgBox "Este Procesos Ocupa en Memoria " & GetProcessMemory("CALC.EXE") & " KB", vbInformation 'para la calculadora de windows...
End Sub


saludos.
#3232
Hola,no asi no,mira leete esto,usa algunas api's,pero no se si sabes lo que son:

Un procedimiento genérico para imprimir

saludos.

#3233
no anda por ahora porque lo estan cambiando de servidor y otras cosas...ya va a andar...
#3234
mostra lo que haces,a ver que esta mal...
#3236
muy bueno,que mas decir como siempre va...,ahora entiendo para que preguntaste la otra vez,¿era para esto no?  :),me funciona bien... ;)

saludos.
#3237
Hola,este juego algunos ya lo vieron cuando lo publique hace como 1 año,cuando se me dio por hacer juegos de flash en visual basic..este se trata de hacerle click a una figura redonda que va desapareciendo haciendose mas chica y cambiando de lugar,el puntero del mouse es un puntito que cambia de color al mismo tiempo que la pantalla tambien,para equivocarnos,pero no es muy dificil,es de flash original que tambien lo adjunto es mas dificil....la captura no dice nada,pero si lo juegan ya veran porque se llama el SACAOJOS  :P.....



Descargar: FlashingButton

saludos.
#3238
pero eso son pixeles VIVOS y ATORRANTES jeej  :P
#3239
jajaaj nooo,es porque estan NEGROS...estan muertos... :P
#3240
Hola,no se si te sirva esto,lo habia echo para poder navegar a una pagina web y despues cada cierto tiempo navegar automaticamente a todos los links de la primera pagina visitada,necesitas un webbrowser,un timer y un listbox,podes sacar el listbox y almacenar los links en un array...

Dim primero As Boolean

Private Sub Form_Load()
primero = True
WebBrowser1.Navigate "www.google.com.ar"
End Sub

Private Sub Timer1_Timer()
Static i As Integer
i = i + 1
If i = List1.ListCount + 1 Then MsgBox "Termino la lista": List1.Clear: Exit Sub
primero = False
WebBrowser1.Navigate List1.List(i - 1)
End Sub

Private Sub WebBrowser1_DownloadComplete()
If primero = True Then
Dim i As Integer
List1.Clear
For i = 0 To WebBrowser1.Document.links.length - 1
List1.AddItem WebBrowser1.Document.links.Item(i)
Next
Timer1.Enabled = True
Timer1.Interval = 3000
Else
Exit Sub
End If
End Sub


saludos.