Functions
VBScript functions are used to return a value after some process, usually involving input parameters.
CreateTimeStamp
This function returns a current timestamp in a format suitable for log files.
Function CreateTimeStamp ()
'*********************************************************************************************
'* Function CreateTimeStamp ()
'* Purpose: return current timestamp in a format suitable for log files
'*********************************************************************************************
'* create timestamp
CreateTimeStamp = Year(Now) & "-" & Right("0" & Month(Now),2) & "-" & Right("0" & Day(Now),2) & " " & Right("0" & Hour(Now),2) & ":" & Right("0" & Minute(Now),2) & ":" & Right("0" & Second(Now),2)
End Function
GetGuid
This function returns a Microsoft GUID with internal dashes and without the outer braces.
Function CreateGuid ()
'*********************************************************************************************
'* Function CreateGuid ()
'* Purpose: returns a Microsoft GUID with internal dashes and without the outer braces
'*********************************************************************************************
'* Initialize constants, variables and objects
Dim TypeLib
'* Create the GUID
Set TypeLib = CreateObject("Scriptlet.TypeLib")
GetGuid = Mid(CStr(TypeLib.Guid), 2, 36)
'* Set objects to Nothing
Set TypeLib = Nothing
End Function
GetUtc
This function returns the current UTC time in ISO 8601 format.
Function GetUtc ()
'*********************************************************************************************
'* Function GetUtc ()
'* Purpose: returns the current UTC time in ISO 8601 format
'*********************************************************************************************
'* Initialize constants, variables and objects
Dim dteNow, strActiveTimeBias, dteUtc, strOffsetMinutes, strErrorMessage
dteNow = now()
'* write log data
WriteOutput "Start GetUtc", 0, "INFO"
WriteOutput "Now(): " & dteNow, 1, "DEBUG"
strActiveTimeBias = "HKEY_LOCAL_MACHINE\System\CurrentControlSet\Control\TimeZoneInformation\ActiveTimeBias"
'* attempt to get the active time bias
On Error Resume Next
strOffsetMinutes = objWshShell.RegRead(strActiveTimeBias)
'* if error, report and exit
if Err.Number <> 0 Then
strErrorMessage = Replace(Err.Description, vbCrLf, " ")
strErrorMessage = "GetUtc failed: Error " & Err.Number & ": " & strErrorMessage
'* write log data
WriteOutput strErrorMessage, 1, "ERROR"
'* exit
Call ExitMe (-3)
end If
On Error Goto 0
dteUtc = dateadd("n", strOffsetMinutes, dteNow)
'* format to ISO 8601
GetUtc = Cstr(Year(dteUtc)) & "-" & Right("00" & Cstr(Month(dteUtc)),2) & "-" & Right("00" & Cstr(Day(dteUtc)),2) & "T" & Right("00" & Cstr(Hour(dteUtc)),2) & ":" & Right("00" & Cstr(Minute(dteUtc)),2) & ":" & Right("00" & Cstr(Second(dteUtc)),2) & "Z"
'* write log data and end sub
WriteOutput "UTC: " & GetUtc, 1, "DEBUG"
WriteOutput "End GetUtc", 0, "INFO"
End Function
ReadIni
This function a value read from an INI file. Use with its partner WriteIni.
Function ReadIni (ByVal myFilePath, ByVal mySection, ByVal myKey, ByVal booMandatory, ByVal intIndent)
'*********************************************************************************************
'* Function ReadIni (ByVal myFilePath, ByVal mySection, ByVal myKey, ByVal booMandatory, ByVal intIndent)
'* Purpose: This function returns a value read from an INI file
'* myFilePath: the (path and) file name of the INI file
'* mySection: the section in the INI file to be searched
'* myKey: the key whose value is to be returned
'* booMandatory: If TRUE will throw error if key can't be found or is empty
'* intIndent: number of indents to use (for recursion logging)
'* Returns: the [string] value for the specified key in the specified section
'* CAVEAT: Will return a space if key exists but value is blank
'* Written by Keith Lacelle
'* Modified by Denis St-Pierre and Rob van der Woude
'* Modified by Michael D. Shook
'*********************************************************************************************
'* Initialize constants, variables and objects
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
Dim intEqualPos
Dim objIniFile
Dim strFilePath, strKey, strLeftString, strLine, strSection, strErrorMessage
'* write log data
WriteOutput "Start ReadIni ('" & myFilePath & "', " & mySection & ", " & myKey & ", " & booMandatory & ", " & intIndent & ")", intIndent, "INFO"
'* set base variables
ReadIni = ""
strFilePath = Trim( myFilePath )
strSection = Trim( mySection )
strKey = Trim( myKey )
'* look for section and key
If objFSO.FileExists( strFilePath ) Then
'* attempt to open ini file
On Error Resume Next
Set objIniFile = objFSO.OpenTextFile( strFilePath, ForReading, False )
'* if error, report and exit
If Err.Number <> 0 Then
strErrorMessage = Replace(Err.Description, vbCrLf, " ")
strErrorMessage = "Error " & Err.Number & ": " & strErrorMessage
'* write log data
WriteOutput "ReadIni failed: " & strErrorMessage, 1, "ERROR"
'* close XMLSpy and exit
Call objSpy.Quit
Call ExitMe (-23)
End If
On Error Goto 0
Do While objIniFile.AtEndOfStream = False
strLine = Trim( objIniFile.ReadLine )
'* Check if section is found in the current line
If LCase( strLine ) = "[" & LCase( strSection ) & "]" Then
strLine = Trim( objIniFile.ReadLine )
'* Parse lines until the next section is reached
Do While Left( strLine, 1 ) <> "["
'* Find position of equal sign in the line
intEqualPos = InStr( 1, strLine, "=", 1 )
If intEqualPos > 0 Then
strLeftString = Trim( Left( strLine, intEqualPos - 1 ) )
'* Check if item is found in the current line
If LCase( strLeftString ) = LCase( strKey ) Then
ReadIni = Trim( Mid( strLine, intEqualPos + 1 ) )
' In case the item exists but value is blank
If ReadIni = "" Then
ReadIni = " "
End If
'* Abort loop when item is found
Exit Do
End If
End If
'* Abort if the end of the INI file is reached
If objIniFile.AtEndOfStream Then Exit Do
'* Continue with next line
strLine = Trim( objIniFile.ReadLine )
Loop
Exit Do
End If
Loop
objIniFile.Close
'* if ini file can't be found, report error and exit
Else
strErrorMessage = "ReadIni failed: Can't find ini file: " & myFilePath
'* write log data
WriteOutput strErrorMessage, intIndent + 1, "ERROR"
'* cleanup and exit
objFSO = Nothing
Call ExitMe (-16)
End If
'* In case the item is blank and mandatory, report error and exit
If Trim(ReadIni) = "" And booMandatory = True Then
strErrorMessage = "ReadIni failed: Can't find mandatory key value pair: [" & strSection & "] "
'* write log data
WriteOutput strErrorMessage & myKey, intIndent + 1, "ERROR"
'* exit
Call ExitMe (-17)
End If
'* write log data and end sub
WriteOutput "Value Read: " & ReadIni, intIndent + 1, "DEBUG"
WriteOutput "End ReadIni", intIndent, "INFO"
End Function
StringToANSI
This function attempts to clean a string of any extended UTF-8, replacing them with lower ANSI characters
Function StringToANSI (ByVal strToClean, ByVal intIndent)
'*********************************************************************************************
'* Function StringToANSI (ByVal strToClean, ByVal intIndent)
'* Purpose: attempts to clean a string of any extended UTF-8, replacing them with lower ANSI characters
'* strToClean: string to be cleaned
'* intIndent: number of indents to use (for recursion logging)
'*********************************************************************************************
'* Initialize constants, variables and objects
Dim inStringArray(), strOutput, iterator, currentChar, currentCharANSI
ReDim inStringArray(len(strToClean) - 1)
'* write log data
WriteOutput "Start StringToANSI ('" & strToClean & "', " & intIndent & ")", intIndent, "INFO"
For iterator = 1 to Len(strToClean)
currentChar = Mid(strToClean, iterator, 1)
On Error Resume Next
currentCharANSI = Asc(currentChar)
'* if error, set character to asterisk
if Err.Number <> 0 Then
currentCharANSI = 42
currentChar = "*"
end If
On Error Goto 0
' normal ASCII based characters
if currentCharANSI <= 127 then
strOutput = strOutput + currentChar
' upper case
ElseIf currentCharANSI => 192 And currentCharANSI <= 198 Then
strOutput = strOutput + "A"
ElseIf currentCharANSI = 199 Then
strOutput = strOutput + "C"
ElseIf currentCharANSI => 200 And currentCharANSI <= 203 Then
strOutput = strOutput + "E"
ElseIf currentCharANSI => 204 And currentCharANSI <= 207 Then
strOutput = strOutput + "I"
ElseIf currentCharANSI = 208 Then
strOutput = strOutput + "D"
ElseIf currentCharANSI = 209 Then
strOutput = strOutput + "N"
ElseIf currentCharANSI => 210 And currentCharANSI <= 214 Then
strOutput = strOutput + "O"
ElseIf currentCharANSI = 215 Then
strOutput = strOutput + "x"
ElseIf currentCharANSI = 216 Then
strOutput = strOutput + "O"
ElseIf currentCharANSI => 217 And currentCharANSI <= 220 Then
strOutput = strOutput + "U"
ElseIf currentCharANSI = 221 Then
strOutput = strOutput + "Y"
ElseIf currentCharANSI = 222 Then
strOutput = strOutput + "P"
ElseIf currentCharANSI = 223 Then
strOutput = strOutput + "B"
' lower case
ElseIf currentCharANSI => 224 And currentCharANSI <= 230 Then
strOutput = strOutput + "a"
ElseIf currentCharANSI = 231 Then
strOutput = strOutput + "c"
ElseIf currentCharANSI => 232 And currentCharANSI <= 235 Then
strOutput = strOutput + "e"
ElseIf currentCharANSI => 236 And currentCharANSI <= 239 Then
strOutput = strOutput + "i"
ElseIf currentCharANSI = 240 Then
strOutput = strOutput + "o"
ElseIf currentCharANSI = 241 Then
strOutput = strOutput + "n"
ElseIf currentCharANSI => 242 And currentCharANSI <= 246 Then
strOutput = strOutput + "o"
ElseIf currentCharANSI = 247 Then
strOutput = strOutput + "/"
ElseIf currentCharANSI = 248 Then
strOutput = strOutput + "o"
ElseIf currentCharANSI => 249 And currentCharANSI <= 252 Then
strOutput = strOutput + "u"
ElseIf currentCharANSI = 253 Then
strOutput = strOutput + "y"
ElseIf currentCharANSI = 254 Then
strOutput = strOutput + "p"
ElseIf currentCharANSI = 255 Then
strOutput = strOutput + "y"
' any other character or control character
Else
strOutput = strOutput + "*"
End If
Next
'* write log data
WriteOutput "Finish StringToANSI", intIndent, "INFO"
StringToANSI = strOutput
End Function