DUVIDA COM TIMER

BRUNOMOMESSO 07/06/2011 20:42:24
#376113
Boa noite, como posso criar um timer para verificar se um programa foi aberto e se aberto o mesmo será fechado
TECLA 07/06/2011 20:49:53
#376115 Resposta escolhida
Você já tem a rotina que faz a verificação?
BRUNOMOMESSO 07/06/2011 21:15:52
#376119
nao TECLA, essa é minha duvida pois nunca mechi com isso neh
GANDA.NICK 08/06/2011 01:22:32
#376134
olá bruno, não sei trabalhar muito bem com API[ô]s mas vê se é isto que vc precisa:

  Private Declare Function FindWindow Lib [Ô]user32[Ô] Alias [Ô]FindWindowA[Ô] (ByVal lpclassname As String, ByVal lpWindowName As String) As Long
Private Declare Function PostMessage Lib [Ô]user32[Ô] Alias [Ô]PostMessageA[Ô] (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Const WM_CLOSE = &H10
Dim vIdApp As Long

Private Function fActivateWindowClass(psClassname As String) As Boolean
Dim hWnd As Long
    hWnd = FindWindow(psClassname, vbNullString)
    If hWnd > 0 Then fActivateWindowClass = True Else fActivateWindowClass = False
    vIdApp = hWnd
End Function 


 Private Sub Timer1_Timer()
If fActivateWindowClass([Ô]notepad[Ô]) = True Then
    PostMessage vIdApp, WM_CLOSE, 0&, 0&
    MsgBox [Ô]fechou a aplicação[Ô]
Else
    MsgBox [Ô]A aplicação não está aberta[Ô]
End If
End Sub




não esqueça de mudar a propriedade [Ô]interval[Ô] do timer sabendo que 1000 é 1 segundo

com o bloco de notas funciona certinho, se não der com a aplicação que vc pretende dê uma vista de olhos em como trabalhar com a Function FindWindow.


té +
BRUNOMOMESSO 08/06/2011 06:26:17
#376135
Não funcionou nao e seria uma sequencia de arquivos
BRUNOMOMESSO 09/06/2011 21:26:23
#376366
bom problema resolvido com isso


[ô]Modulo

Option Explicit

Private Declare Function CloseHandle Lib [Ô]Kernel32.dll[Ô] (ByVal Handle 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 TerminateProcess Lib [Ô]kernel32[Ô] (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function CreateToolhelpSnapshot Lib [Ô]kernel32[Ô] Alias [Ô]CreateToolhelp32Snapshot[Ô] (ByVal lFlags As Long, lProcessID As Long) As Long
Private Declare Function ProcessFirst Lib [Ô]kernel32[Ô] Alias [Ô]Process32First[Ô] (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function ProcessNext Lib [Ô]kernel32[Ô] Alias [Ô]Process32Next[Ô] (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function GetVersionExA Lib [Ô]kernel32[Ô] (lpVersionInformation As OSVERSIONINFO) As Integer

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
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
Private Const PROCESS_ALL_ACCESS = 0
Private Const TH32CS_SNAPPROCESS As Long = 2&

Private Const WINNT As Integer = 2
Private Const WIN98 As Integer = 1

Public KillAppReturn As Boolean
Public Function getVersion() As Integer
Dim udtOSInfo As OSVERSIONINFO
Dim intRetVal As Integer

With udtOSInfo
.dwOSVersionInfoSize = 148
.szCSDVersion = Space$(128)
End With

intRetVal = GetVersionExA(udtOSInfo)

getVersion = udtOSInfo.dwPlatformId
End Function

Public Function Killapp(myName As String)
Select Case getVersion()
Case WIN98
Killapp9X (myName)
Case WINNT
KillappNT (myName)
End Select
End Function

Private Function KillappNT(myName As String)
Dim uProcess As PROCESSENTRY32
Dim rProcessFound As Long
Dim hSnapshot As Long
Dim szExename As String
Dim exitCode As Long
Dim myProcess As Long
Dim AppKill As Boolean
Dim appCount As Integer
Dim I As Integer
On Local Error GoTo Finish
appCount = 0
uProcess.dwSize = Len(uProcess)
hSnapshot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0&)
rProcessFound = ProcessFirst(hSnapshot, uProcess)
Do While rProcessFound
I = InStr(1, uProcess.szExeFile, Chr(0))
szExename = LCase$(Left$(uProcess.szExeFile, I - 1))
If Right$(szExename, Len(myName)) = LCase$(myName) Then
KillAppReturn = True
appCount = appCount + 1
myProcess = OpenProcess(1&, -1&, uProcess.th32ProcessID)
AppKill = TerminateProcess(myProcess, 0&)
Call CloseHandle(myProcess)
End If
rProcessFound = ProcessNext(hSnapshot, uProcess)
Loop
Call CloseHandle(hSnapshot)
Finish:
KillAppReturn = False
End Function

Private Function Killapp9X(myName As String)
Dim uProcess As PROCESSENTRY32
Dim rProcessFound As Long
Dim hSnapshot As Long
Dim szExename As String
Dim exitCode As Long
Dim myProcess As Long
Dim AppKill As Boolean
Dim appCount As Integer
Dim I As Integer
On Local Error GoTo Finish
appCount = 0
uProcess.dwSize = Len(uProcess)
hSnapshot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0&)
rProcessFound = ProcessFirst(hSnapshot, uProcess)
Do While rProcessFound
I = InStr(1, uProcess.szExeFile, Chr(0))
szExename = LCase$(Left$(uProcess.szExeFile, I - 1))
If Right$(szExename, Len(myName)) = LCase$(myName) Then
KillAppReturn = True
appCount = appCount + 1
myProcess = OpenProcess(PROCESS_ALL_ACCESS, False, uProcess.th32ProcessID)
AppKill = TerminateProcess(myProcess, exitCode)
Call CloseHandle(myProcess)
End If
rProcessFound = ProcessNext(hSnapshot, uProcess)
Loop
Call CloseHandle(hSnapshot)
Finish:
KillAppReturn = False
End Function


[ô]form

Private Sub Timer1_Timer()
Killapp [Ô]notepad.exe[Ô]
End Sub

mas isso seria temporario por enquanto pq c ele mudar o nome do exe passaria pelo programa do mesmo modo

agora é tentar formas novas, como c ele modificar algo em run-time do programa criado por terceiro ele fecharia ou algo do tipo
Tópico encerrado , respostas não são mais permitidas
Voltar