Detection application ouverte

Version imprimable

11/03/2005, 10h49
elabbassi

Detection application ouverte

Bonjour
J'ai utilisé une fonction de detection d'application ouverte dans mon application,
Et à l'execution elle genere l'erreur suivante:
"Point d'entrée RegistreServiceProcess d'une DLL introuvable dans kernel32".
Merci de m'aider à resoudre ce problème.
Ou si qlq'un à une autre solution, merci de me la poster.
11/03/2005, 11h02
HPJ

Donne nous les lignes de tes intructions Declare.

Code:

1
2
3
4
5
6
7
8
9
 
Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal blnheritHandle As Long, ByVal dwAppProcessId As Long) As Long
Declare Function ProcessFirst Lib "kernel32" Alias "Process32First" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
Declare Function ProcessNext Lib "kernel32" Alias "Process32Next" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
Declare Function TerminateProcess Lib "kernel32" (ByVal ApphProcess As Long, ByVal uExitCode As Long) As Long
Declare Function CreateToolhelpSnapshot Lib "kernel32" Alias "CreateToolhelp32Snapshot" (ByVal lFlags As Long, lProcessID As Long) As Long
 
Declare Function RegisterServiceProcess Lib "kernel32" (ByVal ProcessID As Long, ByVal ServiceFlags As Long) As Long
Declare Function GetCurrentProcessId Lib "kernel32" () As Long

11/03/2005, 11h15
HPJ

RegisterServiceProcess n'existe que sous Windows 9x
11/03/2005, 11h40
elabbassi

Et que dois-je faire avec win2000 et winxp?

Dans un projet, j'ai mis un formulaire nommé Form1 avec un bouton dessus
avec comme code dans le formulaire :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 Private Sub Command1_Click() Unload Form1 End End Sub Private Sub Form_Load() If App.PrevInstance Then ' cherche une instance de programme précédente MsgBox "Le programme est déjà lancé, cliquez sur Ok puis utilisez ALT+TAB pour basculer sur le programme", vbOKOnly Unload Form1 End End If End Sub
en le compilant, puis en le l'éxécutant, seul la première instance du programme s'éxécute

voila voila

11/03/2005, 15h53
elabbassi

Mon but moi c'est de tester est ce que outlook est chargé ou non,
si non, charge le.
11/03/2005, 15h55
HPJ

Pour faire ça, tu n'as pas besoin de la fonction RegisterServiceProcess.

bon, alors pour scruter la liste des appli qui tourne sur mes postes, j'utilise ceci :

dans un module de déclaration :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
Public Const max_path = 260
 
' structure d'information sur les process
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
 
' structure d'information sur les threads
Public Type THREADENTRY32
    dwSize As Long
    cntUsage As Long
    th32ThreadID As Long
    th32OwnerProcessID As Long
    tpBasePri As Long
    tpDeltaPri As Long
    dwFlags As Long
End Type
 
' acces aux process et thread de windows
Public Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal handle As Long, ByVal id As Long) As Long
Public Declare Sub CloseHandle Lib "kernel32" (ByVal hpass As Long)
'info sur les process
Public Declare Function Process32First Lib "kernel32" (ByVal handle As Long, pointeur As PROCESSENTRY32) As Long
Public Declare Function Process32Next Lib "kernel32" (ByVal handle As Long, pointeur As PROCESSENTRY32) As Long
'info sur les threads
Public Declare Function Thread32First Lib "kernel32" (ByVal handle As Long, pointeur As THREADENTRY32) As Long
Public Declare Function Thread32Next Lib "kernel32" (ByVal handle As Long, pointeur As THREADENTRY32) As Long
'info sur les fenetres
Public Declare Function GetWindowTextA Lib "user32" (ByVal handle As Long, ByVal lpstring As String, ByVal cch As Long) As Long
Public Declare Function GetDesktopWindow Lib "user32" () As Long
Public Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Public Declare Function GetLastError Lib "kernel32" () As Long
 
 
Public retour As PROCESSENTRY32
Public monthread As THREADENTRY32

et dans mon formulaire :
(avec un textbox en multi-ligne et avec les scrollbars)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
Private Sub Command1_Click()
    Dim titre_fenetre As String
    Dim handle As Long
    Dim procid As Long
    Dim nom_exe As String
    Dim explorer_ProcessID As Long
    Dim resul As Long
    Dim lg_titre_fenetre As Long
    Dim desktop_fenetre As Long
 
    Text1.Text = ""
    y = CreateToolhelp32Snapshot(2&, 0&)
    retour.dwSize = Len(retour)
    x = Process32First(y, retour)
    Do While x = 1
        nom_exe = Mid(retour.szExeFile & Chr(0), 1, InStr(1, retour.szExeFile, Chr(0), vbBinaryCompare) - 1)
        nom_exe = Mid(nom_exe, InStrRev(nom_exe, "\", -1, vbBinaryCompare) + 1, Len(nom_exe) - InStrRev(nom_exe, "\", -1, vbBinaryCompare) + 1)
        If (LCase(nom_exe) = "explorer.exe") Then
            ' sauvegarde de l'id du process explorer
            explorer_ProcessID = retour.th32ProcessID
        End If
        Text1.Text = Text1.Text & nom_exe & vbCrLf
        retour.dwSize = Len(retour)
        x = Process32Next(y, retour)
    Loop
    ' fermeture de l'handle snapshot
    CloseHandle (y)
 
    titre_fenetre = Space$(251)
    lg_titre_fenetre = 250
    desktop_fenetre = GetDesktopWindow()
    t = GetWindow(desktop_fenetre, 5)
    Do While t <> 0
        resul = GetWindowTextA(t, titre_fenetre, lg_titre_fenetre)
        If (resul > 11) Then
            If (LCase(Mid(titre_fenetre, 1, 10)) = "navigation") Then
                liste = liste & Mid(titre_fenetre, 1, resul) & " , "
            End If
        End If
        t = GetWindow(t, 2)
    Loop
End Sub

il te reste a trouvé dans la liste l'application que tu cherches ...

avec dans le form, ceci :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
Private Sub Command1_Click()
    Dim titre_fenetre As String
    Dim handle As Long
    Dim procid As Long
    Dim nom_exe As String
    Dim explorer_ProcessID As Long
    Dim resul As Long
    Dim lg_titre_fenetre As Long
    Dim desktop_fenetre As Long
 
    Text1.Text = ""
    y = CreateToolhelp32Snapshot(2&, 0&)
    retour.dwSize = Len(retour)
    x = Process32First(y, retour)
    Do While x = 1
        nom_exe = Mid(retour.szExeFile & Chr(0), 1, InStr(1, retour.szExeFile, Chr(0), vbBinaryCompare) - 1)
        nom_exe = Mid(nom_exe, InStrRev(nom_exe, "\", -1, vbBinaryCompare) + 1, Len(nom_exe) - InStrRev(nom_exe, "\", -1, vbBinaryCompare) + 1)
        If (LCase(nom_exe) = "explorer.exe") Then
            ' sauvegarde de l'id du process explorer
            explorer_ProcessID = retour.th32ProcessID
        End If
        Text1.Text = Text1.Text & nom_exe & vbCrLf
        retour.dwSize = Len(retour)
        x = Process32Next(y, retour)
    Loop
    ' fermeture de l'handle snapshot
    CloseHandle (y)
 
    titre_fenetre = Space$(251)
    lg_titre_fenetre = 250
    desktop_fenetre = GetDesktopWindow()
    t = GetWindow(desktop_fenetre, 5)
    Do While t <> 0
        resul = GetWindowTextA(t, titre_fenetre, lg_titre_fenetre)
        If (resul > 0) Then
'            If (LCase(Mid(titre_fenetre, 1, 10)) = "navigation") Then
                Text1.Text = Text1.Text & Mid(titre_fenetre, 1, resul) & vbCrLf
'                liste = liste & Mid(titre_fenetre, 1, resul) & " , "
'            End If
        End If
        t = GetWindow(t, 2)
    Loop
End Sub

c'est même carrément mieux ...

14/03/2005, 12h20
elabbassi
Bonjour,
J'ai fais ça pour ouvrir outlook, mais avant de l'ouvrir je dois tester est ce qu'il n'est pas déjà ouvert pour que je ne l'ouvre une 2ième fois
Code:

1 2 3 4 5 6 Dim AppliOutlook As Outlook.Application Set AppliOutlook = New Outlook.Application AppliOutlook.Quit AppliOutlook Set AppliOutlook = Nothing