Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
' applications, but you may not reproduce
' or publish this code on any web site,
' online service, or distribute as source
' on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Const MAX_COMPUTERNAME As Long = 16
Private Const REG_BINARY As Long = &H3
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const ERROR_SUCCESS As Long = 0
Private Const STANDARD_RIGHTS_READ As Long = &H20000
Private Const KEY_QUERY_VALUE As Long = &H1
Private Const KEY_ENUMERATE_SUB_KEYS As Long = &H8
Private Const KEY_NOTIFY As Long = &H10
Private Const SYNCHRONIZE As Long = &H100000
Private Const KEY_READ As Long = ((STANDARD_RIGHTS_READ Or _
KEY_QUERY_VALUE Or _
KEY_ENUMERATE_SUB_KEYS Or _
KEY_NOTIFY) And _
(Not SYNCHRONIZE))
Private Type SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Type TIME_ZONE_INFORMATION
Bias As Long
StandardName(0 To 63) As Byte
StandardDate As SYSTEMTIME
StandardBias As Long
DaylightName(0 To 63) As Byte
DaylightDate As SYSTEMTIME
DaylightBias As Long
End Type
Private Declare Function GetTimeZoneInformation Lib "kernel32" _
(lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long
Private Declare Function SystemTimeToTzSpecificLocalTime Lib "kernel32" _
(lpTimeZone As TIME_ZONE_INFORMATION, _
lpUniversalTime As SYSTEMTIME, _
lpLocalTime As SYSTEMTIME) As Long
Private Declare Function FileTimeToSystemTime Lib "kernel32" _
(lpFileTime As FILETIME, _
lpSystemTime As SYSTEMTIME) As Long
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" _
Alias "RegOpenKeyExA" _
(ByVal hKey As Long, _
ByVal lpSubKey As String, _
ByVal ulOptions As Long, _
ByVal samDesired As Long, _
phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" _
Alias "RegQueryValueExA" _
(ByVal hKey As Long, _
ByVal lpValueName As String, _
ByVal lpReserved As Long, _
lpType As Long, _
lpData As Any, _
lpcbData As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" _
(ByVal hKey As Long) As Long
Private Declare Function GetComputerName Lib "kernel32" _
Alias "GetComputerNameA" _
(ByVal lpBuffer As String, _
nSize As Long) As Long
Private Declare Function lstrlenW Lib "kernel32" _
(ByVal lpString As Long) As Long
Private Sub Form_Load()
Command1.Caption = "Last Shutdown Date"
Check1.Caption = "Include time"
Label1.Caption = "Last shutdown of " & GetLocalComputerName() & "occured on:"
Text1.Text = ""
End Sub
Private Sub Command1_Click()
Dim buff As String
Dim bIncludeTime As Boolean
bIncludeTime = Check1.Value = vbChecked
buff = GetLastSystemShutdown(bIncludeTime)
Text1.Text = buff
End Sub
Private Function GetLastSystemShutdown(bIncludeTime As Boolean) As String
Dim hKey As Long
Dim sKey As String
Dim sValueName As String
Dim ft As FILETIME 'value to retrieve
Dim cbData As Long 'size of data
sKey = "System\CurrentControlSet\Control\Windows"
sValueName = "ShutdownTime"
If RegOpenKeyEx(HKEY_LOCAL_MACHINE, _
sKey, _
0&, _
KEY_READ, _
hKey) = ERROR_SUCCESS Then
If hKey <> 0 Then
'retrieve the passed value if present
cbData = Len(ft)
If RegQueryValueEx(hKey, _
sValueName, _
0&, _
REG_BINARY, _
ft, _
cbData) = ERROR_SUCCESS Then
GetLastSystemShutdown = GetFileToSystemDate(ft, bIncludeTime)
End If 'RegQueryValueEx
'clean-up
RegCloseKey hKey
End If 'hKey
End If 'RegOpenKeyEx
End Function
Private Function GetFileToSystemDate(ft As FILETIME, _
Optional bIncludeTime As Boolean = False) As String
Dim buff As String
Dim st As SYSTEMTIME 'system (UNC) time
Dim lt As SYSTEMTIME 'local time
Dim tz As TIME_ZONE_INFORMATION
If FileTimeToSystemTime(ft, st) Then
'retrieve the local time zone info
GetTimeZoneInformation tz
'convert the system time returned above
'to a local time taking the time zone
'info into account
SystemTimeToTzSpecificLocalTime tz, st, lt
'now just write it out
buff = Format$(DateSerial(lt.wYear, lt.wMonth, lt.wDay), "Long Date")
If bIncludeTime Then
buff = buff & " @ " & Format$(TimeSerial(lt.wHour, _
lt.wMinute, _
lt.wSecond), _
"Long Time")
End If
GetFileToSystemDate = buff
Else
GetFileToSystemDate = ""
End If
End Function
Private Function GetLocalComputerName() As String
Dim tmp As String
'return the name of the computer
tmp = Space$(MAX_COMPUTERNAME)
If GetComputerName(tmp, Len(tmp)) <> 0 Then
GetLocalComputerName = TrimNull(tmp)
End If
End Function
Private Function TrimNull(startstr As String) As String
TrimNull = Left$(startstr, lstrlenW(StrPtr(startstr)))
End Function |