Impedire l'avvio di un programma.gambas già avviato
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.