O Que Está Errado?

[Guest - Alexandre -]

Este código tem como objetivo listar e matar determinados processos que estão carregados na memória. Porém ele está dando um erro (em vermelho): "'Sub' ou 'Function' não definida". Não sei como resolvê-lo, alguém pode me ajudar?

Aí vai parte do código:

Sub ListaProgMem()

hSnapShot = _

CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0&)

If hSnapShot <> 0 Then

uProcess.dwSize = Len(uProcess)

rProcess = ProcessFirst(hSnapShot, uProcess)

Do While rProcess

tPID = uProcess.th32ProcessID

tMID = uProcess.th32ModuleID

ComparaLista (Trim(RemoveChr0(uProcess. _

szExeFile))), Hex&(uProcessID)

rProcess = ProcessNext(hSnapShot, uProcess)

Loop

Call CloseHandle(hSnapShot)

End If

End Sub

Function ComparaLista(Processo As String, _

ProcessoCodeHex As String)

Dim Posicao As Integer

Dim NomeArq As String

Lista = "CALC.EXE NOTEPAD.EXE"

Posicao = Strings.InStr(1, Strings.StrReverse _

(Processo), "\", vbBinaryCompare)

NomeArq = Strings.Right(Processo, Posicao - 1)

If Strings.InStr(1, Lista, NomeArq, vbTextCompare) _

Then

RemoveProgMem (ProcessoCodeHex)

End If

End Function

[Graymalkin]

Não existe Hex&(), mas sim Hex() e Hex$().

Abraços,

Graymalkin

[Guest Guest]

Ok, corrigi isso, mas agora da um erro na linha:

rProcess = ProcessNext(hSnapShot, uProcess)

"Tipo incompatível de argumento ByRef" ...

[Graymalkin]

Onde está a declaração de uProcess?

Graymalkin

[Guest Guest]

Ela está declarada. Vou te passar o script completo pra você dar uma olhada. Testa aí.

Aí vai ...

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 Function GetExitCodeProcess Lib _

"Kernel32" (ByVal hProcess As Long, lpExitCode As _

Long) As Long

Public Declare Function TerminateProcess Lib _

"Kernel32" (ByVal hProcess As Long, ByVal _

uExitCode As Long) As Long

Public Declare Function OpenProcess Lib "Kernel32" _

(ByVal dwDesiredAcess As Long, ByVal bInheritHandle _

As Long, ByVal dwProcessId As Long) As Long

Public Declare Function RegisterServiceProcess Lib _

"Kernel32.dll" (ByVal dwProcessId As Long, ByVal _

dwType As Long) As Long

Public Declare Function CloseHandle Lib "Kernel32.dll" _

(ByVal dwProcessId As Long, ByVal dwType As Long) _

As Long

Public Const MAX_PATH As Integer = 260

Public Const TH32CS_SNAPPROCESS = &H2

Public Const PROCESSTERMINATE = &H1

Dim uProcess As PROCESSENTRY32

Type PROCESSENTRY32

dwSize As Long

cntUsage As Long

th32ProcessID As Long

th32DefaultHeapID As Long

th32ModuleID As Long

th32Threads As Long

cntThreads As Long

th32ParentProcessID As Long

pcPriClassBase As Long

dwFlags As Long

szExeFile As String * MAX_PATH

End Type

Sub ListaProgMem()

hSnapShot = _

CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0&)

If hSnapShot <> 0 Then

uProcess.dwSize = Len(uProcess)

rProcess = ProcessFirst(hSnapShot, uProcess)

Do While rProcess

tPID = uProcess.th32ProcessID

tMID = uProcess.th32ModuleID

ComparaLista (Trim(RemoveChr0(uProcess. _

szExeFile))), Hex$(uProcessID)

rProcess = ProcessNext(hSnapShot, uProcess)

Loop

End If

End Sub

Function ComparaLista(Processo As String, _

ProcessoCodeHex As String)

Dim Posicao As Integer

Dim NomeArq As String

Lista = "CALC.EXE NOTEPAD.EXE"

Posicao = Strings.InStr(1, Strings.StrReverse _

(Processo), "\", vbBinaryCompare)

NomeArq = Strings.Right(Processo, Posicao)

If Strings.InStr(1, Lista, NomeArq, vbTextCompare) _

Then

RemoveProgMem (ProcessoCodeHex)

End If

End Function

Function RemoveChr0(cString As String)

While Right(cString, 1) = Chr$(0)

cString = Left(cString, Len(cString) - 1)

Wend

RemoveChr0 = cString

End Function

Sub RemoveProgMem(CodeHex As String)

Dim ProTemp As String

hProcess = OpenProcess(PROCESS_TERMINATE, _

CLng(False), CLng("&h" & CodeHex))

If hProcess = 0 Then

'Processo não existe

Else

If GetExitCodeProcess(hProcess, _

lExitCode) = 0 Then

'Não pode ser finalizado

Else

If TerminateProcess(hProcess, _

lExitCode) = 0 Then

'Processo não finalizado

Else

'Processo finalizado

End If

End If

End If

End Sub

[Graymalkin]

Tem uma pá de coisas erradas aí no código. Constantes não declaradas, variáveis não declaradas (vazias, portanto), tem um membro a mais (th32Threads) na estrutura PROCESSENTRY32 que faz com que o nome do executável perca 4 bytes, etc. Aconselho você dar um Stop no começo do código e acompanhar linha a linha verificando se os valores estão corretos.

Abraços,

Graymalkin

[Guest Guest]

Ok ... desde já, agradeço sua ajuda.

Veja, eu fiz algumas alterações no código: corrigi algumas coisas e parece q estou no caminho certo, porém ainda não cheguei lá. Com as correções que fiz ele está conseguindo listar os programas carregados na memória e ele, pelo menos, está tentando finalizar o processo, mas retorna um erro de controle q eu coloquei: "Não pode ser finalizado"

Dê uma olhada no novo código:

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 Function GetExitCodeProcess Lib "Kernel32" _

(ByVal hProcess As Long, lpExitCode As Long) As Long

Public Declare Function TerminateProcess Lib "Kernel32" _

(ByVal hProcess As Long, ByVal uExitCode As Long) As Long

Public Declare Function OpenProcess Lib "Kernel32" _

(ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long

Public Declare Function RegisterServiceProcess Lib "kernel32.dll" _

(ByVal dwProcessId As Long, ByVal dwType As Long) As Long

Public Declare Function CloseHandle Lib "Kernel32" (ByVal hFile As Long) As Long

Public Const MAX_PATH As Integer = 260

Public Const TH32CS_SNAPPROCESS = &H2

Public Const PROCESS_TERMINATE = &H1

Dim uProcess As PROCESSENTRY32

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

Sub ListaProgMem()

hSnapShot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0&)

If hSnapShot <> 0 Then

uProcess.dwSize = Len(uProcess)

rProcess = ProcessFirst(hSnapShot, uProcess)

Do While rProcess

tPid = uProcess.th32ProcessID

tMID = uProcess.th32ModuleID

ComparaLista Trim(RemoveChr0(uProcess.szExeFile)), Hex$(uProcess.th32ProcessID)

rProcess = ProcessNext(hSnapShot, uProcess)

Loop

Call CloseHandle(hSnapShot)

End If

End Sub

Function ComparaLista(Processo As String, ProcessoCodeHex As String)

Dim Posicao As Integer

Dim NomeArq As String

Lista = "CALC.EXE"

Found = Strings.InStr(1, Processo, Lista, vbTextCompare)

If Found Then

RemoveProgMem (ProcessoCodeHex)

End If

End Function

Function RemoveChr0(cString As String)

While Right(cString, 1) = Chr$(0)

cString = Left(cString, Len(cString) - 1)

Wend

RemoveChr0 = cString

End Function

Sub RemoveProgMem(CodeHex As String)

Dim ProTemp As String

hProcess = OpenProcess(PROCESS_TERMINATE, CLng(False), CLng("&h" & CodeHex))

If hProcess = 0 Then

MsgBox "Processo não existe"

Else

If GetExitCodeProcess(hProcess, uExitCode) = 0 Then

MsgBox "Não pode ser finalizado"

Else

If TerminateProcess(hProcess, uExitCode) = 0 Then

MsgBox "Processo não finalizado"

Else

MsgBox "Processo Finalizado"

End If

End If

End If

End Sub

[Graymalkin]

Não testei aqui, mas para o OpenProcess() no RemoveProgMem você deveria passar o número do processo (que é um inteiro longo) e não uma string com um valor hexadecimal.

Abraços,

Graymalkin

[Guest Guest]

Não estou conseguindo fazer isso ...

[Graymalkin]

Reescrevi o seu módulo, uma que o código estava bem desorganizado, além de ter coisas sem necessidade e a parte de finalizar o processo estava incompleta:

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 Function GetExitCodeProcess Lib _
"kernel32" (ByVal hProcess As Long, lpExitCode As _
Long) As Long

Public Declare Function TerminateProcess Lib _
"kernel32" (ByVal hProcess As Long, ByVal _
uExitCode As Long) As Long

Public Declare Function OpenProcess Lib "kernel32" _
(ByVal dwDesiredAcess As Long, ByVal bInheritHandle _
As Long, ByVal dwProcessId As Long) As Long

Public Declare Function RegisterServiceProcess Lib _
"Kernel32.dll" (ByVal dwProcessId As Long, ByVal _
dwType As Long) As Long

Public Declare Function CloseHandle Lib "Kernel32.dll" _
(ByVal dwProcessId As Long, ByVal dwType As Long) _
As Long

Private Declare Sub ExitProcess Lib "kernel32" (ByVal uExitCode As Long)

Const TH32CS_SNAPHEAPLIST = &H1
Const TH32CS_SNAPPROCESS = &H2
Const TH32CS_SNAPTHREAD = &H4
Const TH32CS_SNAPMODULE = &H8
Const TH32CS_SNAPALL = (TH32CS_SNAPHEAPLIST Or TH32CS_SNAPPROCESS Or TH32CS_SNAPTHREAD Or TH32CS_SNAPMODULE)
Const TH32CS_INHERIT = &H80000000
Const PROCESS_TERMINATE = &H1

Public Const MAX_PATH As Integer = 260

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

Sub ListaProgMem()
    Dim uProcess As PROCESSENTRY32
    uProcess.dwSize = Len(uProcess)
    
    hSnapShot = CreateToolhelpSnapshot(TH32CS_SNAPALL, 0&)
    If hSnapShot <> 0 Then
        rProcess = ProcessFirst(hSnapShot, uProcess)
        Do While rProcess
            tPID = uProcess.th32ProcessID
            tMID = uProcess.th32ModuleID
            Debug.Print RemoveChr0(uProcess.szExeFile), uProcess.th32ProcessID
            ComparaLista RemoveChr0(uProcess.szExeFile), uProcess.th32ProcessID
            uProcess.szExeFile = String(MAX_PATH, Chr(0))
            rProcess = ProcessNext(hSnapShot, uProcess)
        Loop
    End If
End Sub

Function ComparaLista(ByVal Processo As String, ByVal PID As Long)
    lista = Split("CALC.EXE;NOTEPAD.EXE", ";")
    For Each programa In lista
        If LCase(programa) = LCase(Processo) Then
            RemoveProgMem PID
        End If
    Next
End Function

Function RemoveChr0(ByVal cString As String)
    RemoveChr0 = Replace(cString, Chr(0), "")
End Function

Sub RemoveProgMem(ByVal PID As Long)
    Dim ProTemp As String
    Dim lExitCode As Long
    lExitCode = 0

    hProcess = OpenProcess(PROCESS_TERMINATE, &H0, PID)
    If hProcess = 0 Then
        'Processo não existe
    Else
        lExitCode = GetExitCodeProcess(hProcess, 0)
        If lExitCode = 0 Then
            lExitCode = TerminateProcess(hProcess, 0)
        Else
            ExitProcess lExitCode
        End If
    End If
End Sub

Experimente agora. Ele fecha a Calculadora e o Bloco de Notas.

Abraços,

Graymalkin

[Guest Guest]

Funcionou, ta ótimo ... vou dar uma estudada nele pra ver as besteiras que fiz (rsss)

Olha, agradeço muito sua ajuda, valeu ...

Abraços,

Alexandre