' FlagCleanup.vbs
' VBScript program to clean up flag files in shared folder. These flag
' files are used to enforce one logon session per user.
'
' ----------------------------------------------------------------------
' Copyright (c) 2010 Richard L. Mueller
' Hilltop Lab web site - http://www.rlmueller.net
' Version 1.0 - June 3, 2010
'
' You have a royalty-free right to use, modify, reproduce, and
' distribute this script file in any way you find useful, provided that
' you agree that the copyright owner above has no warranty, obligations,
' or liability for such use.

Option Explicit

Dim objFSO
Dim strComputerEncoded, strShare, strComputer, strHexValue
Dim strFile, objStream, strLine, dtmReported
Dim strShare2, objErrorLog, strErrorLog, strUser
Dim blnFound, dtmModified, objFile, strPrefix

Const B64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
Const ForReading = 1

' Specify shared folder.
strShare = "\\MyServer\MyShare\Logs"

' Specify alternate folder if the first is unavailable.
strShare2 = "\\MyServer2\MyShare\Logs"

Set objFSO = CreateObject("Scripting.FileSystemObject")

' Open error log file.
strErrorLog = strShare2 & "\Error.log"
Set objErrorLog = objFSO.OpenTextFile(strErrorLog, ForReading)

' Read each line of the file.
blnFound = False
Do Until objErrorLog.AtEndOfStream
    strLine = objErrorLog.ReadLine
    ' Parse information recorded in logoff errors.
    If (blnFound = True) Then
        strPrefix = Left(strLine, InStr(strLine, ":") - 1)
        Select Case strPrefix
            Case "Time"
                dtmReported = CDate(Mid(strLine, InStr(strLine, ":") + 2))
            Case "User"
                strUser = Mid(strLine, InStr(strLine, ":") + 2)
            Case "Computer"
                strComputer = Mid(strLine, InStr(strLine, ":") + 2)
                ' Base64 encode the computer name.
                strHexValue = TextToHex(strComputer)
                strComputerEncoded = HexToBase64(strHexValue)
            Case "Flag file"
                blnFound = False
                strFile = Mid(strLine, InStr(strLine, ":") + 2)
                Set objFile = objFSO.GetFile(strFile)
                ' Check date of this flag file.
                dtmModified = CDate(objFile.DateLastModified)
                ' Only consider flag files saved before logoff error reported.
                If (dtmReported > dtmModified) Then
                    ' Check computer name in file.
                    Set objStream = objFSO.OpenTextFile(strFile, ForReading)
                    strLine = objStream.ReadLine
                    objStream.Close
                    ' Check that the encoded computer name matches.
                    If (strLine = strComputerEncoded) Then
                        ' Delete the file.
                        objFSO.DeleteFile strFile
                    End If
                End If
        End Select
    End If
    ' Only consider logoff errors.
    If (strLine = "## Logoff Error") Then
        blnFound = True
    End If
Loop
objErrorLog.Close

Function TextToHex(ByVal strText)
    ' Function to convert a text string into a string of hexadecimal bytes.
    Dim strChar, k

    TextToHex = ""
    For k = 1 To Len(strText)
        strChar = Mid(strText, k, 1)
        TextToHex = TextToHex & Hex(Asc(strChar))
    Next
End Function

Function HexToBase64(ByVal strHex)
    ' Function to convert a hex string into a base64 encoded string.
    ' Constant B64 has global scope.
    Dim lngValue, lngTemp, lngChar, intLen, k, j, strWord, str64, intTerm

    intLen = Len(strHex)

    ' Pad with zeros to multiple of 3 bytes.
    intTerm = intLen Mod 6
    If (intTerm = 4) Then
        strHex = strHex & "00"
        intLen = intLen + 2
    End If
    If (intTerm = 2) Then
        strHex = strHex & "0000"
        intLen = intLen + 4
    End If

    ' Parse into groups of 3 hex bytes.
    j = 0
    strWord = ""

    HexToBase64 = ""
    For k = 1 To intLen Step 2
        j = j + 1
        strWord = strWord & Mid(strHex, k, 2)
        If (j = 3) Then
            ' Convert 3 8-bit bytes into 4 6-bit characters.
            lngValue = CCur("&H" & strWord)

            lngTemp = Fix(lngValue / 64)
            lngChar = lngValue - (64 * lngTemp)
            str64 = Mid(B64, lngChar + 1, 1)
            lngValue = lngTemp

            lngTemp = Fix(lngValue / 64)
            lngChar = lngValue - (64 * lngTemp)
            str64 = Mid(B64, lngChar + 1, 1) & str64
            lngValue = lngTemp

            lngTemp = Fix(lngValue / 64)
            lngChar = lngValue - (64 * lngTemp)
            str64 = Mid(B64, lngChar + 1, 1) & str64

            str64 = Mid(B64, lngTemp + 1, 1) & str64

            HexToBase64 = HexToBase64 & str64
            j = 0
            strWord = ""
        End If
    Next
    ' Account for padding.
    If (intTerm = 4) Then
        HexToBase64 = Left(HexToBase64, Len(HexToBase64) - 1) & "="
    End If
    If (intTerm = 2) Then
        HexToBase64 = Left(HexToBase64, Len(HexToBase64) - 2) & "=="
    End If

End Function