Newsgroup: it.comp.appl.access
Titolo: Modulo per verificare se un processo è attivo in task manager (If - Then - Else)

Salve a tutti,
in questi giorni ho dovuto affrontare un problema per me nuovo,
lanciare un determinato programma sulla base di cosa avrei *trovato*
all'interno del task manager.
Dopo alcune peripezie ho risolto il problema creando in VB un bel modulozzo
che posto su questo NG in c.c. con la speranza che opssa essere di aiuto a
qualcuno di Voi.
=============
Option Explicit
Global Task(200) As Long
Global iTask As Integer
Global NewTask(10) As String
Global iNewTask As Integer
Global CercaTask As Boolean
Global gTrovato As Boolean
Global gNomeTask As String
Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal
lParam As Long) As Boolean
Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal
hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Declare Function GetWindowTextLength Lib "user32" Alias
"GetWindowTextLengthA" (ByVal hwnd As Long) As Long
Public Function EnumWindowsProc(ByVal hwnd As Long, ByVal lParam As Long) As
Boolean
Dim sSave As String, Ret As Long
Dim Trovato As Boolean
Dim I As Integer
Ret = GetWindowTextLength(hwnd)
sSave = Space(Ret)
GetWindowText hwnd, sSave, Ret + 1
If UCase(sSave) = gNomeTask Then gTrovato = True
EnumWindowsProc = True
End Function
Sub Main()
Dim obj As Object
Dim LancioBat
Dim RetVal As Single
On Error GoTo Errore
gTrovato = False
gNomeTask = "QUIQUOQUA"
EnumWindows AddressOf EnumWindowsProc, ByVal 0&
If Not gTrovato Then
  RetVal = Shell("c:\dir1\paperino.bat", vbHide)
Else
  RetVal = Shell("c:\dir2\gastone.exe", vbHide)
End If
End
Exit Sub
Errore:
MsgBox "Errore: " & Err.Number & vbCrLf & Err.Description
End
End Sub
=============
Buona giornata,
--
strano...mavero

Bravo!!!
MAssimiliano 


...beh alla fine o facevo la cosa giusta o dovevo optare per una protesi
dentale ... ho preferito quindi tener mano al portafoglio!
--
strano...mavero

 strano...mavero
Le migliorie delle frequentazioni giuste si vedono ;-)
-- 
Ciao
Pablitomf (Maurizio Facciuti)
Access : Ver.97 - 2K
----------------------------------
http://www.accessgroup.it/
http://www.sitocomune.com/
----------------------------------
Non mi fido molto delle statistiche, perchč un uomo con la testa nel forno
acceso e i piedi nel congelatore statisticamente ha una temperatura media.
questo articolo e` stato inviato via web dal servizio gratuito 
http://www.newsland.it/news
 segnala gli abusi ad 
ab...@newsland.it


Grazie!
Purtroppo ora avrò meno elasticità e potrò partecipare meno attivamente alle
giornate del NG, sia in qualità di richiedente che di offerente ... però
tutti i 3d vengono scaricati e costoditi gelosamente all'interno del mio
Thunderbird!!!
--
strano...mavero

 Le migliorie delle frequentazioni giuste si vedono ;-)
Anche se... anche se...
L'istanza implicita creata dall'AddressOf sul 97 non "mi" funzia. 
"EnumWindows AddressOf EnumWindowsProc, ByVal 0&"
Hai riferimenti aggiuntivi?


 ha scritto nel messaggio
news:cvvgsu$2vl$1...@news.newsland.it...

l'ho implementato in VB6 ... se vuoi ti mando il vbp per posta e ci fai i
tuoi test ...
... su access non credo di aver tempo di fare test in questi giorni e poi
era necessario per me ottenere
un file di tipo exe (in questa circostanza).
Fammi sapere via mail al massim, ok?
..
strano...mavero

 ha scritto nel messaggio 
news:42233...@x-privat.org...

Complimenti per lo sforzo e il risultato.
Voglio dare anche io il mio contributo con questo modulo che può servire 
allo scopo,
ed è pronto per Access:
Option Compare Database
Option Explicit
      Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal 
wCmd As Long) As Long
      Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" 
(ByVal hwnd As Long, ByVal lpString As String, ByVal CCh As Long) As Long
      Declare Function IsWindowVisible Lib "user32" (ByVal hwnd As Long) As 
Long
      Public Const GW_HWNDFIRST = 0
      Public Const GW_HWNDLAST = 1
      Public Const GW_HWNDNEXT = 2
      Public Const GW_HWNDPREV = 3
Function GetAppName(Lnghwnd As Long)
            Dim LngResult As Long
            Dim StrWinText As String * 255
            Dim LngCCh As Long
         LngResult = GetWindowText(Lnghwnd, StrWinText, 255)
         GetAppName = Left(StrWinText, LngResult)
End Function
            'Esempio:   GetCountOfWindows(hWndAccessApp,"Microsoft Access")
Function GetCountOfWindows(Lnghwnd, StrAppCaption)
    Dim LngResult As Long
    Dim LngICount As Long
    Dim StrAppName As String
         LngResult = GetWindow(Lnghwnd, GW_HWNDFIRST)
         Do Until LngResult = 0
         If IsWindowVisible(LngResult) Then
               StrAppName = GetAppName(LngResult)
               If InStr(1, StrAppName, "PSWIN ver. 8.0") Then
                  LngICount = LngICount + 1
                  End If
            End If
            LngResult = GetWindow(LngResult, GW_HWNDNEXT)
         Loop
         GetCountOfWindows = LngICount
End Function
Function VerificaAperti() As Boolean
'procedura per verificare se è stata aperta un'altra applicazione con lo 
stesso nome
      If GetCountOfWindows(hWndAccessApp, "NomeTuaApplicazione") > 1 Then
        'Cancel = True
        'MsgBox "E' possibile aprire una sola volta il programma." & Chr(13) 
& _
        '        "Verificare sulla barra di stato. Esiste una" & Chr(13) & _
        '        "copia già aperta del programma."
        'DoCmd.Quit acQuitSaveNone
        VerificaAperti = True
        End If
End Function
Ciao, Carlo 

 Access : Ver.97 - 2K
Ovviamente non esiste, ma si può Emulare, l'unica differenza
è che il Nome della Procedura va passato come Stringa.
Option Compare Database
Option Explicit
'---------------------------------------------------------------------------
----------------------------------------
'   Declarations
'
'   These function names were puzzled out by using DUMPBIN /exports
'   with VBA332.DLL and then puzzling out parameter names and types
'   through a lot of trial and error and over 100 IPFs in MSACCESS.EXE
'   and VBA332.DLL.
'
'   These parameters may not be named properly but seem to be correct in
'   light of the function names and what each parameter does.
'
'   EbGetExecutingProj: Gives you a handle to the current VBA project
'   TipGetFunctionId: Gives you a function ID given a function name
'   TipGetLpfnOfFunctionId: Gives you a pointer a function given its
function ID
'
'---------------------------------------------------------------------------
----------------------------------------
Private Declare Function GetCurrentVbaProject _
 Lib "vba332.dll" Alias "EbGetExecutingProj" _
 (hProject As Long) As Long
Private Declare Function GetFuncID _
 Lib "vba332.dll" Alias "TipGetFunctionId" _
 (ByVal hProject As Long, ByVal strFunctionName As String, _
 ByRef strFunctionId As String) As Long
Private Declare Function GetAddr _
 Lib "vba332.dll" Alias "TipGetLpfnOfFunctionId" _
 (ByVal hProject As Long, ByVal strFunctionId As String, _
 ByRef lpfn As Long) As Long
'---------------------------------------------------------------------------
----------------------------------------
'   AddrOf
'
'   Returns a function pointer of a VBA public function given its name. This
function
'   gives similar functionality to VBA as VB5 has with the AddressOf param
type.
'
'   NOTE: This function only seems to work if the proc you are trying to get
a pointer
'       to is in the current project. This makes sense, since we are using a
function
'       named EbGetExecutingProj.
'---------------------------------------------------------------------------
----------------------------------------
Public Function AddrOf(strFuncName As String) As Long
    Dim hProject As Long
    Dim lngResult As Long
    Dim strID As String
    Dim lpfn As Long
    Dim strFuncNameUnicode As String
    Const NO_ERROR = 0
    ' The function name must be in Unicode, so convert it.
    strFuncNameUnicode = StrConv(strFuncName, vbUnicode)
    ' Get the current VBA project
    ' The results of GetCurrentVBAProject seemed inconsistent, in our tests,
    ' so now we just check the project handle when the function returns.
    Call GetCurrentVbaProject(hProject)
    ' Make sure we got a project handle... we always should, but you never
know!
    If hProject <> 0 Then
        ' Get the VBA function ID (whatever that is!)
        lngResult = GetFuncID( _
         hProject, strFuncNameUnicode, strID)
        ' We have to check this because we GPF if we try to get a function
pointer
        ' of a non-existent function.
        If lngResult = NO_ERROR Then
            ' Get the function pointer.
            lngResult = GetAddr(hProject, strID, lpfn)
            If lngResult = NO_ERROR Then
                AddrOf = lpfn
            End If
        End If
    End If
End Function
-- 
@Alex (Alessandro Baraldi)
---------------------------------------------------------------------------
http://www.sitocomune.com/
http://www.mantuanet.it/alessandro.baraldi/
---------------------------------------------------------------------------


Ciao Pablitomf,
Per Access97 devi farti una funzione che interroga la Dll vba332
una delle tante (la prima che mi č capitata)
--------------
http://access.jessy.free.fr/htm/Equivalence/AddrOf.htm
-------------
Poi la usi cosě
----------
EnumWindows AddrOf(" EnumWindowsProc"), ByVal 0&"
----------
Da Access2000 in avanti AddressOf  fa parte del linguaggio.
Ciao Giorgio