Whenever a document is clicked from explorer, a new instance of TextMagic is run, and the document is displayed.This is all very well if TextMagic has a SDI (Single Document Interface) - ie it can only display one document at a time. However, if TextMagic has a MDI (Multiple Document Interface), - ie it can display multiple documents (like word), then you do not want another instance of TextMagic appearing.
Surely there must be some way of checking if TextMagic is already running, and if so activating it and loading the document from that one. Well, there is, but it can get very complicated. However, there is another solution - www.vbaccelerator.com This site has some excellent controls, including a control that allows you to associate an extension, specify an icon for the files, check if an instance is running and more!
For more information, click the link above, click Libraries and you will see an item called Passing Command Line Parameters to an Existing Instance of your App. If you just want to download the code, complete with an example, click here. It also requires the SSubTmr.DLL component. There is an example below:
Option Explicit
' ===========================================================================
' Filename: modStartup.bas
' Author: Steve McMahon ([email protected])
' Date: 2 January 1999
' Modified By: James Crowley ([email protected])
' Date: 16 November 1999
'
' Description:
' A re-usable module for single instance applications which can have a
' a command line.
'
' a) To absolutely prevent two instances, we use a system Mutex via
' CreateMutex (rather than App.PrevInstance, which may not
return True).
' However this is a pain during development if you press Stop
(have to
' shutdown VB to clear the Mutex) so we just use App.PrevInstance
then.
' b) When window is created, it is tagged with a Windows property so any
' new instances can be accurately identified.
' c) When the user tries to start a second instance (either by double
' clicking on the EXE or by double clicking an associated
file), the
' window is identified and the command line (if any) is sent
to it.
'
' ---------------------------------------------------------------------------
' vbAccelerator - free, advanced source code for VB programmers.
' http://vbaccelerator.com
' ===========================================================================
Private Declare Function CreateMutex Lib "kernel32" Alias "CreateMutexA"
(ByVal lpMutexAttributes As Long, ByVal bInitialOwner As Long, ByVal lpName
As String) As Long
Private Declare Function GetLastError Lib "kernel32" () As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject
As Long) As Long
Private Const ERROR_ALREADY_EXISTS = 183&
Private m_hMutex As Long
Private Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc
As Long, ByVal lParam As Long) As Long
Private Declare Function IsWindowVisible Lib "user32" (ByVal hwnd
As Long) As Long
Private Declare Function BringWindowToTop Lib "user32" (ByVal hwnd
As Long) As Long
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd
As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA"
(ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As
Long
Private Declare Function GetProp Lib "user32" Alias "GetPropA"
(ByVal hwnd As Long, ByVal lpString As String) As Long
Private Declare Function SetProp Lib "user32" Alias "SetPropA"
(ByVal hwnd As Long, ByVal lpString As String, ByVal hData As Long) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory"
( _
lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
Private Declare Function SendMessageTimeout Lib "user32" Alias "SendMessageTimeoutA"
(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, lParam As Any,
ByVal fuFlags As Long, ByVal uTimeout As Long, lpdwResult As Long) As Long
Private Const SMTO_NORMAL = &H0
Public Const WM_COPYDATA = &H4A
Public Type COPYDATASTRUCT
dwData As Long
cbData As Long
lpData As Long
End Type
Private Declare Function SendMessageByLong Lib "user32" Alias "SendMessageA"
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam
As Long) As Long
Private Const WM_SYSCOMMAND = &H112
Private Const SC_RESTORE = &HF120
Private Declare Function IsIconic Lib "user32" (ByVal hwnd As Long)
As Long
Private m_hWndPrevious As Long
Private m_bInDevelopment As Boolean
' Change this line:
Private Const mcTHISAPPID = "DevPad"
Public Sub Main()
' Check if this is the first instance:
If (WeAreAlone(mcTHISAPPID & "_APPLICATION_MUTEX")) Then
' If it is, then start the app:
' Change these lines:
frmStartupDemo.Show
Else
' There is an existing instance.
' First try to find it:
EnumerateWindows
' If we get it:
If (m_hWndPrevious <> 0) Then
' Do we have a command to send, or is the main window hidden?
If (Command <> "") Or (IsWindowVisible(m_hWndPrevious) = 0) Then
' Send. The app must subclass the WM_COPYDATA message
' to get this information:
Dim tCDS As COPYDATASTRUCT, b() As Byte, lR As Long
If (Command <> "") Then
b = StrConv(Command, vbFromUnicode)
tCDS.dwData = 0
tCDS.cbData = UBound(b) + 1
tCDS.lpData = VarPtr(b(0))
Else
ReDim b(0 To 0) As Byte
tCDS.dwData = 0
tCDS.cbData = 1
tCDS.lpData = VarPtr(b(0))
End If
' Give in if the existing app is not responding:
lR = SendMessageTimeout(m_hWndPrevious, WM_COPYDATA, 0, tCDS, SMTO_NORMAL, 5000, lR)
Else
' Try to activate the existing window:
RestoreAndActivate m_hWndPrevious
End If
End If
End If
End Sub
Public Sub RestoreAndActivate(ByVal hWnd As Long)
If (IsIconic(hWnd)) Then
SendMessageByLong hWnd, WM_SYSCOMMAND, SC_RESTORE, 0
End If
ActivateWindow hWnd
End Sub
Public Sub TagWindow(ByVal hWnd As Long)
' Applies a window property to allow the window to
' be clearly identified.
SetProp hWnd, mcTHISAPPID & "_APPLICATION", 1
End Sub
Private Function IsThisApp(ByVal hWnd As Long) As Boolean
' Check if the windows property is set for this
' window handle:
If GetProp(hWnd, mcTHISAPPID & "_APPLICATION") = 1 Then
IsThisApp = True
End If
End Function
Public Function EnumWindowsProc( _
ByVal hWnd As Long, _
ByVal lParam As Long _
) As Long
Dim bStop As Boolean
' Customised windows enumeration procedure. Stops
' when it finds another application with the Window
' property set, or when all windows are exhausted.
bStop = False
If IsThisApp(hWnd) Then
EnumWindowsProc = 0
m_hWndPrevious = hWnd
Else
EnumWindowsProc = 1
End If
End Function
Public Function EnumerateWindows() As Boolean
' Enumerate top-level windows:
EnumWindows AddressOf EnumWindowsProc, 0
End Function
Public Sub ActivateWindow(ByVal lHwnd As Long)
SetForegroundWindow lHwnd
End Sub
Public Function InDevelopment() As Boolean
' Debug.Assert code not run in an EXE. Therefore
' m_bInDevelopment variable is never set.
Debug.Assert InDevelopmentHack() = True
InDevelopment = m_bInDevelopment
End Function
Private Function InDevelopmentHack() As Boolean
' .... '
m_bInDevelopment = True
InDevelopmentHack = m_bInDevelopment
End Function
Private Function WeAreAlone(ByVal sMutex As String) As Boolean
' Don't call Mutex when in VBIDE because it will apply
' for the entire VB IDE session, not just the app's
' session.
If InDevelopment Then
WeAreAlone = Not (App.PrevInstance)
Else
' Ensures we don't run a second instance even
' if the first instance is in the start-up phase
m_hMutex = CreateMutex(ByVal 0&, 1, sMutex)
If (Err.LastDllError = ERROR_ALREADY_EXISTS) Then
CloseHandle m_hMutex
Else
WeAreAlone = True
End If
End If
End Function
Public Function EndApp()
' Call this to remove the Mutex. It will be cleared
' anyway by windows, but this ensures it works.
If (m_hMutex <> 0) Then
CloseHandle m_hMutex
End If
m_hMutex = 0
End Function
Comments