FINALIZAR TAREFAS

USUARIO.EXCLUIDOS 19/12/2003 12:30:52
#1740
como faço para para fechar progamas.

estou precisando assim sempre que eu for desligar o meu computador basta eu executar este mine progama e ele tratará de fechar todos os progamas que abrir e à± fechei

Agradeço, feliz natal e um feliz ano novo[S36]
LIONDAS 19/12/2003 14:47:34
#1754
Resposta escolhida
Cole o código abaixo em um arquivo de classe :




Option Explicit

Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal dwFlags As Long, ByVal dwIdProc As Long) As Long
Private Declare Function Process32First Lib "kernel32" (ByVal hndl As Long, ByRef pstru As PROCESSENTRY32) As Boolean
Private Declare Function Process32Next Lib "kernel32" (ByVal hndl As Long, ByRef pstru As PROCESSENTRY32) As Boolean
Private Declare Function CloseHandle Lib "kernel32" (ByVal hnd As Long) As Boolean
Private Declare Function GetLastError Lib "kernel32" () As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long

Private Const TH32CS_SNAPPROCESS = &H2
Private Const PROCESS_TERMINATE = &H1
Private lExitCode As Long

Private 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 * 260
End Type


'FUNCOES AUXILIARES ################################################################

'Atualiza a lista de processos
Public Function ListaProcessos() As Variant
Dim nLen As Integer
Dim bRet As Boolean
Dim hSnap As Long
Dim nCont As Long
Dim Processo As PROCESSENTRY32


Dim aNome As Variant
Dim aPath As Variant
Dim aResp As Variant

nCont = 0
ReDim aNome(0) As String
ReDim aPath(0) As String

hSnap = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)
Processo.dwSize = Len(Processo)
bRet = Process32First(hSnap, Processo)
If bRet Then
ReDim Preserve aNome(0) As String
ReDim Preserve aPath(0) As String
aNome(nCont) = GetNome(Trim(Processo.szExeFile))
aPath(nCont) = GetPath(Trim(Processo.szExeFile))
End If
Do While bRet
nCont = nCont + 1
bRet = Process32Next(hSnap, Processo)
If bRet Then
ReDim Preserve aNome(0 To nCont) As String
ReDim Preserve aPath(0 To nCont) As String
aNome(nCont) = GetNome(Trim(Processo.szExeFile))
aPath(nCont) = GetPath(Trim(Processo.szExeFile))
End If
DoEvents
Loop
bRet = CloseHandle(hSnap)

ReDim aResp(LBound(aNome) To UBound(aNome), 0 To 1) As String
For nCont = LBound(aNome) To UBound(aNome)
aResp(nCont, 0) = aNome(nCont)
aResp(nCont, 1) = aPath(nCont)
Next

ListaProcessos = aResp

End Function

'Finaliza um processo
Public Function KillProcesso(ByVal sArquivo As String) As Boolean
Dim bFind As Boolean
Dim bRet As Boolean
Dim hSnap As Long
Dim hProcess As Variant
Dim p32stru As PROCESSENTRY32
bFind = False
hSnap = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)
p32stru.dwSize = Len(p32stru)
bRet = Process32First(hSnap, p32stru)
If bRet Then If GetNome(Trim(p32stru.szExeFile)) = sArquivo Then bFind = True
Do While (Not bFind) And (bRet)
bRet = Process32Next(hSnap, p32stru)
If bRet Then If UCase(GetNome(Trim(p32stru.szExeFile))) = UCase(sArquivo) Then bFind = True
DoEvents
Loop
bRet = CloseHandle(hSnap)
KillProcesso = True
If bFind Then
hProcess = OpenProcess(PROCESS_TERMINATE, CLng(False), CLng("&h" & Hex$(p32stru.th32ProcessID)))
If hProcess 0 Then
If GetExitCodeProcess(hProcess, lExitCode) = 0 Then
KillProcesso = False
Else
If TerminateProcess(hProcess, lExitCode) = 0 Then KillProcesso = False
End If
End If
End If
End Function

Private Function GetNome(ByVal sArq As String) As String
sArq = LimpaString(sArq, 0)
Dim ID As Long
For ID = Len(sArq) To 1 Step -1
If Mid$(sArq, ID, 1) = "\" Then
GetNome = Right$(sArq, Len(sArq) - ID)
Exit For
End If
Next ID
ID = InStr(1, GetNome, ".")
GetNome = Left(GetNome, ID + 3)
End Function

Private Function GetPath(ByVal sArq As String) As String
sArq = LimpaString(sArq, 0)
Dim ID As Long
For ID = Len(sArq) To 1 Step -1
If Mid$(sArq, ID, 1) = "\" Then
GetPath = Left(sArq, ID)
Exit For
End If
Next ID
End Function

Private Function LimpaString(ByVal sArq As String, ByVal nAsc As Byte) As String
Dim ID As Long
LimpaString = ""
For ID = 1 To Len(sArq)
If Asc(Mid(sArq, ID, 1)) nAsc Then LimpaString = LimpaString & Mid(sArq, ID, 1)
Next ID
End Function

Tópico encerrado , respostas não são mais permitidas