program to reboot os when the current date does not match the bootup date.
the reboot can occur at any time, not just when a user is logged on, but at any time.


notice.
Care should be taken while running this program due to the fact if files are opened at the time of a reboot, shutdown, or logoff, files can be destroyed or altered. Any user of this program accepts this condition and responsibility for any and all damages this program might cause to his computer system or somebody else's computer system.


Acknowledgment to Ben Clark for the service template and Tonny Bjorn for reboot/shutdown/logoff code.

any discussion can be placed here
User to user discussions about the PB/Win (formerly PB/DLL) product line. Discussion topics include PowerBASIC Forms, PowerGEN and PowerTree for Windows.



Code:
'pbwin 8.04
'RBTMIDNT.BAS
'PROGRAM TO RUN AS A SERVICE AND REBOOT THE OS SHORTLY AFTER MIDNIGHT OR
'    OR IF OS DATE DOES NOT MATCH THE LAST REBOOTED DATE.
'
#COMPILE EXE "RBTMIDNT.EXE"

'$RESOURCE "RESOURCE.PBR" ' Embed the resources into the exe

#DIM ALL ' Force ALL vars to have to be declared


#INCLUDE "WIN32API.INC"
' My includes actually have the WinAPI includes in them.

GLOBAL hWindow AS LONG ' You should set this in your WINMAINX to the handle
' of your main window.

GLOBAL glastdaterebooted AS STRING

SUB ShutDownNT(BYVAL DoWhat AS LONG)
    LOCAL OSVersion         AS OSVERSIONINFO
    LOCAL ProcessHandle     AS LONG
    LOCAL TokenHandle       AS LONG
    LOCAL TempLUID          AS LUID
    LOCAL TokenPrivilleges  AS TOKEN_PRIVILEGES
    LOCAL TKPDummy          AS TOKEN_PRIVILEGES
    LOCAL lReturnLength     AS LONG
    OSVersion.dwOSVersionInfoSize = SIZEOF(OSVersion)
    IF GetVersionEx(OSVersion) <> 0 THEN
        IF OSVersion.dwPlatformId = %VER_PLATFORM_WIN32_NT THEN
            ProcessHandle = GetCurrentProcess()
            CALL OpenProcessToken(ProcessHandle, %TOKEN_ADJUST_PRIVILEGES OR %TOKEN_QUERY, TokenHandle)
            CALL LookupPrivilegeValue("", "SeShutdownPrivilege", TempLUID)
            TokenPrivilleges.PrivilegeCount = 1
            TokenPrivilleges.Privileges(0).pLuid = TempLUID
            TokenPrivilleges.Privileges(0).Attributes = %SE_PRIVILEGE_ENABLED
            IF AdjustTokenPrivileges(TokenHandle, %FALSE, TokenPrivilleges, LEN(TKPDummy), TKPDummy, lReturnLength) THEN
                ' Flags: %EWX_LOGOFF, %EWX_SHUTDOWN, %EWX_REBOOT, %EWX_FORCE, %EWX_POWEROFF
                SELECT CASE DoWhat
                    CASE 1
                        ' Force Shut Down and ReBoot
                        CALL ExitWindowsEx(%EWX_FORCE OR %EWX_SHUTDOWN OR %EWX_REBOOT, 0)
                    CASE 2
                        ' Force Logoff user' Force Logoff user
                        CALL ExitWindowsEx(%EWX_FORCE OR %EWX_LOGOFF, 0)
                    CASE ELSE
                        ' Force Shut Down and Power Off
                        CALL ExitWindowsEx(%EWX_FORCE OR %EWX_SHUTDOWN OR %EWX_POWEROFF, 0)
                END SELECT
            END IF
        END IF
    END IF
END SUB

 FUNCTION rebootmessage(BYVAL A AS LONG) AS LONG
  MSGBOX "A forced reboot is scheduled in 30 seconds."+$CRLF+_
         "Sorry, a count down timer is not possible."+$CRLF+_
         "A reboot will occur if the date is not the same date when the OS started."+$CRLF+_
         "The last date the OS started was on "+glastdaterebooted+"." , %MB_SERVICE_NOTIFICATION, "Message"
END FUNCTION


FUNCTION winmainx() AS LONG
LOCAL lRESULT, hthread1 AS LONG
glastdaterebooted=DATE$
SLEEP 60000 'give the operation system time to become stable

CHECKTHEDATE:
IF glastdaterebooted=DATE$ THEN SLEEP 5000:GOTO checkthedate

THREAD CREATE rebootmessage(1&) TO hthread1
SLEEP 300
THREAD CLOSE hthread1 TO lresult
SLEEP 31000
CALL ShutDownNT(1)

END FUNCTION


'#INCLUDE "MYINC.INC" ' This was the main Bas file for my executable

' ---------------------
' CONSTANT DECLARATIONS
' ---------------------
%EVENTLOG_AUDIT_FAILURE = 16
%EVENTLOG_AUDIT_SUCCESS = 8
%EVENTLOG_ERROR_TYPE = 1
%EVENTLOG_INFORMATION_TYPE = 4
%EVENTLOG_SUCCESS = 0
%EVENTLOG_WARNING_TYPE = 2

' This constant is used to set logging status.
%EVENTLOG_LEVEL = %EVENTLOG_AUDIT_FAILURE + %EVENTLOG_AUDIT_SUCCESS + %EVENTLOG_ERROR_TYPE + _
%EVENTLOG_INFORMATION_TYPE + %EVENTLOG_SUCCESS + %EVENTLOG_WARNING_TYPE
%SERVICE_WIN32_OWN_PROCESS = &H10&
%SERVICE_WIN32_SHARE_PROCESS = &H20&
%SERVICE_WIN32 = %SERVICE_WIN32_OWN_PROCESS + %SERVICE_WIN32_SHARE_PROCESS
%SERVICE_DEMAND_START = &H3&
%SERVICE_ERROR_NORMAL = &H1&
%WAIT_OBJECT_0 = 0&

' -------------------------
' FUNCTION/SUB DECLARATIONS
' -------------------------
DECLARE FUNCTION Install() AS LONG
DECLARE FUNCTION InitService() AS LONG
DECLARE FUNCTION Uninstall() AS LONG
DECLARE FUNCTION WinErrorMessage(BYVAL ErrNumber AS LONG) AS STRING
DECLARE FUNCTION SendStatus(BYVAL CurrentStatus AS DWORD, BYVAL ExitCode AS DWORD, ServiceSpecificExitCode AS LONG, BYVAL Checkpoint AS DWORD, BYVAL WaitHint AS DWORD) AS LONG
DECLARE FUNCTION ServiceThread(ID AS LONG) AS LONG
DECLARE SUB Handler(BYVAL ControlValue AS DWORD)
DECLARE SUB LogNTEvent(Message AS STRING, LogCode AS LONG)
DECLARE SUB ServiceMain(BYVAL dwArgs AS DWORD, BYVAL lpszArgv AS DWORD)
DECLARE SUB Terminate(ErrCode AS DWORD)
DECLARE SUB StopService()
DECLARE SUB PauseService()
DECLARE SUB ResumeService()

' ----------------
' GLOBAL VARIABLES
' ----------------
GLOBAL gascServiceName AS ASCIIZ * 8
GLOBAL gascServiceDisplayName AS ASCIIZ * 256
GLOBAL gdwdhStatus AS DWORD
GLOBAL gdwdServiceState AS DWORD
GLOBAL gdwdServiceStatus AS DWORD
GLOBAL glnghInstance AS LONG
GLOBAL glnghPrvInst AS LONG
GLOBAL glnghTerminateEvent AS LONG
GLOBAL glnghServiceThread AS LONG
GLOBAL glngThreadResult AS LONG
GLOBAL glngRunningService AS LONG
GLOBAL glngPauseService AS LONG
GLOBAL glngCmdShow AS LONG
GLOBAL ptrCmdLine AS ASCIIZ PTR

' FUNCTION: WinMain
FUNCTION WINMAIN(BYVAL hCurInst AS LONG, BYVAL hPrvInst AS LONG, BYVAL CmdLine AS ASCIIZ PTR, BYVAL CmdShow AS LONG) EXPORT AS LONG
DIM Result AS LONG
DIM CmdParm AS STRING
DIM udtSTE AS SERVICE_TABLE_ENTRY

' Set the service name and display name here.
gascServiceName = "RBTMIDNT SERVICE"
gascServiceDisplayName = "Restart on New Date"
glngHInstance = hCurInst
glnghPrvInst = hPrvInst
glngCmdShow = CmdShow
ptrCmdLine = CmdLine

' Get the Command Line parms
CmdParm = UCASE$(EXTRACT$(@CmdLine, ANY " ,." + CHR$(9)))
' Get rid of any seperators
CmdParm = REMOVE$(CmdParm, ANY "-\/")

' If the exe was executed with the Install parm then we just install and quit
IF CmdParm = "INSTALL" THEN
' Install the service.
Result = Install()
IF ISFALSE Result THEN
MSGBOX "An error occured while trying to install this service
END IF
' If the exe was executed with the UnInstall parm then we just uninstall and quit
ELSEIF CmdParm = "UNINSTALL" THEN
' Uninstall the service.
Result = Uninstall()
IF ISFALSE Result THEN
MSGBOX "An error occured while trying to uninstall this service
END IF

' No parms were given that we want so start up as service
' This should only happen when the service control manager starts us
ELSE

udtSTE.lpServiceName = VARPTR(gascServiceName)
udtSTE.lpServiceProc = CODEPTR(ServiceMain)

Result = StartServiceCtrlDispatcher(udtSTE)

IF Result = 0 THEN
ExitProcess GetLastError()
END IF

END IF

FUNCTION = 0

END FUNCTION

' Install the service into windows
FUNCTION Install() AS LONG
DIM dwdRet AS DWORD
DIM lngDQEnd AS LONG
DIM lngDQStart AS LONG
DIM lngHSCManager AS LONG
DIM lngHService AS LONG
DIM ascEXE AS ASCIIZ * %MAX_PATH

ON ERROR GOTO Error_Install

' Assume a failure for now.
FUNCTION = %FALSE

lngHSCManager = OpenSCManager(BYVAL %NULL, BYVAL %NULL, %SC_MANAGER_CREATE_SERVICE)

IF lngHSCManager <> %NULL THEN
' OK, we have a handle to the SCM.
' Get the full EXE file path.
dwdRet = GetModuleFileName(glngHInstance, ascEXE, %MAX_PATH)
IF dwdRet <> 0 THEN
' Install the service.
lngHService = CreateService(lngHSCManager, gascServiceName, gascServiceDisplayName, _
%SERVICE_ALL_ACCESS, %SERVICE_WIN32_OWN_PROCESS, _
%SERVICE_AUTO_START, %SERVICE_ERROR_NORMAL, _
ascEXE, BYVAL %NULL, BYVAL %NULL, _
BYVAL %NULL, BYVAL %NULL, BYVAL %NULL)
' Close any service handles.
IF lngHService <> %NULL THEN
' Success!
FUNCTION = %TRUE
CloseServiceHandle lngHService
END IF
CloseServiceHandle lngHSCManager
END IF
END IF

FUNCTION = %TRUE

EXIT FUNCTION

Error_Install:

FUNCTION = -1& * ERR

ON ERROR RESUME NEXT

' Close any service handles.
IF lngHService <> %NULL THEN
CALL CloseServiceHandle(lngHService)
END IF

IF lngHSCManager <> %NULL THEN
CALL CloseServiceHandle(lngHSCManager)
END IF

END FUNCTION

' Unistall the service
FUNCTION Uninstall() AS LONG
DIM lngHSCManager AS LONG
DIM lngHService AS LONG

ON ERROR GOTO Error_Uninstall

' Assume a failure for now.
FUNCTION = %FALSE

lngHSCManager = OpenSCManager(BYVAL %NULL, BYVAL %NULL, %SC_MANAGER_CREATE_SERVICE)

IF lngHSCManager <> %NULL THEN
' OK, we have a handle to the SCM.
' Now open our service.
lngHService = OpenService(lngHSCManager, gascServiceName, %SERVICE_ALL_ACCESS)
IF lngHService <> %NULL THEN
' Delete the service.
IF DeleteService(lngHService) <> %NULL THEN
' Success!
FUNCTION = %TRUE
END IF
CloseServiceHandle lngHService
END IF
CloseServiceHandle lngHSCManager
END IF

EXIT FUNCTION

Error_Uninstall:

FUNCTION = -1& * ERR

ON ERROR RESUME NEXT

' Close any service handles.
IF lngHService <> %NULL THEN
CloseServiceHandle lngHService
END IF

IF lngHSCManager <> %NULL THEN
CloseServiceHandle lngHSCManager
END IF

END FUNCTION

' Start up the service
FUNCTION InitService() AS LONG
DIM lngRet AS LONG
DIM ID AS LONG
DIM udtSTE AS SERVICE_TABLE_ENTRY
DIM lpThreadAttributes AS SECURITY_ATTRIBUTES

' Start the main thread for this service
glnghServiceThread = CreateThread(lpThreadAttributes, 0, CODEPTR(ServiceThread), 0, 0, ID)

' Did the thread start OK
IF glnghServiceThread = 0 THEN
FUNCTION = %FALSE
EXIT FUNCTION
ELSE
' Set the global to running
glngRunningService = %TRUE

FUNCTION = %TRUE
EXIT FUNCTION
END IF

END FUNCTION

SUB PauseService()

' Set the global indicating that we are not paused
glngPauseService = %TRUE

' Let er rip
SuspendThread glnghServiceThread

END SUB

SUB ResumeService()

' Set the global indicating that we are not paused
glngPauseService = %FALSE

' Let er rip
ResumeThread glnghServiceThread

END SUB

SUB StopService()

' Set the global flag indicating that the service is not running
glngRunningService = %FALSE

' Set the event so the service will stop
SetEvent glnghTerminateEvent

END SUB

FUNCTION SendStatus(BYVAL CurrentStatus AS DWORD, BYVAL ExitCode AS DWORD, ServiceSpecificExitCode AS LONG, BYVAL Checkpoint AS DWORD, BYVAL WaitHint AS DWORD) AS LONG
DIM udtSS AS SERVICE_STATUS

' Reset the global service status value.
gdwdServiceStatus = CurrentStatus

' Setup the UDT.
udtSS.dwServiceType = %SERVICE_WIN32_OWN_PROCESS
udtSS.dwCurrentState = CurrentStatus

' If we are the process of starting, then don't accept control events
IF CurrentStatus = %SERVICE_START_PENDING THEN
udtSS.dwControlsAccepted = 0
ELSE
' Take what was given
udtSS.dwControlsAccepted = %SERVICE_ACCEPT_STOP + %SERVICE_ACCEPT_PAUSE_CONTINUE + %SERVICE_ACCEPT_SHUTDOWN
END IF

' If a specific ServiceSpecificExitCode is defined, setup the Win32 exit code properly
IF ServiceSpecificExitCode = 0 THEN
udtSS.dwWin32ExitCode = ExitCode
ELSE
udtSS.dwWin32ExitCode = %ERROR_SERVICE_SPECIFIC_ERROR
END IF

' Specific Exit Code
udtSS.dwServiceSpecificExitCode = ServiceSpecificExitCode

udtSS.dwCheckPoint = Checkpoint
udtSS.dwWaitHint = WaitHint

IF SetServiceStatus(gdwdHStatus, udtSS) = 0 THEN
' Something went wrong so stop the service
StopService
FUNCTION = %FALSE
ELSE
FUNCTION = %TRUE
END IF

END FUNCTION

SUB ServiceMain(BYVAL dwArgs AS DWORD, BYVAL lpszArgv AS DWORD)
LOCAL Result AS LONG
LOCAL lpEventAttributes AS SECURITY_ATTRIBUTES

' Register with the SCM
gdwdHStatus = RegisterServiceCtrlHandler(gascServiceName, CODEPTR(Handler))
' Did it work
IF gdwdHStatus = 0 THEN
' No, so terminate
Terminate GetLastError()
EXIT SUB
END IF

' Service has been registered and startup is pending
IF ISFALSE SendStatus(%SERVICE_START_PENDING, %NO_ERROR, 0, 1, 5000) THEN
Terminate GetLastError()
EXIT SUB
END IF

' Create the termination event
glnghTerminateEvent = CreateEvent(lpEventAttributes, %TRUE, %FALSE, "")
IF glnghTerminateEvent = 0 THEN
Terminate GetLastError()
EXIT SUB
END IF

' Service startup is still pending
IF ISFALSE SendStatus(%SERVICE_START_PENDING, %NO_ERROR, 0, 2, 1000) THEN
Terminate GetLastError()
EXIT SUB
END IF

' Start the service
Result = InitService()
IF ISFALSE Result THEN
' Oops
Terminate GetLastError()
EXIT SUB
END IF

' Service is now running
IF ISFALSE SendStatus(%SERVICE_RUNNING, %NO_ERROR, 0, 0, 0) THEN
Terminate GetLastError()
EXIT SUB
END IF

' Wait for the signal to end
WaitForSingleObject glnghTerminateEvent, %INFINITE

Terminate 0

EXIT SUB

END SUB

SUB Terminate(ErrCode AS DWORD)

' If the Terminate Event has already been created then destroy it
IF glnghTerminateEvent <> 0 THEN
CloseHandle glnghTerminateEvent
END IF

IF gdwdHStatus <> 0 THEN
' Send a message to the SCM and tell them that we are stopping
SendStatus %SERVICE_STOPPED, ErrCode, 0&, 0&, 0&
END IF

' If the thread has started, then kill it
IF glnghServiceThread <> 0 THEN
' Not normally here in a service
' However, this program was written as an executable first and converted into a service
' There is a global hWindow that is set in the WINMAINX when we start
' We need to destroy the window so the WINMAINX will come back to us
' Is it a valid window
IF IsWindow(hWindow) THEN
' Yes so destroy it
DestroyWindow hWindow
' This will cause the Message Loop in your WINMAINX to exit and return
END IF

' Close the thread
CloseHandle glnghServiceThread
END IF

END SUB

SUB Handler(BYVAL ControlValue AS DWORD)
' This procedure (by its' name) handles all service requests.
LOCAL Result AS LONG

ON ERROR RESUME NEXT

' There is no Start option because the ServiceMain takes care of starting the service
SELECT CASE ControlValue
CASE %SERVICE_CONTROL_STOP
' Set the global Status
gdwdServiceState = %SERVICE_STOP_PENDING

' Tell the SCM that we are stopping
SendStatus %SERVICE_STOP_PENDING, %NO_ERROR, 0&, 1, 5000

' Stop the service
StopService
CASE %SERVICE_CONTROL_PAUSE
' Are we running and not paused
IF (ISTRUE glngRunningService) AND (ISFALSE glngPauseService) THEN
' Tell the SCM that we are pausing
SendStatus %SERVICE_PAUSE_PENDING, %NO_ERROR, 0, 1, 1000

' Pause it
PauseService

' Set the current state
gdwdServiceState = %SERVICE_PAUSED
END IF
CASE %SERVICE_CONTROL_CONTINUE
' Are we running and paused
IF (ISTRUE glngRunningService) AND (ISTRUE glngPauseService) THEN
' Tell the SCM that we are un pausing
SendStatus %SERVICE_CONTINUE_PENDING, %NO_ERROR, 0, 1, 1000

' Resume the service
ResumeService

' Set the current state
gdwdServiceState = %SERVICE_RUNNING
END IF
CASE %SERVICE_CONTROL_INTERROGATE
' Don't need to do anything
' We will send the current status below
CASE %SERVICE_CONTROL_SHUTDOWN
' We don't do anything with a shutdown
EXIT SUB
END SELECT

' Tell the SCM the new status
SendStatus gdwdServiceState, %NO_ERROR, 0, 0, 0

END SUB

FUNCTION ServiceThread(ID AS LONG) EXPORT AS LONG
LOCAL Result AS LONG
LOCAL Msg AS tagMsg

' Run until we are killed
Result = WINMAINX()
' I had written a program and compiled it as an exe
' To make it a service, I just renamed the WINMAIN to WINMAINX and then
' call it like you see above

END FUNCTION