Get Key

[gunsmokingman]

Thanks Yzöwl

Here is the line that is causing problems

      It = " Sys Install Time   " & Vt & T1(1) & " " & T1(2)

Which means that it might fail on this line also

      Lt = " Sys LastBoot Time  " & Vt & T1(1) & " " & T1(2)

Could you run this script and post it results and also change this to test both

Test One

     
     Tme.Value = Obj.InstallDate
     For Each Col In Split(Tme.GetVarDate, " ")

Test Two

     Tme.Value = Obj.LastBootUpTime
     For Each Col In Split(Tme.GetVarDate, " ")

 Dim Act :Set Act = CreateObject("WScript.Shell")
 Dim Fso :Set Fso = CreateObject("Scripting.FileSystemObject")
 Dim Tme :Set Tme = CreateObject("WbemScripting.SWbemDateTime")
 Dim Wmi :Set Wmi = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\CIMV2")
 Dim C1, Col, Obj, Var, Ts, Tx
 C1 = 0
    For Each Obj In Wmi.ExecQuery("SELECT * FROM Win32_OperatingSystem") 
     Tme.Value = Obj.InstallDate
     For Each Col In Split(Tme.GetVarDate, " ")
      Var = Var & vbCrLf & C1 & " : " & Col
      C1 = C1 + 1
     Next 
    Next 
  Tx = Act.SpecialFolders("Desktop") & "\TestOutput.txt" 
  Set Ts = Fso.CreateTextFile(Tx)
   Ts.WriteLine Var
   Ts.Close
   Act.Run(Chr(34) & Tx & Chr(34)),1,True
  Fso.DeleteFile(Tx),True

[spriditis]

It fails because not everyone uses US regional settings:

For me GetVarDate returns data in format "yyyy.MM.dd. HH:mm:ss"

Therefore there is no T1(2) - either way you should build you date string from seperate parts, not split unknown format. Like:

GetVarDate is ok for output, but to compare values, build it from parts.

Anyhow this will return value as "yyyy.MM.dd. HH:mm:ss" no matter what settings are configured.

dt.Year & "." & Right("00" & dt.Month, 2) & "." & Right("00" & dt.Day, 2) & ". " & _
       Right("00" & dt.Hours, 2) & ":" & Right("00" & dt.Minutes, 2) & _
       ":" & Right("00" & dt.Seconds, 2)

Uptime function - minor modification by me, not sure what was original:

Function TimeSpan(dt1, dt2)
Dim seconds, minutes, hours, days
    If (isDate(dt1) And IsDate(dt2)) = False Then
        TimeSpan = ""
        Exit Function
    End If 

    seconds = Abs(DateDiff("S", dt1, dt2))
    minutes = seconds \ 60
    hours = minutes \ 60
    days = hours \ 24
    hours = hours mod 24
    minutes = minutes mod 60
    seconds = seconds mod 60

    TimeSpan = days & " days " & _
      Right("00" & hours, 2) & "h " & _
      Right("00" & minutes, 2) & "m " & _
      Right("00" & seconds, 2) & "s"
End Function

Edited March 22, 2010 by spriditis

[florydude]

I ported the GetKey() function to a simple VBS script:

' 
'  GetKey.vbs v1.0 by flory
' 
'
'***************************************************************************
'
'
Option Explicit
'Use VbCrLf 
ON ERROR RESUME NEXT

Dim WSHShell, KEY, ID
Set WSHShell = WScript.CreateObject("WScript.Shell")
Dim strResultKey, strResultId

Dim Tme
Set Tme = WScript.CreateObject("WbemScripting.SWbemDateTime")

Dim objWMIService
Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")

'-> Text Output Objects
Dim ARW 
ARW = Chr(160) & Chr(187) & Chr(160)

Dim RegKey
RegKey = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\"

Dim strProductKey, strProductID, strProductOS
strProductKey = RegKey & "Windows NT\CurrentVersion\DigitalProductId"
strProductID = RegKey & "Windows NT\CurrentVersion\ProductId"

Dim strDefault
strDefault = "ProductId"	

    '-> Get The TimeDate Server Key	
    Function GetKey(ByVal rpk)
        Dim i, j
        Dim dwAccumulator, KeyProductID
        dwAccumulator = ""
		KeyProductID = ""
        Const rpkOffset = 52 : i = 28
        Dim szPossibleChars
        szPossibleChars = "BCDFGHJKMPQRTVWXY2346789"		
        Do
            dwAccumulator = 0 : j = 14
            Do
                dwAccumulator = dwAccumulator * 256
                dwAccumulator = rpk(j + rpkOffset) + dwAccumulator
                rpk(j + rpkOffset) = (dwAccumulator \ 24) And 255
                dwAccumulator = dwAccumulator Mod 24
                j = j - 1
            Loop While j >= 0
            i = i - 1 : KeyProductID = Mid(szPossibleChars, dwAccumulator + 1, 1) & KeyProductID
            If (((29 - i) Mod 6) = 0) And (i <> -1) Then
                i = i - 1 : KeyProductID = "-" & KeyProductID
            End If
        Loop While i >= 0
        GetKey = KeyProductID
        KEY = "      " & ARW & KeyProductID
    End Function

if WScript.arguments.count<1 then
    strResultKey = GetKey(WSHShell.RegRead(strProductKey)) 
	strResultId = Left(Replace(WSHShell.RegRead(strProductID),"-",""),8)

	MsgBox "ProductKey: " & strResultKey & VbCrLf & "Product PID: " & strResultId, vbinformation, "Windows Install Check"	
else 
    WScript.echo "Correct usage: Cscript GetKey.vbs"
	WScript.quit
end if

I'm wondering how can such function list all key / values from a simple registry key as for example:

strTimeServersKey = RegKey & "Windows\CurrentVersion\DateTime\Servers"

for let's say an array of 6 values

:

[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\DateTime\Servers]
@="2"
"1"="time.windows.com"
"2"="time.nist.gov"
"3"="timekeeper.isi.edu"
"4"="usno.pa-x.dec.com"
"5"="tock.usno.navy.mil"
"6"="tick.usno.navy.mil"

GetKey_vbs.zip

Edited June 12, 2011 by florydude

[Sp0iLedBrAt]

I ported the GetKey() function to a simple VBS script

Works here. You could also attach it as a .vbs file (like other members in this sub-forum do) to avoid possible problems with undesired empty spaces or transfer of lines.

Cheers

[florydude]

Done with the attach. Also worked on how the get the servers list for syncronising the time-date:

' 
' TimeDate Server List Script - ServersList.vbs
' 
'
'***************************************************************************
Option Explicit

Dim WSHShell
Set WSHShell = WScript.CreateObject("WScript.Shell")

Dim Tme
Set Tme = WScript.CreateObject("WbemScripting.SWbemDateTime")

Dim objWMIService
Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")

'-> Text Output Objects
Dim ARW 
ARW = Chr(160) & Chr(187) & Chr(160)

Dim RegKey, strDefault, strList
RegKey = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\"

Dim strTimeServersKey
strTimeServersKey = RegKey & "Windows\CurrentVersion\DateTime\Servers"

'-> Read RegistryKey/DefaultValue
Function GetList (strTimeServersKey, strDefault)
	On Error Resume Next
	Dim i,j,k
	Dim Servers
	Servers = " "		
	k = 0
    Do 	
	    k = k + 1	
        WSHShell.RegRead(strTimeServersKey & "\" & k)	
    Loop While err.number = 0
    Err.Clear	
	j = k - 1
	Dim ServersDigit()
    For i = strDefault to j
    Do 
	    i = i + 1	 
        ReDim Preserve ServersDigit(i) 
        ServersDigit(i) = WSHShell.RegRead(strTimeServersKey & "\" & i)		
		Servers = Servers & VbCrLf & i & ARW & ServersDigit(i)

	Loop While err.number = 0
	Next	
        GetList = Servers 
        strList  = " DateTime Servers List " & ARW & ServersDigit	
End Function  

if WScript.arguments.count<1 then
    strList = GetList(strTimeServersKey, 0)	
	MsgBox "Date-Time Servers: " & strList, vbinformation, "DateTime Servers" 
else
	MsgBox "Usage: CScript ServersList.vbs", vbinformation, "DateTime Servers"
	WScript.quit
end if

Can be fixed a little more on how the array is builded etc.

ServersList.zip