Fore vb6
majnounbella
Messages postés
3
Date d'inscription
mercredi 18 octobre 2006
Statut
Membre
Dernière intervention
1 décembre 2010
-
29 nov. 2007 à 13:32
cs_Exploreur Messages postés 4821 Date d'inscription lundi 11 novembre 2002 Statut Membre Dernière intervention 15 novembre 2016 - 29 nov. 2007 à 21:41
cs_Exploreur Messages postés 4821 Date d'inscription lundi 11 novembre 2002 Statut Membre Dernière intervention 15 novembre 2016 - 29 nov. 2007 à 21:41
A voir également:
- Getmodulefilenameexa
- Vb6 mid ✓ - Forum Visual Basic
- Vb6 split ✓ - Forum Visual Basic 6
- Datediff vb6 ✓ - Forum Visual Basic 6
- Vb6 decompiler - Forum Visual Basic 6
- Vb6 else if - Conseils pratiques -Visual Basic / VB.NET
5 réponses
pneau
Messages postés
258
Date d'inscription
mercredi 21 avril 2004
Statut
Membre
Dernière intervention
27 octobre 2010
5
29 nov. 2007 à 13:46
29 nov. 2007 à 13:46
salut,
un peu de politesse ne ferait pas de mal dans le message...
bref, pour répondre à ta question
Regardes le code ci-dessous...
ce dernier permet de scanner les process lancés
Option Explicit
'See also KB article Q175030
'===========================================================
'WINDOWS NT ONLY
'-----------------------------------------------------------
'PSAPI.DLL does not operate on Windows 95/98, use the
'ToolHelp32 APIs instead.
'Remember to distribute the PSAPI.DLL file (available in the
'Platform SDK. with any executable that uses it, as it is
'not currently distributed with the operating system.
'===========================================================
'Public Declare Function CloseHandle Lib "Kernel32.dll" _
' (ByVal Handle As Long) As Long
Public Declare Function OpenProcess Lib "Kernel32.dll" _
(ByVal dwDesiredAccessas As Long, ByVal bInheritHandle As Long, _
ByVal dwProcId As Long) As Long
Public Declare Function EnumProcesses Lib "psapi.dll" _
(ByRef lpidProcess As Long, ByVal cb As Long, _
ByRef cbNeeded As Long) As Long
Public Declare Function GetModuleFileNameExA Lib "psapi.dll" _
(ByVal hProcess As Long, ByVal hModule As Long, _
ByVal ModuleName As String, ByVal nSize As Long) As Long
Public Declare Function EnumProcessModules Lib "psapi.dll" _
(ByVal hProcess As Long, ByRef lphModule As Long, _
ByVal cb As Long, ByRef cbNeeded As Long) As Long
Public Const PROCESS_QUERY_INFORMATION = 1024
Public Const PROCESS_VM_READ = 16
Public Const MAX_PATH = 260
Public Const STANDARD_RIGHTS_REQUIRED = &HF0000
Public Const SYNCHRONIZE = &H100000
'STANDARD_RIGHTS_REQUIRED Or SYNCHRONIZE Or &HFFF
Public Const PROCESS_ALL_ACCESS = &H1F0FFF
Public Function FindProcess() As Boolean
'=========================================================
'Clears the listbox specified by the DestListBox parameter
'and then fills the list with the processes and the
'modules used by each process
'=========================================================
Dim cb As Long
Dim cbNeeded As Long
Dim NumElements As Long
Dim ProcessIDs() As Long
Dim cbNeeded2 As Long
Dim NumElements2 As Long
Dim Modules(1 To 1024) As Long
Dim lRet As Long
Dim ModuleName As String
Dim nSize As Long
Dim hProcess As Long
Dim i As Long
Dim sModName As String
Dim sChildModName As String
Dim iModDlls As Long
Dim iProcesses As Integer
Dim bProcessExist As Boolean
Dim stmpModule() As String
Dim sExeName As String
' DestListBox.Clear
'Get the array containing the process id's for each process object
cb = 8
cbNeeded = 96
'One important note should be made. Although the documentation
'names the returned DWORD "cbNeeded", there is actually no way
'to find out how big the passed in array must be. EnumProcesses()
'will never return a value in cbNeeded that is larger than the
'size of array value that you passed in the cb parameter.
'if cbNeeded == cb upon return, allocate a larger array
'and try again until cbNeeded is smaller than cb.
Do While cb <= cbNeeded
cb = cb * 2
ReDim ProcessIDs(cb / 4) As Long
lRet = EnumProcesses(ProcessIDs(1), cb, cbNeeded)
Loop
'calculate how many process IDs were returned
NumElements = cbNeeded / 4
Do While i <= NumElements
'Get a handle to the Process
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION _
Or PROCESS_VM_READ, 0, ProcessIDs(i))
' Iterate through each process with an ID that <> 0
If hProcess Then
'Retrieve the number of bytes that the array of module handles requires
lRet = EnumProcessModules(hProcess, Modules(1), 1024, cbNeeded2)
'Get an array of the module handles for the specified process
lRet = EnumProcessModules(hProcess, Modules(1), cbNeeded2, cbNeeded2)
'If the Module Array is retrieved, Get the ModuleFileName
If lRet <> 0 Then
'Fill the ModuleName buffer with spaces
ModuleName = Space(MAX_PATH)
'Preset buffer size
nSize = 500
'Get the module file name
lRet = GetModuleFileNameExA(hProcess, Modules(1), ModuleName, nSize)
'Get the module file name out of the buffer, lRet is how
'many characters the string is, the rest of the buffer is spaces
sModName = Left$(ModuleName, lRet)
stmpModule = Split(sModName, "")
sExeName = stmpModule(UBound(stmpModule))
'Add the process to the listbox
' DestListBox.AddItem sModName
'Increment the count of processes we've added
iProcesses = iProcesses + 1
iModDlls = 1
' Do
' iModDlls = iModDlls + 1
'
' 'Fill the ModuleName buffer with spaces
ModuleName = Space(MAX_PATH)
'
' 'Preset buffer size
' nSize = 500
'
' 'Get the module file name out of the buffer, lRet is how
' 'many characters the string is, the rest of the buffer is spaces
' lRet = GetModuleFileNameExA(hProcess, Modules(iModDlls), ModuleName, nSize)
' sChildModName = Left$(ModuleName, lRet)
'
' If sChildModName = sModName Then Exit Do
' If Trim(sChildModName) <> "" Then DestListBox.AddItem " " & sChildModName
' Loop
End If
Else
'Return the number of Processes found
'FillProcessListNT = 0
bProcessExist = False
End If
'Close the handle to the process
lRet = CloseHandle(hProcess)
i = i + 1
Loop
'Return the number of Processes found
End Function
A toi de l'adapter pour ton besoin
Pat
Don't Worry , Be Happy
<hr />
lorsque le problème est résolu, pensez Réponse Acceptée
un peu de politesse ne ferait pas de mal dans le message...
bref, pour répondre à ta question
Regardes le code ci-dessous...
ce dernier permet de scanner les process lancés
Option Explicit
'See also KB article Q175030
'===========================================================
'WINDOWS NT ONLY
'-----------------------------------------------------------
'PSAPI.DLL does not operate on Windows 95/98, use the
'ToolHelp32 APIs instead.
'Remember to distribute the PSAPI.DLL file (available in the
'Platform SDK. with any executable that uses it, as it is
'not currently distributed with the operating system.
'===========================================================
'Public Declare Function CloseHandle Lib "Kernel32.dll" _
' (ByVal Handle As Long) As Long
Public Declare Function OpenProcess Lib "Kernel32.dll" _
(ByVal dwDesiredAccessas As Long, ByVal bInheritHandle As Long, _
ByVal dwProcId As Long) As Long
Public Declare Function EnumProcesses Lib "psapi.dll" _
(ByRef lpidProcess As Long, ByVal cb As Long, _
ByRef cbNeeded As Long) As Long
Public Declare Function GetModuleFileNameExA Lib "psapi.dll" _
(ByVal hProcess As Long, ByVal hModule As Long, _
ByVal ModuleName As String, ByVal nSize As Long) As Long
Public Declare Function EnumProcessModules Lib "psapi.dll" _
(ByVal hProcess As Long, ByRef lphModule As Long, _
ByVal cb As Long, ByRef cbNeeded As Long) As Long
Public Const PROCESS_QUERY_INFORMATION = 1024
Public Const PROCESS_VM_READ = 16
Public Const MAX_PATH = 260
Public Const STANDARD_RIGHTS_REQUIRED = &HF0000
Public Const SYNCHRONIZE = &H100000
'STANDARD_RIGHTS_REQUIRED Or SYNCHRONIZE Or &HFFF
Public Const PROCESS_ALL_ACCESS = &H1F0FFF
Public Function FindProcess() As Boolean
'=========================================================
'Clears the listbox specified by the DestListBox parameter
'and then fills the list with the processes and the
'modules used by each process
'=========================================================
Dim cb As Long
Dim cbNeeded As Long
Dim NumElements As Long
Dim ProcessIDs() As Long
Dim cbNeeded2 As Long
Dim NumElements2 As Long
Dim Modules(1 To 1024) As Long
Dim lRet As Long
Dim ModuleName As String
Dim nSize As Long
Dim hProcess As Long
Dim i As Long
Dim sModName As String
Dim sChildModName As String
Dim iModDlls As Long
Dim iProcesses As Integer
Dim bProcessExist As Boolean
Dim stmpModule() As String
Dim sExeName As String
' DestListBox.Clear
'Get the array containing the process id's for each process object
cb = 8
cbNeeded = 96
'One important note should be made. Although the documentation
'names the returned DWORD "cbNeeded", there is actually no way
'to find out how big the passed in array must be. EnumProcesses()
'will never return a value in cbNeeded that is larger than the
'size of array value that you passed in the cb parameter.
'if cbNeeded == cb upon return, allocate a larger array
'and try again until cbNeeded is smaller than cb.
Do While cb <= cbNeeded
cb = cb * 2
ReDim ProcessIDs(cb / 4) As Long
lRet = EnumProcesses(ProcessIDs(1), cb, cbNeeded)
Loop
'calculate how many process IDs were returned
NumElements = cbNeeded / 4
Do While i <= NumElements
'Get a handle to the Process
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION _
Or PROCESS_VM_READ, 0, ProcessIDs(i))
' Iterate through each process with an ID that <> 0
If hProcess Then
'Retrieve the number of bytes that the array of module handles requires
lRet = EnumProcessModules(hProcess, Modules(1), 1024, cbNeeded2)
'Get an array of the module handles for the specified process
lRet = EnumProcessModules(hProcess, Modules(1), cbNeeded2, cbNeeded2)
'If the Module Array is retrieved, Get the ModuleFileName
If lRet <> 0 Then
'Fill the ModuleName buffer with spaces
ModuleName = Space(MAX_PATH)
'Preset buffer size
nSize = 500
'Get the module file name
lRet = GetModuleFileNameExA(hProcess, Modules(1), ModuleName, nSize)
'Get the module file name out of the buffer, lRet is how
'many characters the string is, the rest of the buffer is spaces
sModName = Left$(ModuleName, lRet)
stmpModule = Split(sModName, "")
sExeName = stmpModule(UBound(stmpModule))
'Add the process to the listbox
' DestListBox.AddItem sModName
'Increment the count of processes we've added
iProcesses = iProcesses + 1
iModDlls = 1
' Do
' iModDlls = iModDlls + 1
'
' 'Fill the ModuleName buffer with spaces
ModuleName = Space(MAX_PATH)
'
' 'Preset buffer size
' nSize = 500
'
' 'Get the module file name out of the buffer, lRet is how
' 'many characters the string is, the rest of the buffer is spaces
' lRet = GetModuleFileNameExA(hProcess, Modules(iModDlls), ModuleName, nSize)
' sChildModName = Left$(ModuleName, lRet)
'
' If sChildModName = sModName Then Exit Do
' If Trim(sChildModName) <> "" Then DestListBox.AddItem " " & sChildModName
' Loop
End If
Else
'Return the number of Processes found
'FillProcessListNT = 0
bProcessExist = False
End If
'Close the handle to the process
lRet = CloseHandle(hProcess)
i = i + 1
Loop
'Return the number of Processes found
End Function
A toi de l'adapter pour ton besoin
Pat
Don't Worry , Be Happy
<hr />
lorsque le problème est résolu, pensez Réponse Acceptée
cs_Exploreur
Messages postés
4821
Date d'inscription
lundi 11 novembre 2002
Statut
Membre
Dernière intervention
15 novembre 2016
15
29 nov. 2007 à 14:04
29 nov. 2007 à 14:04
Salut,
Pneau(salut) >> Il me semble qu'il y a plus court : App.PrevInstance, à voir...
A+
Exploreur
Linux a un noyau, Windows un pépin
Pneau(salut) >> Il me semble qu'il y a plus court : App.PrevInstance, à voir...
A+
Exploreur
Linux a un noyau, Windows un pépin
cs_Exploreur
Messages postés
4821
Date d'inscription
lundi 11 novembre 2002
Statut
Membre
Dernière intervention
15 novembre 2016
15
29 nov. 2007 à 14:24
29 nov. 2007 à 14:24
Re,
Comme cela :
Private Sub Form_Load()
If App.PrevInstance Then MsgBox "Application déjà lancer !": Unload Me
End Sub
A+
Exploreur
Linux a un noyau, Windows un pépin
Comme cela :
Private Sub Form_Load()
If App.PrevInstance Then MsgBox "Application déjà lancer !": Unload Me
End Sub
A+
Exploreur
Linux a un noyau, Windows un pépin
pneau
Messages postés
258
Date d'inscription
mercredi 21 avril 2004
Statut
Membre
Dernière intervention
27 octobre 2010
5
29 nov. 2007 à 14:35
29 nov. 2007 à 14:35
salut exploreur...
oui effectivement...mais pourquoi faire simple quand on peut faire compliqué...
au moins avec ce code il pourra controler si l'appli est lancée a partir d'un autre exe...
tchô
Pat
Don't Worry , Be Happy
<hr />lorsque le problème est résolu, pensez Réponse Acceptée
oui effectivement...mais pourquoi faire simple quand on peut faire compliqué...
au moins avec ce code il pourra controler si l'appli est lancée a partir d'un autre exe...
tchô
Pat
Don't Worry , Be Happy
<hr />lorsque le problème est résolu, pensez Réponse Acceptée
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
cs_Exploreur
Messages postés
4821
Date d'inscription
lundi 11 novembre 2002
Statut
Membre
Dernière intervention
15 novembre 2016
15
29 nov. 2007 à 21:41
29 nov. 2007 à 21:41
Salut à tous,
majnounbella >> Les codes proposés te convienne...?
A+
Exploreur
Linux a un noyau, Windows un pépin
majnounbella >> Les codes proposés te convienne...?
A+
Exploreur
Linux a un noyau, Windows un pépin
