Differenze tra le versioni di "Impedire l'avvio di un programma.gambas già avviato"

Da Gambas-it.org - Wikipedia.
(7 versioni intermedie di uno stesso utente non sono mostrate)
Riga 2: Riga 2:
  
  
<FONT color=#B22222>'''1)'''</font>
+
<FONT color=#B22222>'''1)'''</font> Si leggono i dati presenti nei file "cmdline" e "stat" presenti nella cartella del processo del programma (contenuta a sua volta nella cartella "/proc"):
 
+
  '''Public''' Sub Form_Activate()  <FONT color=gray>' ''oppure "'''Sub Main()'''" se il programma è a "linea di comando"''</font>
  '''Public''' Sub Form_Open()
+
 
   Dim sOutput As String
+
  Dim s, cmdline As String
+
   Dim id As New String[]
   Exec ["pgrep", "-f", "-l", "nome_programma.gambas"] Wait To sOutput
+
   
+
   For Each s In Dir("/proc", "*", gb.Directory)
  If Split(Trim$(sOutput), gb.NewLine).Count > 1 Then
+
    If Exist("/proc" &/ s &/ "cmdline") Then
  Quit
+
      cmdline = File.Load("/proc" &/ s &/ "cmdline")
   Endif
+
      If (cmdline Like "*" & Application.Name & ".gambas*") Then
+
        id.Push(Split(File.Load("/proc" &/ s &/ "stat"), Chr(32))[0])
 +
        If id.Count > 1 Then
 +
          If id[id.Max] > id[id.Max - 1] Then Quit
 +
        Endif     
 +
      Endif
 +
    Endif
 +
   Next
 +
   
 
  '''End'''
 
  '''End'''
 
  
  
  
 
<FONT color=#B22222>'''2)'''</font>
 
<FONT color=#B22222>'''2)'''</font>
 
+
<BR>Il seguente codice vale solo per programmi in ambiente grafico.
 +
<BR>E' necessario attivare il Componente ''gb.desktop''.
 
  '''Public''' Sub Form_Open()
 
  '''Public''' Sub Form_Open()
+
 
Dim index As String
+
  For i As Integer = 0 To Desktop.Windows.Count - 1
Dim plura As String[]
+
    If Desktop.Windows[i].Name = Application.Name Then Me.Close
Dim a, b As Integer
+
  Next
+
    
<FONT color=gray>' ''Otteniamo il PID dei processi (programmi) aperti, aventi il medesimo "nome_programma.gambas":''</font>
 
  Shell "ps -aux | grep " & "nome_programma.gambas" To index
 
 
  plura = Split(index, " ")
 
 
  For a = 0 To plura.Max
 
 
<FONT color=gray>' ''Cerca il riferimento al 1° programma aperto (cioè a quello con identico nome al proprio):''</font>
 
    If Right(plura[a], 20) Like "*.gambas*" Then
 
 
<FONT color=gray>' ''Così può passare a "Kill" la stringa, contenuta da ciascuna variabile "plura" successiva alle stringhe che si riferiscono al 1° processo (che resta così protetto), sino a quando non passerà la stringa contenente il PID del 2° processo (se è stato aperto il 2° programma), cioè... se stesso !''</font>
 
      For b = a To plura.Max
 
 
<FONT color=gray>' ''Non appena viene passato il PID del 2° processo, questo viene terminato.''
 
' ''Quindi il programma (se è il 2°) si auto-elimina e non si apre:''</font>
 
        Try Shell "kill " & plura[b]
 
      Next
 
 
    Endif
 
   NextEnd
 
 
 
  '''End'''
 
  '''End'''
 
  
  
  
 
<FONT color=#B22222>'''3)'''</font>
 
<FONT color=#B22222>'''3)'''</font>
 
+
<BR>Il seguente codice vale solo per programmi in ambiente grafico.
 +
<BR>E' necessario attivare il Componente ''gb.desktop''.
 
  '''Public''' Sub Form_Open()
 
  '''Public''' Sub Form_Open()
+
 
Dim P As New Pointer[]
+
  Dim ii As New Integer[]
+
 
   P = Desktop.FindWindow(Application.Name)
+
   ii = Desktop.FindWindow(Application.Name)
+
 
   If P.count = 0 Then   
+
   If ii.Count == 0 Then   
 
     message.info("applicazione non ancora avviata")   
 
     message.info("applicazione non ancora avviata")   
   Else If P.count > 0 Then   
+
   Else If ii.Count > 0 Then   
 
     message.info("applicazione già avviata !")   
 
     message.info("applicazione già avviata !")   
 
     FMain.Close
 
     FMain.Close
   End If
+
   End
 
    
 
    
 
  '''End'''
 
  '''End'''
  
  
 +
 +
<FONT color=#B22222>'''4)'''</font>
 +
'''Public''' Sub Form_Open()
 +
 
 +
  Dim sOutput As String
 +
 +
  Exec ["pgrep", "-f", "-l", "<FONT color=gray>nome_programma.gambas</font>"] Wait To sOutput
 +
 +
  If Split(Trim$(sOutput), gb.NewLine).Count > 1 Then Quit
 +
 +
'''End'''
  
  
<FONT color=#B22222>'''4)'''</font>
 
  
 +
<FONT color=#B22222>'''5)'''</font>
 
  '''Public''' Sub Form_Open()
 
  '''Public''' Sub Form_Open()
 
   
 
   
Dim risultato As String
+
  Dim index As String
Dim iRis As Byte
+
  Dim plura As String[]
   
+
  Dim a, b As Integer
   Shell "ps aux | grep " & "nome_programma.gambas" & " | grep -wv grep | wc -l" To risultato
+
 
 +
  <FONT color=gray>' ''Otteniamo il PID dei processi (programmi) aperti, aventi il medesimo "nome_programma.gambas":''</font>
 +
   Shell "ps -aux | grep " & "<FONT color=gray>nome_programma.gambas</font>" To index
 
    
 
    
   iRis = CByte(Trim(risultato))
+
   plura = Split(index, " ")
 
    
 
    
   If iRis > 1 Then
+
   For a = 0 To plura.Max
     FMain.Close
+
<FONT color=gray>' ''Cerca il riferimento al 1° programma aperto (cioè a quello con identico nome al proprio):''</font>
   Endif
+
    If Right(plura[a], 20) Like "*.gambas*" Then
 +
<FONT color=gray>' ''Così può passare a "Kill" la stringa, contenuta da ciascuna variabile "plura" successiva alle stringhe che si riferiscono al 1° processo (che resta così protetto), sino a quando non passerà la stringa contenente il PID del 2° processo (se è stato aperto il 2° programma), cioè... se stesso !''</font>
 +
      For b = a To plura.Max
 +
<FONT color=gray>' ''Non appena viene passato il PID del 2° processo, questo viene terminato.''
 +
' ''Quindi il programma (se è il 2°) si auto-elimina e non si apre:''</font>
 +
        Try Shell "kill " & plura[b]
 +
      Next
 +
     Endif
 +
   Next
 
    
 
    
 
  '''End'''
 
  '''End'''
  
  
 +
 +
<FONT color=#B22222>'''6)'''</font>
 +
'''Public''' Sub Form_Open()
 +
 
 +
  Dim risultato As String
 +
  Dim iRis As Byte
 +
 
 +
  Shell "ps aux | grep " & "<FONT color=gray>nome_programma.gambas</font>" & " | grep -wv grep | wc -l" To risultato
 +
 
 +
  iRis = CByte(Trim(risultato))
 +
 
 +
  If iRis > 1 Then FMain.Close
 +
 
 +
'''End'''
  
  
<FONT color=#B22222>'''5)'''</font>
 
  
 +
<FONT color=#B22222>'''7)'''</font>
 
  Private iRun As Integer   
 
  Private iRun As Integer   
 
  Private hsettings As Settings
 
  Private hsettings As Settings
Riga 101: Riga 122:
 
   
 
   
 
   hsettings = New Settings(User.Home &/ "prova.conf")
 
   hsettings = New Settings(User.Home &/ "prova.conf")
  iRun = hsettings[Application.Name & "_scn/ctrapp", 0]   
+
  iRun = hsettings[Application.Name & "_scn/ctrapp", 0]   
  Inc iRun
+
  Inc iRun
+
 
If iRun > 1 Then   
+
  If iRun > 1 Then   
  Me.Close   
+
    Me.Close   
  Else   
+
  Else   
    hsettings[Application.Name & "_scn/ctrapp"] = iRun   
+
    hsettings[Application.Name & "_scn/ctrapp"] = iRun   
    hsettings.Save   
+
    hsettings.Save   
Endif     
+
  Endif     
+
 
 
  '''End'''
 
  '''End'''
 
   
 
   
Riga 119: Riga 140:
 
   hsettings[Application.Name & "_scn/ctrapp"] = iRun     
 
   hsettings[Application.Name & "_scn/ctrapp"] = iRun     
 
   hsettings.Save
 
   hsettings.Save
+
 
 
  '''End'''
 
  '''End'''
  
  
  
 
+
<FONT color=#B22222>'''8)'''</font>
<FONT color=#B22222>'''6)'''</font>
 
 
 
 
  '''Public''' Sub Form_Open()   
 
  '''Public''' Sub Form_Open()   
 
        
 
        
 
   If settings[Application.Name & "_scn/ctrap"] = "1" Then   
 
   If settings[Application.Name & "_scn/ctrap"] = "1" Then   
     If Message.Warning("Il programma è già aperto", "forza apertura", "non aprire di nuovo") = 1 Then   
+
     If Message.Warning("Il programma è già aperto", "forza apertura", "non aprire di nuovo") == 1 Then   
     
+
    Else   
            Else   
+
      Me.Close   
            Me.Close   
+
    Endif   
          Endif   
+
  Endif   
    Endif   
+
 
    settings[Application.Name & "_scn/ctrap"] = "1"   
+
  settings[Application.Name & "_scn/ctrap"] = "1"   
      settings.Save
+
  settings.Save
 
   
 
   
 
  '''End'''  
 
  '''End'''  
Riga 144: Riga 163:
 
  '''Public''' Sub Form_Close()   
 
  '''Public''' Sub Form_Close()   
 
   
 
   
    settings[Application.Name & "_scn/ctrap"] = "0"   
+
  settings[Application.Name & "_scn/ctrap"] = "0"   
    settings.Save
+
  settings.Save
 
   
 
   
 
  '''End'''
 
  '''End'''
Riga 151: Riga 170:
  
  
 
+
<FONT color=#B22222>'''9)'''</font>
<FONT color=#B22222>'''7)'''</font>
 
 
 
 
  '''Public''' Sub Form_Open()
 
  '''Public''' Sub Form_Open()
 
   
 
   
Dim iPuntIni AS Integer
+
  Dim iPuntIni AS Integer
Dim iPuntFin AS Integer
+
  Dim iPuntFin AS Integer
Dim iLunStriMia AS Integer
+
  Dim iLunStriMia AS Integer
Dim iLun2 AS Integer
+
  Dim iLun2 AS Integer
Dim Esito AS String
+
  Dim Esito AS String
Dim $StriMia AS String = "TestDbContabFam.gambas"
+
  Dim $StriMia AS String = Application.Name
+
 
 
   iLunStriMia = Len($StriMia)
 
   iLunStriMia = Len($StriMia)
 
   
 
   
Riga 171: Riga 188:
 
   iLun2 = iPuntFin - iPuntIni
 
   iLun2 = iPuntFin - iPuntIni
 
   
 
   
   If iLun2 > iLunStriMia THEN
+
   If iLun2 > iLunStriMia Then Me.Close
      Quit
+
    
   Endif
 
 
 
  '''End'''
 
  '''End'''
 
 
La Shell restituisce una stringa formata da tutte le ricorrenze contenenti ''TestDbContabFam.gambas'', per cui agendo sulla lunghezza della sottostringa formata dal punto di inizio della prima ricorrenza e dal punto di fine dell'ultima ricorrenza, si intuisce il numero delle chiamate al programma eseguibile e ne viene permessa solamente una, però se la 2^ chiamata viene fatta dall'ide di Gambas, allora la ricorrenza con estensione ".gambas" viene incontrata una volta sola ed il programma si avvia ugualmente.
 
La Shell restituisce una stringa formata da tutte le ricorrenze contenenti ''TestDbContabFam.gambas'', per cui agendo sulla lunghezza della sottostringa formata dal punto di inizio della prima ricorrenza e dal punto di fine dell'ultima ricorrenza, si intuisce il numero delle chiamate al programma eseguibile e ne viene permessa solamente una, però se la 2^ chiamata viene fatta dall'ide di Gambas, allora la ricorrenza con estensione ".gambas" viene incontrata una volta sola ed il programma si avvia ugualmente.
  
  
  
 
+
<FONT color=#B22222>'''10)'''</font>
<FONT color=#B22222>'''8)'''</font>
 
 
 
 
Così dovrebbe funzionare anche in caso che una precedente istanza del programma sia abortita a seguito di errore:
 
Così dovrebbe funzionare anche in caso che una precedente istanza del programma sia abortita a seguito di errore:
 
 
  Private hSetting As Settings
 
  Private hSetting As Settings
 
   
 
   
Riga 191: Riga 202:
 
  '''Public''' Sub Form_Open()
 
  '''Public''' Sub Form_Open()
 
   
 
   
Dim iPid As Integer = Application.Id
+
  Dim iPid As Integer = Application.Id
Dim sPid, sSysPid As String
+
  Dim sPid, sSysPid As String
+
 
hSetting = New Settings(User.Home &/ "myapp.conf")
+
  hSetting = New Settings(User.Home &/ "myapp.conf")
 +
 
 
   If (hSetting["Application/pid", 0] = 0) Then
 
   If (hSetting["Application/pid", 0] = 0) Then
  <FONT color=#006400>' ''questa è la prima  esecuzione:''</font>
+
  <FONT color=gray>' ''Questa è la prima  esecuzione:''</font>
 
     hSetting["Application/pid"] = iPid
 
     hSetting["Application/pid"] = iPid
 
     hSetting.Save
 
     hSetting.Save
 +
  Else
 +
    sPid = hSetting["Application/pid"]
 +
    Shell "ps aux | grep " & sPid & "  | grep -wv grep | wc -l" Wait To sSysPid
 +
    sSysPid = Replace(sSysPid, "\n", "")
 +
    If (Val(sSysPid) > 0) Then
 +
      Me.Close  <FONT color=gray>' ''Applicazione già attiva''</font>
 
     Else
 
     Else
      sPid = hSetting["Application/pid"]
+
  <FONT color=gray>' ''Istanza precedente probabilmente abortita:''</font>
      Shell "ps aux | grep " & sPid & "  | grep -wv grep | wc -l" Wait To sSysPid
+
      hSetting["Application/pid"] = iPid
      sSysPid = Replace(sSysPid, "\n", "")
+
      hSetting.Save
      If (Val(sSysPid) > 0) Then
+
    Endif
        Me.Close ' Applicazione già attiva
 
        Else
 
  <FONT color=#006400>' ''Istanza precedente probabilmente abortita:''</font>
 
          hSetting["Application/pid"] = iPid
 
          hSetting.Save
 
      Endif
 
 
   Endif
 
   Endif
+
 
 
  '''End'''
 
  '''End'''
  
  
  
 
+
=Note=
==Note==
 
 
[1] I vari algoritmi, in questa pagina riportati, provengono da un'analoga discussione avviata nel Forum di ''Gambas-it.org'', e sono l'apporto di vari iscritti al Forum.
 
[1] I vari algoritmi, in questa pagina riportati, provengono da un'analoga discussione avviata nel Forum di ''Gambas-it.org'', e sono l'apporto di vari iscritti al Forum.

Versione delle 18:46, 10 feb 2021

Per impedire che un programma Gambas venga aperto involontariamente più volte, sono possibili diverse modalità: [Nota 1]


1) Si leggono i dati presenti nei file "cmdline" e "stat" presenti nella cartella del processo del programma (contenuta a sua volta nella cartella "/proc"):

Public Sub Form_Activate()   ' oppure "Sub Main()" se il programma è a "linea di comando"
 
 Dim s, cmdline As String
 Dim id As New String[]
    
 For Each s In Dir("/proc", "*", gb.Directory)
   If Exist("/proc" &/ s &/ "cmdline") Then
     cmdline = File.Load("/proc" &/ s &/ "cmdline")
     If (cmdline Like "*" & Application.Name & ".gambas*") Then
       id.Push(Split(File.Load("/proc" &/ s &/ "stat"), Chr(32))[0])
       If id.Count > 1 Then
         If id[id.Max] > id[id.Max - 1] Then Quit
       Endif      
     Endif
   Endif
 Next
    
End


2)
Il seguente codice vale solo per programmi in ambiente grafico.
E' necessario attivare il Componente gb.desktop.

Public Sub Form_Open()
 
 For i As Integer = 0 To Desktop.Windows.Count - 1
   If Desktop.Windows[i].Name = Application.Name Then Me.Close
 Next
  
End


3)
Il seguente codice vale solo per programmi in ambiente grafico.
E' necessario attivare il Componente gb.desktop.

Public Sub Form_Open()
  
 Dim ii As New Integer[]
 
 ii = Desktop.FindWindow(Application.Name)
 
 If ii.Count == 0 Then  
   message.info("applicazione non ancora avviata")  
 Else If ii.Count > 0 Then  
   message.info("applicazione già avviata !")  
   FMain.Close
 End
 
End


4)

Public Sub Form_Open()
 
 Dim sOutput As String

 Exec ["pgrep", "-f", "-l", "nome_programma.gambas"] Wait To sOutput

 If Split(Trim$(sOutput), gb.NewLine).Count > 1 Then Quit

End


5)

Public Sub Form_Open()

 Dim index As String
 Dim plura As String[]
 Dim a, b As Integer
 
' Otteniamo il PID dei processi (programmi) aperti, aventi il medesimo "nome_programma.gambas":
 Shell "ps -aux | grep " & "nome_programma.gambas" To index
 
 plura = Split(index, " ")
 
 For a = 0 To plura.Max
' Cerca il riferimento al 1° programma aperto (cioè a quello con identico nome al proprio):
   If Right(plura[a], 20) Like "*.gambas*" Then
' Così può passare a "Kill" la stringa, contenuta da ciascuna variabile "plura" successiva alle stringhe che si riferiscono al 1° processo (che resta così protetto), sino a quando non passerà la stringa contenente il PID del 2° processo (se è stato aperto il 2° programma), cioè... se stesso !
     For b = a To plura.Max
' Non appena viene passato il PID del 2° processo, questo viene terminato.
' Quindi il programma (se è il 2°) si auto-elimina e non si apre:
        Try Shell "kill " & plura[b]
     Next
   Endif
 Next
 
End


6)

Public Sub Form_Open()
 
 Dim risultato As String
 Dim iRis As Byte
 
 Shell "ps aux | grep " & "nome_programma.gambas" & " | grep -wv grep | wc -l" To risultato
 
 iRis = CByte(Trim(risultato))
 
 If iRis > 1 Then FMain.Close
 
End


7)

Private iRun As Integer  
Private hsettings As Settings


Public Sub Form_Open()

 hsettings = New Settings(User.Home &/ "prova.conf")
 iRun = hsettings[Application.Name & "_scn/ctrapp", 0]  
 Inc iRun
 
 If iRun > 1 Then  
   Me.Close  
 Else  
   hsettings[Application.Name & "_scn/ctrapp"] = iRun  
   hsettings.Save  
 Endif    
 
End


Public Sub Form_Close()

 Dec iRun  
 hsettings[Application.Name & "_scn/ctrapp"] = iRun    
 hsettings.Save
 
End


8)

Public Sub Form_Open()  
     
 If settings[Application.Name & "_scn/ctrap"] = "1" Then   
   If Message.Warning("Il programma è già aperto", "forza apertura", "non aprire di nuovo") == 1 Then   
   Else   
     Me.Close  
   Endif   
 Endif   
 
 settings[Application.Name & "_scn/ctrap"] = "1"  
 settings.Save

End 
      

Public Sub Form_Close()  

 settings[Application.Name & "_scn/ctrap"] = "0"  
 settings.Save

End


9)

Public Sub Form_Open()

 Dim iPuntIni AS Integer
 Dim iPuntFin AS Integer
 Dim iLunStriMia AS Integer
 Dim iLun2 AS Integer
 Dim Esito AS String
 Dim $StriMia AS String = Application.Name
 
 iLunStriMia = Len($StriMia)

 Shell "pgrep -fl " & $StriMia Wait To Esito

 iPuntIni = InStr(Esito, $StriMia)
 iPuntFin = RInStr(Esito, $StriMia) + iLunStriMia
 iLun2 = iPuntFin - iPuntIni

 If iLun2 > iLunStriMia Then Me.Close
 
End

La Shell restituisce una stringa formata da tutte le ricorrenze contenenti TestDbContabFam.gambas, per cui agendo sulla lunghezza della sottostringa formata dal punto di inizio della prima ricorrenza e dal punto di fine dell'ultima ricorrenza, si intuisce il numero delle chiamate al programma eseguibile e ne viene permessa solamente una, però se la 2^ chiamata viene fatta dall'ide di Gambas, allora la ricorrenza con estensione ".gambas" viene incontrata una volta sola ed il programma si avvia ugualmente.


10) Così dovrebbe funzionare anche in caso che una precedente istanza del programma sia abortita a seguito di errore:

Private hSetting As Settings


Public Sub Form_Open()

 Dim iPid As Integer = Application.Id
 Dim sPid, sSysPid As String
 
 hSetting = New Settings(User.Home &/ "myapp.conf")
 
 If (hSetting["Application/pid", 0] = 0) Then
' Questa è la prima  esecuzione:
   hSetting["Application/pid"] = iPid
   hSetting.Save
 Else
   sPid = hSetting["Application/pid"]
   Shell "ps aux | grep " & sPid & "  | grep -wv grep | wc -l" Wait To sSysPid
   sSysPid = Replace(sSysPid, "\n", "")
   If (Val(sSysPid) > 0) Then 
     Me.Close   ' Applicazione già attiva
   Else
' Istanza precedente probabilmente abortita:
     hSetting["Application/pid"] = iPid
     hSetting.Save
   Endif
 Endif
 
End


Note

[1] I vari algoritmi, in questa pagina riportati, provengono da un'analoga discussione avviata nel Forum di Gambas-it.org, e sono l'apporto di vari iscritti al Forum.