Start a program just one time

[Jawade]

What is the best way to start a program not more than one time?

[deltarho[1859]]

Windows method.

Code: Select all

#include "Windows.bi"
Function FirstInstanceOfProgram() As Long
' True   = This Is the only current instance of the program.
' False  = Program Is already running

Dim hMutex As Handle
Dim ThisApp As Wstring * Max_Path
Dim LastError As Long

  ThisApp = "OzM1bli3JTRRJQixaf83"

  hMutex = CreateMutexW( ByVal Null, ByVal Null, VarPtr(ThisApp) )
  LastError = GetLastError
  If hMutex <> 0 Then
    If LastError = Error_Already_Exists Then
      Function = FALSE
    Else
      Function = TRUE
    End If
  Else
    ThisApp = "Mutex Create failed with error code" & Str(LastError)
    Messagebox( Byval NULL, ThisApp, "Test", MB_OK )
    Function = FALSE
  End If

End Function

If FirstInstanceOfProgram = 0 Then
  Messagebox Null, "<Whatever> is already running", "Title", MB_IconWarning Or MB_TaskModal Or MB_Topmost
  End
End If

MessageBox Null, "First instance", "Title", MB_TaskModal Or MB_Topmost

<Whatever> is the name of your program.
<Title>, whatever you want.

[UEZ]

Here the ported Autoit function _Singleton

Code: Select all

'Ported from Autoit's function _Singleton
#Include "windows.bi"

'iFlag:
'0 - Exit the script with the exit code -1 if another instance already exists.
'1 - Return from the function without exiting the script.
'2 - Allow the object to be accessed by anybody in the system. 
Function Singleton(sOccurrenceName As LPCWSTR, iFlag As Ubyte) As HANDLE
	Dim As SECURITY_ATTRIBUTES tSECURITY_ATTRIBUTES
	If iFlag And 2 Then
		Dim As SECURITY_DESCRIPTOR tSecurityDescriptor 
		If InitializeSecurityDescriptor(@tSecurityDescriptor, SECURITY_DESCRIPTOR_REVISION) Then
			SetSecurityDescriptorDacl(@tSecurityDescriptor, True, Null, False)
			tSECURITY_ATTRIBUTES.nLength = Sizeof(SECURITY_ATTRIBUTES)
			tSECURITY_ATTRIBUTES.lpSecurityDescriptor = @tSecurityDescriptor
			tSECURITY_ATTRIBUTES.bInheritHandle = FALSE
		End If
	End If
	Dim As HANDLE hHandle = CreateMutexW(@tSECURITY_ATTRIBUTES, TRUE, sOccurrenceName)
	If GetLastError() = ERROR_ALREADY_EXISTS Then 
		If iFlag And 1 Then
			CloseHandle(hHandle)
			Return 0
		Else
			End -1
		End If
	End If
	Return hHandle
End Function

If Singleton("Test", 1) = 0 Then
	MessageBox(0, "An occurrence of test is already running.", "Warning", MB_ICONWARNING)
	End
End If
MessageBox(0, "The first occurrence of test is running.", "Information", MB_ICONINFORMATION)

Compile and run it twice to see if it works.

[jj2007]

Code: Select all

#include "Windows.bi"
Dim ItsMe as string=Command(0)
If GlobalFindAtom(ItsMe) Then
  Messagebox Null, ItsMe+" is already running", "Sorry:", MB_IconWarning Or MB_Topmost
else
  Dim IsRunning as short=GlobalAddAtom(ItsMe)
  Messagebox Null, ItsMe+" successfully started", "Yeah:", MB_OK Or MB_TaskModal Or MB_Topmost
  GlobalDeleteAtom(IsRunning)
End If

[UEZ]

Code: Select all

#include "Windows.bi"
Dim ItsMe as string=Command(0)
If GlobalFindAtom(ItsMe) Then
  Messagebox Null, ItsMe+" is already running", "Sorry:", MB_IconWarning Or MB_Topmost
else
  Dim IsRunning as short=GlobalAddAtom(ItsMe)
  Messagebox Null, ItsMe+" successfully started", "Yeah:", MB_OK Or MB_TaskModal Or MB_Topmost
  GlobalDeleteAtom(IsRunning)
End If

Cool - very short! Never heard something about "Atoms" in WinAPI.

[deltarho[1859]]

I forgot to add #Include "windows.bi" - I did not test it, copy & paste from an FB application. Tch, tch! It was ported from PowerBASIC and is not behaving as it should.

I will not waste time trying to fix it because jj2007's code is an absolute cracker.

[jj2007]

You are very kind, folks ;-)

Here is the Assembly version:

Code: Select all

include \masm32\MasmBasic\MasmBasic.inc
  Init
  Let esi=CL$(0)		; use the executable name as a unique string
  .if rv(GlobalFindAtom, esi)
	    MsgBox 0, Cat$(esi+" is already running"), "Sorry:", MB_OK or MB_TOPMOST
  .else
	    push rv(GlobalAddAtom, esi)
	    MsgBox 0, Cat$(esi+" successfully started"), "Yeah:", MB_OK or MB_TOPMOST
	    call GlobalDeleteAtom
  .endif
EndOfCode

[deltarho[1859]]

Here is the Assembly version:

Behave yourself, Jochen, the BASIC version is just fine.

[SARG]

In a same way that jj2007's one.

What I use in fbdebugger :

Code: Select all

'To avoid multiple launching
If CreateSemaphore(0, 0, 1,"FBdebugger" )<>0 And GetLastError() = ERROR_ALREADY_EXISTS Then
   If fb_message("Starting FBdebugger","An other occurence is already running."+Chr(13)+"Continue ?", _
   MB_YESNO Or MB_ICONQUESTION Or MB_SYSTEMMODAL Or MB_DEFBUTTON1) = IDNO Then End 1
End If

[Jawade]

Thanks, it works fine.

[jj2007]

Here is the Assembly version:

Behave yourself, Jochen, the BASIC version is just fine.

Hey, young man, my last version looks more BASIC than yours

@Sarg: without ReleaseSemaphore, you risk having a different functionality

[deltarho[1859]]

@jj2007

I have hit a snag with your method. I did not want to be told of a successful start so commented the second MessageBox.

Running as a console program the following does not work.

Code: Select all

'#Console On
#include "Windows.bi"
Dim ItsMe as string=Command(0)
If GlobalFindAtom(ItsMe) Then
  Messagebox Null, ItsMe+" is already running", "Sorry:", MB_IconWarning Or MB_Topmost
  End
Else
  Dim IsRunning as short=GlobalAddAtom(ItsMe)
  'Messagebox Null, ItsMe+" successfully started", "Yeah:", MB_OK Or MB_TaskModal Or MB_Topmost
  GlobalDeleteAtom(IsRunning)
End If
print "Done"
Sleep

If we remove the comment from the second MessageBox it works.

I have seen something like this before where a MessageBox helped a program to work but never did figure out why.

PS My method is now working OK.

[UEZ]

@jj2007

I have hit a snag with your method. I did not want to be told of a successful start so commented the second MessageBox.

Running as a console program the following does not work.

Code: Select all

'#Console On
#include "Windows.bi"
Dim ItsMe as string=Command(0)
If GlobalFindAtom(ItsMe) Then
  Messagebox Null, ItsMe+" is already running", "Sorry:", MB_IconWarning Or MB_Topmost
  End
Else
  Dim IsRunning as short=GlobalAddAtom(ItsMe)
  'Messagebox Null, ItsMe+" successfully started", "Yeah:", MB_OK Or MB_TaskModal Or MB_Topmost
  GlobalDeleteAtom(IsRunning)
End If
print "Done"
Sleep

If we remove the comment from the second MessageBox it works.

I have seen something like this before where a MessageBox helped a program to work but never did figure out why.

PS My method is now working OK.

As long as the first call of the program runs it should work. In your case when comment out the 2nd Messagebox you delete the atom and thus GlobalFindAtom cannot find it.
That means the first call of the program must run.

Code: Select all

'#Console On
#include "Windows.bi"
Dim ItsMe as string=Command(0)
If GlobalFindAtom(ItsMe) Then
  Messagebox Null, ItsMe+" is already running", "Sorry:", MB_IconWarning Or MB_Topmost
  End
Else
  Dim IsRunning as short=GlobalAddAtom(ItsMe)
  'Messagebox Null, ItsMe+" successfully started", "Yeah:", MB_OK Or MB_TaskModal Or MB_Topmost
  Sleep
  GlobalDeleteAtom(IsRunning)
End If
print "Done"
Sleep

[jj2007]

I did not want to be told of a successful start so commented the second MessageBox

As UEZ noted, the MessageBox serves only to simulate the running program. When it finishes, the atom must be deleted.

[dodicat]

Only one left running.
64 bit fbc

Code: Select all

Function StringSplit(s_in As String,chars As String,result() As String) As Long
    Dim As Long ctr,ctr2,k,n,LC=len(chars)
    dim As boolean tally(Len(s_in))
    #macro check_instring()
        n=0
        while n<Lc
        If chars[n]=s_in[k] Then 
        tally(k)=true
        If (ctr2-1) Then ctr+=1
        ctr2=0
        exit while
        end if
        n+=1
       wend
    #endmacro
   
    #macro split()
    If tally(k) Then
        If (ctr2-1) Then ctr+=1:result(ctr)=Mid(s_in,k+2-ctr2,ctr2-1)
        ctr2=0
    End If
    #endmacro
    '==================  LOOP TWICE =======================
    For k  =0 To Len(s_in)-1
        ctr2+=1:check_instring()
    Next k
    if ctr=0 then
         if len(s_in) andalso instr(chars,chr(s_in[0])) then ctr=1':beep
         end if
    If ctr Then Redim result(1 To ctr): ctr=0:ctr2=0 Else  Return 0
    For k  =0 To Len(s_in)-1
        ctr2+=1:split()
    Next k
    '===================== Last one ========================
    If ctr2>0 Then
        Redim Preserve result(1 To ctr+1)
        result(ctr+1)=Mid(s_in,k+1-ctr2,ctr2)
    End If
    Return Ubound(result)
End Function

function pipeout(byval s as string="") byref as string
    var f=freefile
    dim as string tmp
    Open Pipe s For Input As #f 
     s=""
    Do Until EOF(f)
    Line Input #f,tmp
    s+=tmp+chr(10)
    Loop
    close #f
    return s
end function

sub killer(g as string)
var s= pipeout ("tasklist /M ")
redim as string res()
stringsplit(s,chr(13,10),res())
redim as string k()
dim as long count
for n as long=lbound(res) to ubound(res)
  if instr(res(n),g) then
      count+=1
      redim preserve k(1 to count)
      k(count)=res(n)
  end if
next n
for n as long=lbound(k) to ubound(k)-1
    var z=val(trim(trim(k(n),g)))
    if z then
    shell "taskkill /PID "+str(z)
    end if
next n
end sub
'===============

for n as long=1 to 5
    shell "start notepad "
    print "start notepad"
    killer("notepad.exe")
next


print "Done, should only be one notepad running"
sleep