Jump to content
Strawberry Orange Banana Lime Leaf Slate Sky Blueberry Grape Watermelon Chocolate Marble
Strawberry Orange Banana Lime Leaf Slate Sky Blueberry Grape Watermelon Chocolate Marble

MSFN is made available via donations, subscriptions and advertising revenue. The use of ad-blocking software hurts the site. Please disable ad-blocking software or set an exception for MSFN. Alternatively, register and become a site sponsor/subscriber and ads will be disabled automatically. 


Recommended Posts

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

Share this post


Link to post
Share on other sites

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 by spriditis

Share this post


Link to post
Share on other sites

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"

:rolleyes:

GetKey_vbs.zip

Edited by florydude

Share this post


Link to post
Share on other sites
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

Share this post


Link to post
Share on other sites

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

Share this post


Link to post
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now

  • Recently Browsing   0 members

    No registered users viewing this page.

×