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

Da Gambas-it.org - Wikipedia.
Riga 5: Riga 5:
  
 
  '''Public''' Sub Form_Open()
 
  '''Public''' Sub Form_Open()
 +
 
 
   Dim sOutput As String
 
   Dim sOutput As String
 
   
 
   

Versione delle 19:40, 9 feb 2021

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


1)

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
 Endif

End



2)

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
  NextEnd

End



3)

Public Sub Form_Open()

Dim P As New Pointer[]

 P = Desktop.FindWindow(Application.Name)

 If P.count = 0 Then  
   message.info("applicazione non ancora avviata")  
 Else If P.count > 0 Then  
   message.info("applicazione già avviata !")  
   FMain.Close
 End If 
 
End



4)

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
 Endif
 
End



5)

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



6)

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



7)

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 = "TestDbContabFam.gambas"

 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 
     Quit
 Endif

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.



8)

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.