Start a program just one time
Start a program just one time
What is the best way to start a program not more than one time?
-
- Posts: 4308
- Joined: Jan 02, 2017 0:34
- Location: UK
- Contact:
Re: Start a program just one time
Windows method.
<Whatever> is the name of your program.
<Title>, whatever you want.
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
<Title>, whatever you want.
Last edited by deltarho[1859] on May 30, 2020 12:12, edited 3 times in total.
Re: Start a program just one time
Here the ported Autoit function _Singleton
Compile and run it twice to see if it works.
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)
Last edited by UEZ on May 30, 2020 19:07, edited 1 time in total.
Re: Start a program just one time
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
Re: Start a program just one time
Cool - very short! Never heard something about "Atoms" in WinAPI.jj2007 wrote: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
-
- Posts: 4308
- Joined: Jan 02, 2017 0:34
- Location: UK
- Contact:
Re: Start a program just one time
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.
I will not waste time trying to fix it because jj2007's code is an absolute cracker.
Re: Start a program just one time
You are very kind, folks ;-)
Here is the Assembly version:
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
-
- Posts: 4308
- Joined: Jan 02, 2017 0:34
- Location: UK
- Contact:
Re: Start a program just one time
Behave yourself, Jochen, the BASIC version is just fine.jj2007 wrote:Here is the Assembly version:
Re: Start a program just one time
In a same way that jj2007's one.
What I use in fbdebugger :
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
Re: Start a program just one time
Thanks, it works fine.
Re: Start a program just one time
Hey, young man, my last version looks more BASIC than yoursdeltarho[1859] wrote:Behave yourself, Jochen, the BASIC version is just fine.jj2007 wrote:Here is the Assembly version:
@Sarg: without ReleaseSemaphore, you risk having a different functionality
-
- Posts: 4308
- Joined: Jan 02, 2017 0:34
- Location: UK
- Contact:
Re: Start a program just one time
@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.
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.
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
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.
Re: Start a program just one time
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.deltarho[1859] wrote:@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.If we remove the comment from the second MessageBox it works.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
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.
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
Re: Start a program just one time
As UEZ noted, the MessageBox serves only to simulate the running program. When it finishes, the atom must be deleted.deltarho[1859] wrote:I did not want to be told of a successful start so commented the second MessageBox
Re: Start a program just one time
Only one left running.
64 bit fbc
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