Skip to content

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