Results 1 to 11 of 11
  1. #1
    Join Date
    Nov 2004
    Location
    Bangor, ME USA
    Posts
    44

    Question Unanswered: is there a way to prevent a second opening of a database on the same computer



    I have a database used by several people on a hospital network. For some reason unbeknownst to our IS team the DB keeps disappearing from the Taskbar and people are opening mutiple copies on the same machine. I have a table called use_logger to see who is logged in as the LDB viewer did not work for my purposes at the time. what I want to do is see if a machine has a copy of the DB open already and if so display a message like

    "This machine already has a copy of this program open. This copy will now close. To view the copy open press [Alt]+[Tab].

    If you are sure there is no open copy now call 1794 to have the computer reset."

    The database would then shut down so that the network resources do not get overloaded.

    When a user clicks on the close button I created on the screen it puts in a shutdown time otherwise is shows as 12:00:00 AM

    So, is there a way to do something like:

    if [nln]=environ("username") AND [nmn]=Environ("machine") AND [Time_Out]=#12:00:00 AM# Then {perform above statement and shotdown this copy} Else Continue with Loading this copy.

    Any help appreciated on this.

    ALSO,

    Sometimes people are shutting down the program accidentally and I want to put a commant like

    "you have asked to close this program ARE YOU SURE?"

    is that where a cancel as integer would come in?

    Any help on this is also appreciated.

    I am a newbie/intermediate VBA programmer, still learning.

    TIA
    Kevin M Carman

  2. #2
    Join Date
    Feb 2005
    Posts
    333
    I'm not sure about your first question but this is how I handle the second.

    Code:
        Dim textStr As String
        Dim title As String
        Dim ansStr As String
        
        textStr = "You are about to exit database." & vbCrLf & _
            vbCrLf & "       Do you wish to exit?"
        title = "Exiting CADET Database"
        ansStr = MsgBox(textStr, vbYesNo, title)
        
        If ansStr = vbYes Then
            DoCmd.Quit
        End If

  3. #3
    Join Date
    Nov 2004
    Location
    out on a limb
    Posts
    13,692
    Provided Answers: 59
    kevin
    just a heads up
    you cannot rely on the environment function to return security information. Environ settigns are too easily spoofed, not always populated or may report wrong information. Depending on the OS & version of Access you are using you should use either an API call (see www.mvps.org\access or search for API call dev ashish) OR a call to the system object. There was a thread on this subject within the last week or so started by Paul Kohn (pkstormy)

  4. #4
    Join Date
    Nov 2004
    Location
    Bangor, ME USA
    Posts
    44

    Question

    Campster:
    Thanks, I had experimented on my own and cane up the same way.

    Healdem:
    I have heard that before, but I am not using it for security purposes, just to see who had logged in. I at home use MSA2K and the hospital is n 2K, 2003 formats and the function I have do just what I need them to. but I heed a way to search the records for the user on that machine, with a Time_out of #12:00:00 AM# but the dlookup won't do what I want. Ijust need to know if the record exists not any specific value in any specific field.

    Thanks again

    any additional comments would be appreciated.

    TIA
    Kevin

  5. #5
    Join Date
    Nov 2004
    Location
    out on a limb
    Posts
    13,692
    Provided Answers: 59
    but by using the environ variable you don not defintively know who has logged in or what PC they are using. You are relying on the information to be correct - it needn't be. I don't know when Access references the environment variables, for all I know it could access them at load time so it could be theoretically possible to have 2 different PC's and 2 different users reported none of which may be true.

  6. #6
    Join Date
    Nov 2004
    Location
    Bangor, ME USA
    Posts
    44
    The environ does what I want and that is all I care about right now as unless the people shut down their machine to fake the user and machine name it does what I need the way I need it. I just need to find how to search for the record for whatever their current machine name is and username and that a recored for them doesnot exsist with a time of #12:00:00 AM# that is what I am looking for.

    Anyone else have thoughs on this point (this is becoming a merry-go-round) my thing works now just the way I want it, correct programming or not it works for me.

  7. #7
    Join Date
    Dec 2004
    Location
    Madison, WI
    Posts
    3,926

    Checking for multiple instances

    Here's code for checking to see if the same program is loaded twice by the same user:

    Public Function winCheckMultipleInstances(Optional fConfirm As Boolean = True) As Boolean
    Dim fSwitch As Boolean, sMyCaption As String
    Dim hWndApp As Long, hWndDb As Long
    On Error GoTo ProcErr
    sMyCaption = winGetTitle(winGetHWndDB())
    hWndApp = apiGetWindow(apiGetDesktopWindow(), GW_CHILD)
    Do Until hWndApp = 0
    If hWndApp <> Application.hWndAccessApp Then
    hWndDb = winGetHWndDB(hWndApp)
    If hWndDb <> 0 Then
    If sMyCaption = winGetTitle(hWndDb) Then Exit Do
    End If
    End If
    hWndApp = apiGetWindow(hWndApp, GW_HWNDNEXT)
    Loop
    If hWndApp = 0 Then Exit Function
    If fConfirm Then
    MsgBox sMyCaption & " is already open! This is a warning that you should check the bottom to verify that you already have the program open.", vbOKOnly
    Application.Quit
    End If
    apiSetActiveWindow hWndApp
    If apiIsIconic(hWndApp) Then
    apiShowWindowAsync hWndApp, SW_RESTORE
    Else
    apiShowWindowAsync hWndApp, SW_SHOW
    End If
    Application.Quit
    ProcEnd:
    Exit Function
    ProcErr:
    MsgBox Err.Description
    Resume ProcEnd
    End Function
    '******************** Code End ********************

    Call this by issuing the following:

    call winCheckMultipleInstances(true)
    Expert Database Programming
    MSAccess since 1.0, SQL Server since 6.5, Visual Basic (5.0, 6.0)

  8. #8
    Join Date
    Nov 2004
    Location
    Bangor, ME USA
    Posts
    44
    I was going through my old posts and saw the reply on how to check for multi instances of same user. when I copied the code you graciously provided, and compiled it, it came back function not defined for winGetHWndDB()

    Is this an access fuction or something you created? If it is supposed to be in a library, which one?

    Thanks
    Kevin M Carman

  9. #9
    Join Date
    Nov 2004
    Location
    out on a limb
    Posts
    13,692
    Provided Answers: 59
    sounds like an API call, its probably referncing a windows DLL. Paul should be able to provide more details
    I'd rather be riding on the Tiger 800 or the Norton

  10. #10
    Join Date
    Dec 2004
    Location
    Madison, WI
    Posts
    3,926

    One Instance

    Here's the entire module (sorry about that - I only copied part of the module):

    '******************** Code Start ********************
    Option Compare Database
    Option Explicit

    ' Module mdlCheckMultipleInstances
    ' Graham Mandeno, Alpha Solutions, Auckland, NZ
    ' graham@alpha.co.nz
    ' This code may be used and distributed freely on the condition
    ' that the above credit is included unchanged.

    Private Const cMaxBuffer = 255

    Private Declare Function apiGetClassName Lib "user32" _
    Alias "GetClassNameA" _
    (ByVal hwnd As Long, _
    ByVal lpClassName As String, _
    ByVal nMaxCount As Long) _
    As Long

    Private Declare Function apiGetDesktopWindow Lib "user32" _
    Alias "GetDesktopWindow" _
    () As Long

    Private Declare Function apiGetWindow Lib "user32" _
    Alias "GetWindow" _
    (ByVal hwnd As Long, _
    ByVal wCmd As Long) _
    As Long

    Private Const GW_CHILD = 5
    Private Const GW_HWNDNEXT = 2

    Private Declare Function apiGetWindowText Lib "user32" _
    Alias "GetWindowTextA" _
    (ByVal hwnd As Long, _
    ByVal lpString As String, _
    ByVal aint As Long) _
    As Long

    Private Declare Function apiSetActiveWindow Lib "user32" _
    Alias "SetActiveWindow" _
    (ByVal hwnd As Long) _
    As Long

    Private Declare Function apiIsIconic Lib "user32" _
    Alias "IsIconic" _
    (ByVal hwnd As Long) _
    As Long

    Private Declare Function apiShowWindowAsync Lib "user32" _
    Alias "ShowWindowAsync" _
    (ByVal hwnd As Long, _
    ByVal nCmdShow As Long) _
    As Long

    Private Const SW_SHOW = 5
    Private Const SW_RESTORE = 9

    Public Function winGetClassName(hwnd As Long) As String
    Dim sBuffer As String, iLen As Integer
    sBuffer = String$(cMaxBuffer - 1, 0)
    iLen = apiGetClassName(hwnd, sBuffer, cMaxBuffer)
    If iLen > 0 Then
    winGetClassName = left$(sBuffer, iLen)
    End If
    End Function

    Public Function winGetTitle(hwnd As Long) As String
    Dim sBuffer As String, iLen As Integer
    sBuffer = String$(cMaxBuffer - 1, 0)
    iLen = apiGetWindowText(hwnd, sBuffer, cMaxBuffer)
    If iLen > 0 Then
    winGetTitle = left$(sBuffer, iLen)
    End If
    End Function

    Public Function winGetHWndDB(Optional hWndApp As Long) As Long
    Dim hwnd As Long
    winGetHWndDB = 0
    If hWndApp <> 0 Then
    If winGetClassName(hWndApp) <> "OMain" Then Exit Function
    End If
    hwnd = winGetHWndMDI(hWndApp)
    If hwnd = 0 Then Exit Function
    hwnd = apiGetWindow(hwnd, GW_CHILD)
    Do Until hwnd = 0
    If winGetClassName(hwnd) = "ODb" Then
    winGetHWndDB = hwnd
    Exit Do
    End If
    hwnd = apiGetWindow(hwnd, GW_HWNDNEXT)
    Loop
    End Function

    Public Function winGetHWndMDI(Optional hWndApp As Long) As Long
    Dim hwnd As Long
    winGetHWndMDI = 0
    If hWndApp = 0 Then hWndApp = Application.hWndAccessApp
    hwnd = apiGetWindow(hWndApp, GW_CHILD)
    Do Until hwnd = 0
    If winGetClassName(hwnd) = "MDIClient" Then
    winGetHWndMDI = hwnd
    Exit Do
    End If
    hwnd = apiGetWindow(hwnd, GW_HWNDNEXT)
    Loop
    End Function

    Public Function winCheckMultipleInstances(Optional fConfirm As Boolean = True) As Boolean
    Dim fSwitch As Boolean, sMyCaption As String
    Dim hWndApp As Long, hWndDb As Long
    On Error GoTo ProcErr
    sMyCaption = winGetTitle(winGetHWndDB())
    hWndApp = apiGetWindow(apiGetDesktopWindow(), GW_CHILD)
    Do Until hWndApp = 0
    If hWndApp <> Application.hWndAccessApp Then
    hWndDb = winGetHWndDB(hWndApp)
    If hWndDb <> 0 Then
    If sMyCaption = winGetTitle(hWndDb) Then Exit Do
    End If
    End If
    hWndApp = apiGetWindow(hWndApp, GW_HWNDNEXT)
    Loop
    If hWndApp = 0 Then Exit Function
    If fConfirm Then
    MsgBox sMyCaption & " is already open! This is a warning that you should check the bottom to verify that you already have the program open.", vbOKOnly
    Application.Quit
    End If
    apiSetActiveWindow hWndApp
    If apiIsIconic(hWndApp) Then
    apiShowWindowAsync hWndApp, SW_RESTORE
    Else
    apiShowWindowAsync hWndApp, SW_SHOW
    End If
    Application.Quit
    ProcEnd:
    Exit Function
    ProcErr:
    MsgBox err.Description
    Resume ProcEnd
    End Function
    '******************** Code End ********************
    Expert Database Programming
    MSAccess since 1.0, SQL Server since 6.5, Visual Basic (5.0, 6.0)

  11. #11
    Join Date
    Mar 2003
    Location
    The Bottom of The Barrel
    Posts
    6,102
    Provided Answers: 1
    I do it this way:

    Code:
    Option Compare Database
    
    
    'Custom structure for passing in the parameters in/out of the hook enumeration function
    'Could use global variables instead, but this is nicer :)
    Type FindWindowParameters
    
        strTitle As String  'INPUT
        hwnd As Long        'OUTPUT
    
    End Type
    
    Public Function FnFindWindowLike(strWindowTitle As String) As Long
    
        'We'll pass a custom structure in as the parameter to store our result...
        Dim Parameters As FindWindowParameters
        Parameters.strTitle = strWindowTitle ' Input parameter
    
        Call EnumWindows(AddressOf EnumWindowProc, VarPtr(Parameters))
        
        FnFindWindowLike = Parameters.hwnd
        
    End Function
    
    Public Function EnumWindowProc(ByVal hwnd As Long, _
                                   lParam As FindWindowParameters) As Long
       
       Dim strWindowTitle As String
    
       strWindowTitle = Space(260)
       Call GetWindowText(hwnd, strWindowTitle, 260)
       strWindowTitle = TrimNull(strWindowTitle)
                                              
       If strWindowTitle Like lParam.strTitle Then
       
            lParam.hwnd = hwnd 'Store the result for later.
            EnumWindowProc = 0 'This will stop enumerating more windows
       
       End If
                               
       EnumWindowProc = 1
    
    End Function
    
    Public Function TrimNull(strNullTerminatedString As String)
    
        Dim lngPos As Long
    
        'Remove unnecessary null terminator
        lngPos = InStr(strNullTerminatedString, Chr$(0))
       
        If lngPos Then
            TrimNull = Left$(strNullTerminatedString, lngPos - 1)
        Else
            TrimNull = strNullTerminatedString
        End If
       
    End Function
    And then:

    Code:
    Public Declare Function SetForegroundWindow Lib "User32" _
         (ByVal hwnd As Long) As Long
    
    Public Sub yourSub
    Dim wHnd As Long
    
    wHnd = FnFindWindowLike("*yourStringHere*")
    
    If wHnd <> 0 Then
        SetForegroundWindow (wHnd)
    Else
        wHnd = Shell("yourPathHere", vbNormalFocus)
        SetForegroundWindow (wHnd)
    End If
    End Sub
    oh yeah... documentation... I have heard of that.

    *** What Do You Want In The MS Access Forum? ***

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •