[RESOLVED] GetCursorPos API and Date problem

I have a module with a module level date variable.
It also uses the GetCursorPos API.
The problem is that every time the GetCursorPos call is made, the date variable is being reset to '11/15/2006 12:45:00 AM '

Is this a known issue?
Any way to fix it?

that sounds a bit unlikely - can you post your code

You might have declared the GetCursorPos function the wrong way, that's the only reason I can see how other memory resources are written over. Can you please post the declaration you're using for the function and for the POINTAPI structure.

It's a modified version of some code I got from PSC.

It checks to see how long a user has been idle.

I set a watch on the g_lIdleTime variable to find were the reset was happening.

VB Code:

Option Explicit
'**************************************
'Windows API/Global Declarations for :check for user activity throughout the system
'**************************************
 
Private Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long
 
Private Declare Sub GetCursorPos Lib "user32.dll" (lpPoint As POINTAPI)
 
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vkey As Long) As Integer
 
Private Type POINTAPI
    X As Integer
    Y As Integer
End Type
 
Private posOld As POINTAPI
Private posNew As POINTAPI
 
Private m_dStartTime As Date
Public g_lIdleTime As Long 'number of seconds the user has been idle
'**************************************
' Name: check for user activity througho
'     ut the system
' Description:check for user activity throughout the system ,comes in handy when you want to check if the user is uses his computer or not and then take some action depending on it like showing a screensaver or do some maintenance or whatever ofcourse you should use this in combination with a timer control or function
' By: Michel Posseth
'**************************************
Public Sub CheckIdleTime()
'this sub needs to be called from a timer or loop
    Dim lX As Long
    
    If m_dStartTime = "12:00:00 AM" Then
        m_dStartTime = Now
        'clear the CheckKeys
        For lX = 32 To 126
            GetAsyncKeyState Asc(Chr$(lX))
        Next
    End If
    If InputCheck Then
        g_lIdleTime = 0
        m_dStartTime = Now
    Else
        g_lIdleTime = DateDiff("s", m_dStartTime, Now)
    End If
End Sub
 
Private Function InputCheck() As Boolean
    Dim i As Integer
    Dim KeyVal As Integer 'key value
    
    ' take mouse coordinates as they are
    Call GetCursorPos(posNew)
    ' compare them with the previous values
    If ((posNew.X <> posOld.X) Or (posNew.Y <> posOld.Y)) Then
'    Beep 50, 50
        posOld = posNew
        InputCheck = True
        'mouse has been moved no need to check further
        Exit Function
    End If
    
    For KeyVal = 32 To 126
        'check the keys, allow it to loop all keys to clear them
        InputCheck = CBool(GetAsyncKeyState(Asc(Chr$(KeyVal))))
    Next
    
End Function

try this

VB Code:

Option Explicit
'**************************************
'Windows API/Global Declarations for :check for user activity throughout the system
'**************************************
 
Private Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long
 
Private Declare Sub GetCursorPos Lib "user32.dll" (lpPoint As POINTAPI)
 
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vkey As Long) As Integer
 
Private Type POINTAPI
    X As Integer
    Y As Integer
End Type
 
Private posOld As POINTAPI
Private posNew As POINTAPI
 
 
Public g_lIdleTime As Long 'number of seconds the user has been idle
'**************************************
' Name: check for user activity througho
'     ut the system
' Description:check for user activity throughout the system ,comes in handy when you want to check if the user is uses his computer or not and then take some action depending on it like showing a screensaver or do some maintenance or whatever ofcourse you should use this in combination with a timer control or function
' By: Michel Posseth
'**************************************
Public Sub CheckIdleTime()
[B]Dim m_dStartTime As Date 'postion changed[/B]
'this sub needs to be called from a timer or loop
    Dim lX As Long
    
    If m_dStartTime = "12:00:00 AM" Then
        m_dStartTime = Now
        'clear the CheckKeys
        For lX = 32 To 126
            GetAsyncKeyState Asc(Chr$(lX))
        Next
    End If
    If InputCheck Then
        g_lIdleTime = 0
        m_dStartTime = Now
    Else
        g_lIdleTime = DateDiff("s", m_dStartTime, Now)
    End If
End Sub
 
Private Function InputCheck() As Boolean
    Dim i As Integer
    Dim KeyVal As Integer 'key value
    
    ' take mouse coordinates as they are
    Call GetCursorPos(posNew)
    ' compare them with the previous values
    If ((posNew.X <> posOld.X) Or (posNew.Y <> posOld.Y)) Then
'    Beep 50, 50
        posOld = posNew
        InputCheck = True
        'mouse has been moved no need to check further
        Exit Function
    End If
    
    For KeyVal = 32 To 126
        'check the keys, allow it to loop all keys to clear them
        InputCheck = CBool(GetAsyncKeyState(Asc(Chr$(KeyVal))))
    Next
    
End Function
 
Private Sub Command1_Click()
Call CheckIdleTime
End Sub

i mis-said something.

It's the m_dStartTime variable that's being reset and has a watch set.

How do you call this function?

Quote:

---

Originally Posted by danasegarane

try this

---

Moving the m_dStartTime variable into a sub won't work unless it's dimed as Static.
It's value needs to be carried over time.

I just tried it as a static but it still has the same problem.

Also, the module needs to be called by a timer or loop.

My computer had been running several days without a reboot.
I just rebooted to see if XP was acting up, but it didn't help.

dStartTime is still being reset at:
Call GetCursorPos(posNew)

In the InputCheck Function

I just came up with a hack that works, but I'd still like to know what's going on with the original code

VB Code:

Private Function InputCheck() As Boolean
    Dim i As Integer
    Dim KeyVal As Integer 'key value
    Dim dHack As Date
    
    ' take mouse coordinates as they are
    dHack = m_dStartTime 'this shouldn't be needed but GetCursorPos is changing m_dStartTime
    Call GetCursorPos(posNew)
    m_dStartTime = dHack
    ' compare them with the previous values
    If ((posNew.X <> posOld.X) Or (posNew.Y <> posOld.Y)) Then
'    Beep 50, 50
        posOld = posNew
        InputCheck = True
        'mouse has been moved no need to check further
        Exit Function
    End If
    
    For KeyVal = 32 To 126
        'check the keys, allow it to loop all keys to clear them
        InputCheck = CBool(GetAsyncKeyState(Asc(Chr$(KeyVal))))
    Next
    
End Function

The problem is in the POINTAPI declaration, it should contain two 32-bit integers but you have assigned two 16-bit integers to it, so when you call the function it writes information to a 64-bit memory area, but your POINTAPI is only 32-bit which means that other data is overwritten, which happens to be another variable, which is why you don't get a GPF. Change the declaration to:

VB Code:

Private Type POINTAPI
    X As [b]Long [/b]
    Y As [b]Long [/b]
End Type

Thanks Joacim!
That fixed it.

I guess that's what I get for using cut-in-paste code without studying every line :)

a couple of further comments about the code:

VB Code:

Asc(Chr$(lX))

is pointless - you're taking a virtual KeyCode, interpretting it as a ASCII number (which it isn't) to make a String and then reading the ASCII value of the string - i.e. you end up back where you started.

VB Code:

For KeyVal = 32 To 126
        'check the keys, allow it to loop all keys to clear them
        InputCheck = CBool(GetAsyncKeyState(Asc(Chr$(KeyVal))))
    Next

InputCheck will only ever be equal to the last GetAsyncKeyState in the loop - i.e. InputCheck will only be true if whatever key 126 is, is depressed - you can bash away at all the other keys without the idle time ever being reset.

VB Code:

For lX = 32 To 126
            GetAsyncKeyState Asc(Chr$(lX))
        Next

GetAsyncKeyState doesn't do anything when it's called - the only functionality you get from it is by capturing the return value - which you're not doing, so this is pointless too.

All in all, this is a great example of why most of the code at PSC can be ignored - it's crap. I'd recommend going in search of some better stuff, here or at FreeVBCode for example.

Yep, I thought the Asc(Chr$(lX)) looked funny.
I hadn't gotten o the point of optimizing the code.
I just needed to find out what was causing the date reset.

But I removed an "Exit For" from the CBool(GetAsyncKeyState(KeyVal)) loop because I found that test was catching each key.

I'm using a timer with a 2 second delay to call CheckIdleTime.
Try replacing the InputCheck function with the next code and see what the Debug.Print puts out.

VB Code:

Private Function InputCheck() As Boolean
    Dim KeyVal As Integer
    
    ' take mouse coordinates as they are
    Call GetCursorPos(posNew)
    ' compare them with the previous values
    If ((posNew.X <> posOld.X) Or (posNew.Y <> posOld.Y)) Then
        posOld = posNew
        InputCheck = True
        'mouse has been moved no need to check further
        Exit Function
    End If
    
    For KeyVal = 32 To 126
        'check the keys, allow it to loop all keys to clear them\
        InputCheck = CBool(GetAsyncKeyState(KeyVal))
        If InputCheck Then
            Beep '50, 50
            Debug.Print KeyVal
            Exit For
        End If
    Next
    
End Function