dato & tid

[lars1]

Hei!

 

Holder på å lage et vedlikeholds program og lurte på hvordan jeg får programmet til å gi en beskjed når neste vedlikehold skal foregå...

 

Poenget er slik at i programmet skriver man f.eks inn 3mnd i et tekstfelt om 3 mnd skal programmet gi beskjed om at det har gått 3mnd.

 

Noen glupe sjeler som kan hjelpe meg der ute???

[aadnk]

Hva med å bruke scheduled task? På den måten trenger man ikke ha programmet åpent hele tiden og overtar jobben til Windows. Først, legg dette i en modul:

 

Option Explicit

Declare Function NetScheduleJobAdd Lib "netapi32.dll" (ByVal Servername As String, Buffer As Any, Jobid As Long) As Long
Declare Function NetScheduleJobDel Lib "netapi32.dll" (ByVal Servername As String, minJobId As Long, maxJobId As Long) As Long
Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long

' Schedule structure
Private Type AT_INFO
JobTime As Long
DaysOfMonth As Long
DaysOfWeek As Byte
Flags As Byte
dummy As Integer
command As String
End Type

Const JOB_NONINTERACTIVE As Long = &H10
Const JOB_RUN_PERIODICALLY As Long = &H1
Const NERR_Success As Long = 0

' t = time
' d = date
' c = command (what program it should run and stuff)
' i = INTERACTIVE
' p = RUN_PERIODICALLY

Public Sub Create_Scheduled_Event(t As String, d As String, c As String, Optional i As Boolean = False, Optional p As Boolean = True)

Dim strTime As String
Dim strDate() As String
Dim vntWeek() As Variant
Dim intCounter As Integer
Dim intWeekCounter As Integer
Dim at As AT_INFO
Dim lngJobID As Long
Dim lngWin32apiResultCode As Long
Dim strComputerName As String

strComputerName = StrConv(Get_Computer_Name, vbUnicode)

Err.Clear

vntWeek = Array("M", "T", "W", "TH", "F", "S", "SU")

With at
 strTime = Format(t, "hh:mm")
 .JobTime = (Hour(strTime) * 3600 + Minute(strTime) * 60) * 1000
 If Val(d) > 0 Then
   strDate = Split(d, ",")
   For intCounter = 0 To UBound(strDate)
     .DaysOfMonth = .DaysOfMonth + 2 ^ (strDate(intCounter) - 1)
   Next
 Else
   strDate = Split(d, ",")
   For intCounter = 0 To UBound(strDate)
     For intWeekCounter = 0 To UBound(vntWeek)
       If UCase(strDate(intCounter)) = vntWeek(intWeekCounter) Then
         .DaysOfWeek = .DaysOfWeek + 2 ^ intWeekCounter
       End If
     Next
   Next
 End If
 
 If i = False Then .Flags = .Flags Or JOB_NONINTERACTIVE
 
 If p = True Then .Flags = .Flags Or JOB_RUN_PERIODICALLY

 .command = StrConv(c, vbUnicode)
End With
 
lngWin32apiResultCode = NetScheduleJobAdd(strComputerName, at, lngJobID)

' Dette er ikke nødvendig, og sikkert irriterende for brukeren
If lngWin32apiResultCode = NERR_Success Then MsgBox "Task " & lngJobID & " has been scheduled."

End Sub

Public Function Get_Computer_Name() As String

Dim pc_name As String

pc_name = Space(255)
GetComputerName pc_name, 255
Get_Computer_Name = "\\" & Trim(pc_name)
   
End Function

 

Kommandoen kunne f.eks være App.Path & "\" & App.EXEname & " \timeout". Så får du programmet til å sjekke kommandolinjen hver gang den starter ved å sette Sub Main til startup (Project>[Prosjekt navn] propeties>Startup object og setter den til Sub Main). Legg så f.eks dette inn i en modul:

 

Sub Main()

If Command$ = "\timeout" Then
' Hva som skal skje hvis tiden har gått ut

...

End If

' Formen som alltid skal starte
Form1.Show

End Sub

[novcius]

Hehe du trenger ikke bruke API-calls for å lage en scheduled task:

 

at /?

The AT command schedules commands and programs to run on a computer at

a specified time and date. The Schedule service must be running to use

the AT command.