FINALIZAR TAREFAS
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]
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]
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