Need help with API time call

[ProgAnimal]

Hi all.
I'm trying to use API calls (new to me) to establish a timed delete event. The user sets the time when the SQL server will delete a bunch of records, the timer is set when user clicks "OK" and the form minimizes with the caption returning the current time.

I want to do two things:

1) I want the caption to return the amount of time left before files are deleted (could be a million records). This way processor time can be optimized for running other, more important events, etc.

2) I have used the following code in a module to keep the time, but am unsure of how to compare the current time with the delete time and call the deletion process.

'In a form, named frmDeleteME.

Private Sub GetTime()
'I'm not sure how to use the next three lines:
'Dim Winsock1
'Listen...
'Winsock1.Listen

'This works fine...
'Start timing...
'Call Set_Timer(frmDeleteME.Hwnd, 100, 60000) 'Fire every minute.
Call Set_Timer(frmDeleteMe.hWnd, 101, 1000) 'Fire every second.


End Sub

Private Sub Form_Unload(Cancel As Integer)
'When we leave, cancel our call-backs...
Call Kill_Timer(frmDeleteMe.hWnd, 100)
Call Kill_Timer(frmDeleteMe.hWnd, 101)
End Sub


'In the module I have
Option Explicit

'In a module named MTimer.bas

Private Declare Function SetTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long) As Long

Public Sub TimerProc(ByVal mHwnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, _
ByVal dwTime As Long)
Dim dtWait As Date

Select Case idEvent

Case 100 'We assigned this timer ID to fire every minute.
'Dump some text into the form... etc
frmDeleteMe.Caption = "Scheduler - " & Now()
If frmDeleteMe.DTPDelDate = Date Then
If frmDeleteMe.DTPicker1 = Time Then
'Call frmDeleteMe(DeleteFiles)
End If
End If

Case 101 'This fires every second.
'Update the time or whatever here.
frmDeleteMe.Caption = "Scheduler - " & dtWait

'This doesn't work but I am not sure why...

' If DateDiff("d", Now(), frmDeleteMe.DTPDelDate) < 1 Then
' dtWait = DateDiff("d", Now(), frmDeleteMe.DTPDelDate)
' frmDeleteMe.Caption = "Scheduler - " & dtWait & " days"
' ElseIf DateDiff("h", Now(), frmDeleteMe.DTPicker1) < 1 Then
' dtWait = DateDiff("h", Now(), frmDeleteMe.DTPicker1)
' frmDeleteMe.Caption = "Scheduler - " & dtWait & " hours"
' ElseIf DateDiff("m", Now(), frmDeleteMe.DTPicker1) < 1 Then
' dtWait = DateDiff("m", Now(), frmDeleteMe.DTPicker1)
' frmDeleteMe.Caption = "Scheduler - " & dtWait & " minutes"
' ElseIf DateDiff("s", Now(), frmDeleteMe.DTPicker1) < 1 Then
' dtWait = DateDiff("s", Now(), frmDeleteMe.DTPicker1)
' frmDeleteMe.Caption = "Scheduler - " & dtWait & " seconds"
' Else
' frmDeleteMe.Caption = "Scheduler - " & dtWait " Deletion is taking place."
' Call frmDeleteMe.cmdDelete
' End If

End Select

End Sub

Public Sub Kill_Timer(ByVal mHwnd As Long, ByVal ID As Long)
KillTimer mHwnd, ID
End Sub

Public Sub Set_Timer(ByVal mHwnd As Long, ByVal ID As Long, ByVal Milliseconds As Long)
SetTimer mHwnd, ID, Milliseconds, AddressOf TimerProc
End Sub

Thanks for the help!

ProgAnimal

[DaveAMS]

Not trying to tell you how to code, but I've done similar things using the sql server agent by scheduling a dts package.

If you still want to do it in vb, you might consider using the now() function to get the time. It's a lot easier, and probably more efficient.

[ProgAnimal]

Using the scheduler in DTS is fine except it requires the user to get into SQL Server. My users are end users who I don't want to give direct access to SQL Server. Plus, I am trying to make it somewhat more convenient.

How can I use the "now()" function in this situation? The problem lies in calling the comparison factor (delete time/date) from my form module from an outside module. When I try this, VB completely closes.

Still not sure...

[DaveAMS]

on the form frmDeleteME, I assume that DTPDelDate and DTPicker1 are controls...what type are they? The problem might be with those...

[ProgAnimal]

Dave,
They are DTPicker ActiveX controls.

[DaveAMS]

You might check a couple of things:

(1) Make sure you're running sp4 or higher. A new version of this control (6.0) was released with sp4, and there may have been some bug-fixes relating to this problem. If you're already running sp4 or 5...then I'm at a loss.

(2) This probably isn't causing your crash, but the DateDiff code for minutes is "n". The code you've posted has "m", which is for month.

(3) Assuming you're wanting to count down to a future date, you'll want to use a ">" (greater-than) comparison operator in your if statements. It seems that DateDiff subtracts the first date/time from the second one, giving a positive value if Now() is less than DTPicker.

[ProgAnimal]

Thanks Dave!
When I unload the frmDeleteMe, I check to see if the caption is: frmDeleteMe.Caption = "Deletion is taking place.". If it is, then I call the deletenow procedure from the unload event which does what I want it to do.


Option Explicit

'In a module named MTimer.bas

Private Declare Function SetTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long) As Long

Public Sub TimerProc(ByVal mHwnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, _
ByVal dwTime As Long)
Dim dtWait As Integer
Dim dtday As Integer

Select Case idEvent

Case 100 'We assigned this timer ID to fire every minute.
'Dump some text into the form... etc
frmDeleteMe.Caption = "Scheduler - " & Now()
If frmDeleteMe.DTPDelDate = Date Then
If frmDeleteMe.DTPicker1 = Time Then
'Call frmDeleteMe(DeleteFiles)
End If
End If

Case 101 'This fires every second.
'Update the time or whatever here.
'frmDeleteMe.Caption = "Scheduler - " & Time()
If (frmDeleteMe.DTPDelDate.Day - Format(Date, "d")) > 1 Then
dtWait = (frmDeleteMe.DTPDelDate.Day - Format(Date, "d"))
frmDeleteMe.Caption = "Scheduler - " & dtWait & " days"
ElseIf (frmDeleteMe.DTPDelDate.Day - Format(Date, "d")) = 1 Then
dtWait = (frmDeleteMe.DTPDelDate.Day - Format(Date, "d"))
frmDeleteMe.Caption = "Scheduler - Only " & dtWait & " day left!"
ElseIf (frmDeleteMe.DTPicker1.Hour - Format(Time, "h")) > 1 Then
dtWait = (frmDeleteMe.DTPicker1.Hour - Format(Time, "h"))
frmDeleteMe.Caption = "Scheduler - " & dtWait & " hours"
ElseIf (frmDeleteMe.DTPicker1.Hour - Format(Time, "h")) = 1 Then
dtWait = (frmDeleteMe.DTPicker1.Hour - Format(Time, "h"))
frmDeleteMe.Caption = "Scheduler - Only " & dtWait & " hour left!"
ElseIf (frmDeleteMe.DTPicker1.Minute - Format(Time, "n")) > 1 Then
dtWait = (frmDeleteMe.DTPicker1.Minute - Format(Time, "n"))
frmDeleteMe.Caption = "Scheduler - " & dtWait & " minutes"
Else
dtWait = 60 - Format(Time, "S")
frmDeleteMe.Caption = "Scheduler - " & dtWait & " seconds"
If dtWait = 1 Then
frmDeleteMe.Caption = "Deletion is taking place."
Call Kill_Timer(frmDeleteMe.hWnd, 101)
Unload frmDeleteMe
End If
End If
End Select

End Sub

Public Sub Kill_Timer(ByVal mHwnd As Long, ByVal ID As Long)
KillTimer mHwnd, ID
End Sub

Public Sub Set_Timer(ByVal mHwnd As Long, ByVal ID As Long, ByVal Milliseconds As Long)
SetTimer mHwnd, ID, Milliseconds, AddressOf TimerProc
End Sub