Newsgroup: it.comp.lang.visual-basic
Titolo: ricavare il numero di istanze avviate di un applicativo

Ciao,
volevo sapere come era possibile ricavare il numero di istanze attive di un 
programma.
so che con app.PrevInstance posso sapere se è già stato avviato il 
programma.. ma come faccio a identificare il numero di istanze?
grazie
Dav

 ha scritto nel messaggio
news:Xns9619AFD5...@130.133.1.4...

non ho avuto tempo per verificare il tutto comunque incolla il seguente
codice in un modulo, se hai problemi chiedimi pure
ciao.
Option Explicit
      Public Const PROCESS_QUERY_INFORMATION = 1024
      Public Const PROCESS_VM_READ = 16
      Public Const MAX_PATH = 260
      Public Const STANDARD_RIGHTS_REQUIRED = &HF0000
      'STANDARD_RIGHTS_REQUIRED Or SYNCHRONIZE Or &HFFF
      Public Const PROCESS_ALL_ACCESS = &H1F0FFF
      Public Const TH32CS_SNAPPROCESS = &H2&
      Public Const hNull = 0
      Private Type PROCESSENTRY32
         dwSize As Long
         cntUsage As Long
         th32ProcessID As Long           ' This process
         th32DefaultHeapID As Long
         th32ModuleID As Long            ' Associated exe
         cntThreads As Long
         th32ParentProcessID As Long     ' This process's parent process
         pcPriClassBase As Long          ' Base priority of process threads
         dwFlags As Long
         szExeFile As String * 260       ' MAX_PATH
      End Type
     Private Type OSVERSIONINFO
         dwOSVersionInfoSize As Long
         dwMajorVersion As Long
         dwMinorVersion As Long
         dwBuildNumber As Long
         dwPlatformId As Long
         szCSDVersion As String * 128
                                                '1 = Windows 95.
    End Type                                  '2 = Windows NT
Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" ( _
   ByVal dwFlags As Long, ByVal th32ProcessID 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
'// costanti tratte da : HOWTO: Constants in OpenProcess API dsDesiredAccess
Parameter
'// 
http://support.microsoft.com/support/kb/articles/q172/2/73.asp?FR=0
Private Const PROCESS_TERMINATE = &H1 'Enables using the process handle in
the
            'TerminateProcess function to terminate the process.
Private Const SYNCHRONIZE = &H100000   'Enables using the process handle in
any of the
            'wait functions to wait for the process to terminate.
'// costanti recuperate con Google
Private Const WAIT_OBJECT_0 = 0&
'// costante di comodo per mappatura con il codice c++
Private Const pNULL = 0&
'// dichiarazioni tratte dall' API viewer di vb
'      --- kernel32
      Public Declare Function EnumProcesses Lib "psapi.dll" _
         (ByRef lpidProcess As Long, ByVal cb As Long, _
            ByRef cbNeeded 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 Declare Function Process32First Lib "kernel32" ( _
         ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long
      Public Declare Function Process32Next Lib "kernel32" ( _
         ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long
Private Declare Function CloseHandle Lib "kernel32" ( _
                        ByVal hObject As Long _
                        ) 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 TerminateProcess Lib "kernel32" ( _
                        ByVal hProcess As Long, _
                        ByVal uExitCode As Long _
                        ) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" ( _
                        ByVal hHandle As Long, _
                        ByVal dwMilliseconds As Long _
                        ) As Long
'       --- user32
Private Declare Function EnumWindows Lib "user32" ( _
                        ByVal lpEnumFunc As Long, _
                        ByVal lParam As Long _
                        ) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" ( _
                        ByVal hwnd As Long, _
                        ByRef lpdwProcessId As Long _
                        ) As Long
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" ( _
                        ByVal hwnd As Long, ByVal wMsg As Long, _
                        ByVal wParam As Long, ByVal lParam As Long _
                        ) As Long
Public Declare Function GetVersionExA Lib "kernel32" _
         (lpVersionInformation As OSVERSIONINFO) As Integer
Private Const WM_CLOSE = &H10
Public Function ContaIstanze(exeName As String) As Long
      Dim strAppo As String
      Dim iRet As Long
      Select Case getVersion()
      Case 1 'Windows 95/98
         Dim f As Long, sname As String
         Dim hSnap As Long, proc As PROCESSENTRY32
         hSnap = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)
         If hSnap = hNull Then Exit Function
         proc.dwSize = Len(proc)
         ' Iterate through the processes
         f = Process32First(hSnap, proc)
         Do While f
           sname = StrZToStr(proc.szExeFile)
           f = Process32Next(hSnap, proc)
         Loop
      Case 2 'Windows NT
         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 200) As Long
         Dim lRet As Long
         Dim ModuleName As String
         Dim nSize As Long
         Dim hProcess As Long
         Dim i As Long
         'Get the array containing the process id's for each process object
         cb = 8
         cbNeeded = 96
         Do While cb <= cbNeeded
            cb = cb * 2
            ReDim ProcessIDs(cb / 4) As Long
            lRet = EnumProcesses(ProcessIDs(1), cb, cbNeeded)
         Loop
         NumElements = cbNeeded / 4
         For i = 1 To NumElements
            'Get a handle to the Process
            hProcess = OpenProcess(PROCESS_QUERY_INFORMATION _
               Or PROCESS_VM_READ, 0, ProcessIDs(i))
            'Got a Process handle
            If hProcess <> 0 Then
                'Get an array of the module handles for the specified
                'process
                lRet = EnumProcessModules(hProcess, Modules(1), 200, _
                                             cbNeeded2)
                'If the Module Array is retrieved, Get the ModuleFileName
                If lRet <> 0 Then
                   ModuleName = Space(MAX_PATH)
                   nSize = 500
                   lRet = GetModuleFileNameExA(hProcess, Modules(1),
ModuleName, nSize)
                        strAppo = Left(ModuleName, lRet)
                        If LCase(Right(strAppo, Len(exeName))) =
LCase(exeName) Then
                            iRet = iRet + 1
                        End If
                End If
            End If
          'Close the handle to the process
         lRet = CloseHandle(hProcess)
         Next
        ContaIstanze = iRet
      End Select
      End Function
     Private Function getVersion() As Long
         Dim osinfo As OSVERSIONINFO
         Dim retvalue As Integer
         osinfo.dwOSVersionInfoSize = 148
         osinfo.szCSDVersion = Space$(128)
         retvalue = GetVersionExA(osinfo)
         getVersion = osinfo.dwPlatformId
      End Function
      Private Function StrZToStr(s As String) As String
         StrZToStr = Left$(s, Len(s) - 1)
      End Function

 codice in un modulo, se hai problemi chiedimi pure
grazie funziona perfettamente :)
sei stato fin troppo gentile.. davvero:)
grazie 1000

 ha scritto nel messaggio
news:Xns961A6A02...@130.133.1.4...

prego, ciao ;-)

 prego, ciao ;-)
;)
di seguito la routine corretta per funzionare anche in win9X/ME
Public Function ContaIstanze(exeName As String) As Long
Dim strAppo As String
Dim iRet As Long
Dim f As Long, sname As String
Dim hSnap As Long, proc As PROCESSENTRY32
'
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 200) As Long
Dim lRet As Long
Dim ModuleName As String
Dim nSize As Long
Dim hProcess As Long
Dim i As Long
    Select Case GetVersion()
 
        Case 1 'Windows 95/98
 
            hSnap = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)
            If hSnap = hNull Then Exit Function
            proc.dwSize = Len(proc)
            ' Iterate through the processes
            f = Process32First(hSnap, proc)
            iRet = 0
            Do While f
                sname = StrZToStr(proc.szExeFile)
                If Len(sname) >= Len(exeName) Then
                    If UCase(Left(sname, Len(exeName))) = UCase(exeName) 
Then
                        iRet = iRet + 1
                    End If
                End If
                f = Process32Next(hSnap, proc)
 
            Loop
 
        Case 2 'Windows NT
 
 
            'Get the array containing the process id's for each process 
object
            cb = 8
            cbNeeded = 96
            Do While cb <= cbNeeded
                cb = cb * 2
                ReDim ProcessIDs(cb / 4) As Long
                lRet = EnumProcesses(ProcessIDs(1), cb, cbNeeded)
            Loop
            NumElements = cbNeeded / 4
 
            For i = 1 To NumElements
                'Get a handle to the Process
                hProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or 
PROCESS_VM_READ, 0, ProcessIDs(i))
                'Got a Process handle
                If hProcess <> 0 Then
                    'Get an array of the module handles for the specified
                    'process
                    lRet = EnumProcessModules(hProcess, Modules(1), 200, 
cbNeeded2)
 
                    If lRet <> 0 Then
                        ModuleName = Space(MAX_PATH)
                        nSize = 500
                        lRet = GetModuleFileNameExA(hProcess, Modules(1), 
ModuleName, nSize)
                        strAppo = Left(ModuleName, lRet)
 
                        If LCase(Right(strAppo, Len(exeName))) = LCase
(exeName) Then
                            iRet = iRet + 1
                        End If
                    End If
                End If
                'Close the handle to the process
                lRet = CloseHandle(hProcess)
            Next i
 
 
    End Select
 
    ContaIstanze = iRet
End Function