Support Forums > Other Software and Code

Mutex and Firefly

(1/3) > >>

Richard Marchessault:
What code would you recommend to determine if a program is already and switch to the running program instead of starting it up again? I can see examples of using CreateMutex on the PowerBasic forums but wonder how best to implement this with FireFly.

Pierre Bellisle:
Sadly, I'm not a FireFly user, but still, here is the same Mutex & GW_HWNDNEXT approach I had in PowerBASIC...
 

--- Code: ---#Define JumpCompiler "<D:\Free\64\fbc.exe>" 'Compiler to use "< = left delimiter, >" = right delimiter
#Define JumpCompilerCmd "<-s gui -w pedantic "D:\Free\bas\~~Default.rc">" 'Command line to send to compiler (gui or console)

#define UniCode
#Include Once "windows.bi"
#Include Once "win\shellapi.bi"

#Define AppName "Mutex demo"
#Define StaticInfo 101
#Define CrLf Chr(13, 10)
#Define dwMutex 1901310955 '[YYMMDDHHMM] - 10 digits - Max is 4,294,967,295, I use current time

Dim Shared As HINSTANCE hInstance : hInstance = GetModuleHandle(NULL)
'_____________________________________________________________________________

Function WndProc(ByVal hWnd As HWND, ByVal uMsg As UINT, ByVal wParam As WPARAM, ByVal lParam As LPARAM) As Integer
 Dim    hStaticInfo        As HWND
 Static hWindowDefaultFont As HFONT

 Function = 0

 Select Case (uMsg)

   Case WM_CREATE
     Dim As NONCLIENTMETRICS NotClientMetrics
     NotClientMetrics.cbSize = SizeOf(NONCLIENTMETRICS)
     SystemParametersInfo(SPI_GETNONCLIENTMETRICS, NotClientMetrics.cbSize, @NotClientMetrics, 0)
     hWindowDefaultFont = CreateFontIndirect(@NotClientMetrics.lfMessageFont)

     hStaticInfo = CreateWindowEx(0, "Static", "Try to run another self instance" & CRLF & "(Minimize me before)", _
                                  WS_CHILD Or WS_VISIBLE Or SS_CENTER Or SS_NOTIFY, _
                                  10, 30, 200, 30, _
                                  hWnd, Cast(HMENU, StaticInfo), _
                                  hInstance, NULL)
    SendMessage(hStaticInfo, WM_SETFONT, Cast(UInteger, hWindowDefaultFont), TRUE)

   Case WM_DESTROY
     DeleteObject(hWindowDefaultFont) 'Clean up
     PostQuitMessage(0) 'Ask message loop to end
     Exit Function

 End Select

 Function = DefWindowProc(hWnd, uMsg, wParam, lParam)

End Function
'_____________________________________________________________________________

Function WinMain(ByVal hInstance As HINSTANCE, ByVal hPrevInst As HINSTANCE, _
                 ByVal CmdLine As WString Ptr, ByVal CmdShow As Integer) As UINT
 Dim WinClass   As WNDCLASS
 Dim wMsg       As MSG
 Dim hWnd       As HWND
 Dim hIco       As HICON
 Dim WindowSize As SIZEL
 Dim wsAppName  As WString * 128

 wsAppName              = AppName
 WindowSize.cx          = 230
 WindowSize.cy          = 120
 hIco                   = ExtractIcon(GETMODULEHANDLE(""), "Shell32.dll", 294) 'o
 WinClass.style         = CS_HREDRAW Or CS_VREDRAW
 WinClass.lpfnWndProc   = ProcPtr(WndProc)
 WinClass.cbClsExtra    = 0
 WinClass.cbWndExtra    = 0
 WinClass.hInstance     = hInstance
 WinClass.hIcon         = hIco
 WinClass.hCursor       = LoadCursor(NULL, IDC_ARROW)
 WinClass.hbrBackground = Cast(HGDIOBJ, COLOR_BTNFACE + 1) 'Default color
 WinClass.lpszMenuName  = NULL
 WinClass.lpszClassName = @wsAppName

 Dim hTry        As HWND
 Dim hMutex      As HWND
 Dim zMutex      As ZString * 16

 zMutex  = "MyUniqueMutex" 'MaxStringLen is %MAX_PATH, no "\", case sensitive
 hMutex  = CreateMutex(ByVal NULL, 0, zMutex)
 If GetLastError = ERROR_ALREADY_EXISTS Then
   Beep()
   'Optionnal: MessageBox(HWND_DESKTOP, AppName & " is already running!", AppName, MB_TOPMOST Or MB_OK)
   hTry =  GetForegroundWindow()
   Do While hTry
     If  GetWindowLongPtr(hTry, GWLP_USERDATA) = dwMutex Then
       If IsIconic(hTry) Then ShowWindow(hTry, SW_RESTORE) 'Unminimize exe
       SetForegroundWindow(hTry)
       Exit Do
     End If
     hTry = GetWindow(hTry, GW_HWNDNEXT)
   Loop
   If hTry = 0 Then 'Can't find it!!!
     MessageBox(HWND_DESKTOP, AppName & " is running hidden in background!", AppName, MB_TOPMOST Or MB_OK)
   End IF
   End
 End If

 If (RegisterClass(@WinClass)) Then
   hWnd = CreateWindowEx(WS_EX_WINDOWEDGE, _
                         wsAppName, wsAppName, _
                         WS_OVERLAPPED OR WS_CLIPCHILDREN Or WS_DLGFRAME Or WS_BORDER Or WS_VISIBLE Or WS_CAPTION Or _
                         WS_MAXIMIZEBOX Or WS_MINIMIZEBOX Or WS_SYSMENU , _
                         (GetSystemMetrics(SM_CXSCREEN) - WindowSize.cx) / 2, _ 'PosX
                         (GetSystemMetrics(SM_CYSCREEN) - WindowSize.cy) / 2, _ 'PosY
                         WindowSize.cx, WindowSize.cy, _ 'Width, height
                         NULL, NULL, hInstance, NULL)

   SetWindowLongPtr(hWnd, GWLP_USERDATA, dwMutex) 'Set window mutex

   ShowWindow(hWnd, SW_SHOW)
   UpdateWindow(hWnd)

   While GetMessage(@wMsg, ByVal NULL, 0, 0) > 0
     If IsDialogMessage(hWnd, @wMsg) = 0 Then
       TranslateMessage(@wMsg)
       DispatchMessage(@wMsg)
     End If
   Wend
 End If

 DestroyIcon(hIco)

 CloseHandle(hMutex)

 Function = wMsg.message

End Function
'_____________________________________________________________________________

End WinMain(hInstance, NULL, Command(), SW_NORMAL) 'Call main() and return the error code to the OS
'_____________________________________________________________________________
'

--- End code ---

Josť Roca:
Pierre,

Firefly uses PowerBasic, not Freebasic.

Pierre Bellisle:
This was my impression, so I double checked with a quick search and got FireFly for FreeBASIC v3.78 uploaded... by Paul and then because the PowerBASIC's answers where quite explicit I thought Richard was adapting code, I guess that it was kind of a redundant variant of the same question.
In any case, for easy find, the PB equivalent of the above code is at Mutex and GWL_USERDATA

Josť Roca:
Sorry, I forgot that there was a version of Firefly for FreeBasic. I wonder why somebody will want to use it, since it was deprecated long time ago.

Navigation

[0] Message Index

[#] Next page

Go to full version