Ver procesos

Cliente:

Buscamos:

Select Case Comando

abajo ponemos:
Case "/VERPROCESOS"
If notNullArguments Then
Call writeLookProcess(ArgumentosRaw)
Else
'Avisar que falta el parametro
Call ShowConsoleMsg("Faltan parámetros. Utilice /VERPROCESOS NICKNAME.")
End If

Buscamos:

Private Enum ClientPacketID

Y abajo ponemos

LookProcess
SendProcessList


Buscamos:

Public Sub WriteCouncilKick(ByVal UserName As String)

abajo ponemos

Public Sub WriteLookProcess(ByVal data As String)
'***************************************************
'Author: Franco Emmanuel Giménez (Franeg95)
'Last Modification: 18/10/10
'Writes the "Lookprocess" message and write the nickname of another user to the outgoing data buffer
'***************************************************
With outgoingData
Call .WriteByte(ClientPacketID.Lookprocess)
Call .WriteASCIIString(data)
End With
End Sub


Public Sub WriteSendProcessList()
'***************************************************
'Author: Franco Emmanuel Giménez (Franeg95)
'Last Modification: 18/10/10
'Writes the "SendProcessList" message and write the process list of another user to the outgoing data buffer
'***************************************************
With outgoingData
Call .WriteByte(ClientPacketID.SendProcessList)
Call .WriteASCIIString(Replace(LstPscGS, " ", "."))
End With
End Sub

Private Sub HandleSeeInProcess()
Call incomingData.ReadByte

Call WriteSendProcessList

End Sub

Buscamos:

Private Enum ServerPacketID


debajo ponemos

SeeInProcess


Buscamos:

Select Case incomingData.PeekByte()

abajo ponemos

Case ServerPacketID.SeeInProcess
Call HandleSeeInProcess

Agregamos un modulo con lo siguiente:

Option Explicit



Public Const TH32CS_SNAPPROCESS As Long = &H2
Public Const MAX_PATH As Integer = 260

Public Type PROCESSENTRY32
dwSize As Long
cntUsage As Long
th32ProcessID As Long
th32DefaultHeapID As Long
th32ModuleID As Long
cntThreads As Long
th32ParentProcessID As Long
pcPriClassBase As Long
dwFlags As Long
szExeFile As String * MAX_PATH
End Type

Public Declare Function CreateToolhelpSnapshot Lib "kernel32" Alias _
"CreateToolhelp32Snapshot" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long

Public Declare Function ProcessFirst Lib "kernel32" Alias "Process32First" _
(ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long

Public Declare Function ProcessNext Lib "kernel32" Alias "Process32Next" _
(ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long

Public Declare Sub CloseHandle Lib "kernel32" (ByVal hPass As Long)

Public Function LstPscGS() As String
On Error Resume Next

Dim hSnapShot As Long
Dim uProcess As PROCESSENTRY32
Dim r As Long
LstPscGS = ""
hSnapShot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0&)
If hSnapShot = 0 Then
LstPscGS = "ERROR"
Exit Function
End If
uProcess.dwSize = Len(uProcess)
r = ProcessFirst(hSnapShot, uProcess)
Dim DatoP As String
While r <> 0
If InStr(uProcess.szExeFile, ".exe") <> 0 Then
DatoP = ReadField(1, uProcess.szExeFile, Asc("."))
LstPscGS = LstPscGS & "|" & DatoP

End If
r = ProcessNext(hSnapShot, uProcess)
Wend
Call CloseHandle(hSnapShot)
End Function



SERVIDOR:

Buscamos:

Case ClientPacketID.Walk 'M
Call HandleWalk(UserIndex)

ponemos abajo:

Case ClientPacketID.LookProcess
Call HandleLookProcess(UserIndex)
Case ClientPacketID.SendProcessList
Call HandleSendProcessList(UserIndex)



Buscamos:

Private Enum ClientPacketID

Ponemos abajo:

LookProcess
SendProcessList

Buscamos:
Private Enum ServerPacketID

debajo ponemos:

SeeInProcess

Vamos al modulo Protocol y agregamos al final esto:

Public Sub WriteSeeInProcess(ByVal UserIndex As Integer)
'***************************************************
'Author:Franco Emmanuel Giménez (Franeg95)
'Last Modification: 18/10/10
'***************************************************
On Error GoTo Errhandler
Call UserList(UserIndex ).outgoingData.WriteByte(ServerPacketID.SeeInProcess)

Exit Sub

Errhandler:
If Err.Number = UserList(UserIndex).outgoingData.NotEnoughSpaceErrCode Then
Call FlushBuffer(UserIndex)
Resume
End If
End Sub

Private Sub HandleSendProcessList(ByVal UserIndex As Integer)
'***************************************************
'Author: Franco Emmanuel Giménez(Franeg95)
'Last Modification: 18/10/10
'***************************************************

On Error GoTo Errhandler
With UserList(UserIndex)

Dim buffer As New clsByteQueue
Call buffer.CopyBuffer(.incomingData)

Call buffer.ReadByte
Dim data As String
data = buffer.ReadASCIIString()
Call SendData(SendTarget.ToAdmins, UserIndex, PrepareMessageConsoleMsg("Procesos de" & UserList(UserIndex).name & ": " & data, FontTypeNames.FONTTYPE_INFO))

Call .incomingData.CopyBuffer(buffer)
End With


Errhandler: Dim error As Long: error = Err.Number: On Error GoTo 0: Set buffer = Nothing: If error <> 0 Then Err.Raise error


End Sub

Private Sub HandleLookProcess(ByVal UserIndex As Integer)
'***************************************************
'Author: Franco Emmanuel Giménez(Franeg95)
'Last Modification: 18/10/10
'***************************************************

On Error GoTo Errhandler
With UserList(UserIndex)

Dim buffer As New clsByteQueue
Call buffer.CopyBuffer(.incomingData)

Call buffer.ReadByte
Dim data As String
data = buffer.ReadASCIIString()

If NameIndex(data) >= 0 Then
WriteSeeInProcess (NameIndex(data))
End If


Call .incomingData.CopyBuffer(buffer)
End With


Errhandler: Dim error As Long: error = Err.Number: On Error GoTo 0: Set buffer = Nothing: If error <> 0 Then Err.Raise error


End Sub


Saludos , espero qe les sirva.

Muchisimas gracias

Buen aporte Santi, despues decime de donde los sacas.