Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

service-log boot times & time before reboot/lockup along with a reboot on date change

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • service-log boot times & time before reboot/lockup along with a reboot on date change

    same service that was listed previously to reboot a computer if the date changes,
    but, with additional code that logs restarts/shutdown/last time computer was working(running) prior to boot times within up to a minute.

    code can be easily removed that reboots the os on a date change.

    i needed a program like this a long time ago to keep up with the dates and times when a computer was last running and rebooted. naturally it would be wise to have a program that has user logged in times and logout times as well.

    i know most people do not need the reboot part of the program but i left it in because some might and that part can be easily remarked out.

    the program creates two files for logging and also keeps ten backup files of the logs when things start really looking bad.
    both main files can be easily viewed while the program is running, just use type and the files names. TXT for logging the most current time the os is running and DAT for history up to the last startup.
    files BK0 thru BK9 for incremental backups of the DAT file upon bootup.

    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
    http://powerbasic.com/support/pbforu...ad.php?t=36859

    it would be nice to know if this program is VISTA A-OK without the reboot code in it? i am probably going to post the code without the reboot code here also.


    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.
    #INCLUDE "pb_file.bas"           'various file and directory routines
    #INCLUDE "pb_ini.bas"            '.ini file handling
    
    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 I AS LONG
    LOCAL lRESULT, hthread1 AS LONG
    LOCAL whereprogramstarted AS STRING
    LOCAL logrunningfile,loghistoryfile AS STRING
    LOCAL dateoflastrunning AS STRING
    glastdaterebooted=DATE$
    
      whereprogramstarted = TRIM$(ExtractPath(GetExeName()))
       IF RIGHT$(whereprogramstarted, 1) <> "\" THEN
          whereprogramstarted = whereprogramstarted + "\"
       END IF
       logrunningfile = whereprogramstarted + "rbtmidnt.txt"
       loghistoryfile = whereprogramstarted + "rbtmidnt.dat"
       'make incremental back up copies incase of big failure of dat file and many reboots occur
       FILECOPY whereprogramstarted+"rbtmidnt.bk8",whereprogramstarted+"rbtmidnt.bk9"
       FILECOPY whereprogramstarted+"rbtmidnt.bk7",whereprogramstarted+"rbtmidnt.bk8"
       FILECOPY whereprogramstarted+"rbtmidnt.bk6",whereprogramstarted+"rbtmidnt.bk7"
       FILECOPY whereprogramstarted+"rbtmidnt.bk5",whereprogramstarted+"rbtmidnt.bk6"
       FILECOPY whereprogramstarted+"rbtmidnt.bk4",whereprogramstarted+"rbtmidnt.bk5"
       FILECOPY whereprogramstarted+"rbtmidnt.bk3",whereprogramstarted+"rbtmidnt.bk4"
       FILECOPY whereprogramstarted+"rbtmidnt.bk2",whereprogramstarted+"rbtmidnt.bk3"
       FILECOPY whereprogramstarted+"rbtmidnt.bk1",whereprogramstarted+"rbtmidnt.bk2"
       FILECOPY whereprogramstarted+"rbtmidnt.bk0",whereprogramstarted+"rbtmidnt.bk1"
       FILECOPY whereprogramstarted+"rbtmidnt.dat",whereprogramstarted+"rbtmidnt.bk0"
    
    ERRCLEAR
    TRY
    OPEN logrunningfile FOR INPUT AS #1
    LINE INPUT #1,DATEOFLASTRUNNING
    CLOSE 1
    CATCH
    CLOSE
    END TRY
    
    OPEN logrunningfile FOR OUTPUT AS #1
    PRINT #1,USING$("&","running "+DATE$+" "+TIME$)
    CLOSE 1
    OPEN loghistoryfile FOR APPEND AS #1
    PRINT #1,USING$("&",DATEOFLASTRUNNING)
    PRINT #1,USING$("&","started "+DATE$+" "+TIME$)
    CLOSE 1
    
    
    SLEEP 60000 'give the operation system time to become stable
    
    OPEN logrunningfile FOR OUTPUT AS #1
    PRINT #1,USING$("&","running "+DATE$+" "+TIME$)
    CLOSE 1
    
    CHECKTHEDATE:
    FOR I=1& TO 12
      IF glastdaterebooted<>DATE$ THEN
         GOTO reboottheos
         ELSE
         SLEEP 5000
         END IF
    NEXT I
    OPEN logrunningfile FOR OUTPUT AS #1
    PRINT #1,USING$("&","running "+DATE$+" "+TIME$)
    CLOSE 1
    GOTO checkthedate
    
    reboottheos:
    THREAD CREATE rebootmessage(1&) TO hthread1
    SLEEP 300
    THREAD CLOSE hthread1 TO lresult
    SLEEP 31000
    OPEN logrunningfile FOR OUTPUT AS #1
    PRINT #1,USING$("&","running "+DATE$+" "+TIME$)
    CLOSE 1
    SLEEP 30
    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
    Last edited by Paul Purvis; 25 Mar 2008, 07:58 PM.
    p purvis

  • #2
    in w2k, i am finding out the logoff code does not work as is in the function that contains the rebooting/shutdown/logoff.

    it might work on xp, but not tested yet
    p purvis

    Comment


    • #3
      a service to log the os boot times and last time the os was running
      all rebooting code is removed from this code as was listed included in the above program



      Code:
      'pbwin 8.04
      'logwostm.bas
      'PROGRAM TO RUN AS A SERVICE AND LOG THE BOOT TIMES OF THE OS AND LAST TIME OS WAS RUNNING
      '
      '------------------------------------------------------------------------------
      '
      
      #COMPILE EXE "logwostm.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.
      #INCLUDE "pb_file.bas"           'various file and directory routines
      #INCLUDE "pb_ini.bas"            '.ini file handling
      
      GLOBAL hWindow AS LONG ' You should set this in your WINMAINX to the handle
      ' of your main window.
      
      
      FUNCTION winmainx() AS LONG
      LOCAL whereprogramstarted AS STRING
      LOCAL logrunningfile,loghistoryfile AS STRING
      LOCAL dateoflastrunning AS STRING
      
        whereprogramstarted = TRIM$(ExtractPath(GetExeName()))
         IF RIGHT$(whereprogramstarted, 1) <> "\" THEN
            whereprogramstarted = whereprogramstarted + "\"
         END IF
         logrunningfile = whereprogramstarted + "logwostm.txt"
         loghistoryfile = whereprogramstarted + "logwostm.dat"
         'make incremental back up copies incase of big failure of dat file and many reboots occur
         FILECOPY whereprogramstarted+"logwostm.bk8",whereprogramstarted+"logwostm.bk9"
         FILECOPY whereprogramstarted+"logwostm.bk7",whereprogramstarted+"logwostm.bk8"
         FILECOPY whereprogramstarted+"logwostm.bk6",whereprogramstarted+"logwostm.bk7"
         FILECOPY whereprogramstarted+"logwostm.bk5",whereprogramstarted+"logwostm.bk6"
         FILECOPY whereprogramstarted+"logwostm.bk4",whereprogramstarted+"logwostm.bk5"
         FILECOPY whereprogramstarted+"logwostm.bk3",whereprogramstarted+"logwostm.bk4"
         FILECOPY whereprogramstarted+"logwostm.bk2",whereprogramstarted+"logwostm.bk3"
         FILECOPY whereprogramstarted+"logwostm.bk1",whereprogramstarted+"logwostm.bk2"
         FILECOPY whereprogramstarted+"logwostm.bk0",whereprogramstarted+"logwostm.bk1"
         FILECOPY whereprogramstarted+"logwostm.dat",whereprogramstarted+"logwostm.bk0"
      
      ERRCLEAR
      TRY
      OPEN logrunningfile FOR INPUT AS #1
      LINE INPUT #1,DATEOFLASTRUNNING
      CLOSE 1
      CATCH
      CLOSE
      END TRY
      
      OPEN logrunningfile FOR OUTPUT AS #1
      PRINT #1,USING$("&","running "+DATE$+" "+TIME$)
      CLOSE 1
      OPEN loghistoryfile FOR APPEND AS #1
      PRINT #1,USING$("&",DATEOFLASTRUNNING)
      PRINT #1,USING$("&","started "+DATE$+" "+TIME$)
      CLOSE 1
      ' a endless loop logging the time every 30 seconds the os is running
      LOGTHETIME:
      SLEEP 30000
      OPEN logrunningfile FOR OUTPUT AS #1
      PRINT #1,USING$("&","running "+DATE$+" "+TIME$)
      CLOSE 1
      GOTO LOGTHETIME
      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 = "Logwostm Service"
      gascServiceDisplayName = "Log Time Running"
      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
      Last edited by Paul Purvis; 26 Mar 2008, 02:36 PM.
      p purvis

      Comment


      • #4
        the program to log start and stopping of computers
        LOGWOSTM.BAS
        LOGWOSTM.EXE
        Attached Files
        p purvis

        Comment

        Working...
        X