Wednesday, November 23, 2016

Userfile Read & Write Script



Option Explicit
On Error Resume Next

' Variable Declarations
Dim sInFile, sOutFile
Dim oShell, fso
Dim InFile, OutFile
Dim WshNetwork
Dim sFolderLoc, sFile
Dim dictParams
Dim sCurrentLine
Dim sParam, sValue
Dim i, j, ParamCount
Dim bFound
Dim sProfilePath
Dim Linecount

Dim SHOWDEBUG
Dim MAXLINES

' Variable Definitions
Const ForReading = 1, ForWriting = 2, ForAppending = 8
SHOWDEBUG = False                                    ' Set this to True for various debug output

MAXLINES = 1000    ' This is the maximum number of lines the script will copy/create before quitting

' Setup Objects
Set oShell = CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
Set WshNetwork = WScript.CreateObject("WScript.Network")
Set dictParams = CreateObject("Scripting.Dictionary")

' This is the array of parameters we want to set
dictParams.Add "property", Array("deployment.expiration.check.enabled", "deployment.cache.enable" )    ' Add any additional parameters here
dictParams.Add "value",    Array("false"                              , "true"                    ) ' Add the value for each parameter here

ParamCount = UBound(dictParams("property"))                    ' How many parameters are we adding?
DebugText "Found " & ParamCount + 1 & " parameter(s)."

' Determine the path to the current deployment.properties file
' This has only been tested on Win 7 and Win 8.1
sProfilePath = oShell.ExpandEnvironmentStrings("%USERPROFILE%")
sFolderLoc = sProfilePath & "\AppData\LocalLow\Sun\Java\Deployment"
DebugText "Folder Loc: " & sFolderLoc

sInFile = sFolderLoc & "\deployment.properties"
sOutFile = sFolderLoc & "\deployment.newproperties"


' deployment.properties will obviously not be present if Java has not been installed,
' however it will also not be there until Java has run for the current user. The directory
' structure will not have been created either. By creating the properties file in advance
' however, we ensure that the settings will be there on our first-run, and they carry forward.
DebugText "Checking for existence of " & sInFile   

If NOT( FileExists ( sInFile ) ) Then                 ' If the file isn't there
    DebugText "Cannot find Java deployment.properties file. Java may nor be installed or has not been run yet."
    If NOT FolderExists ( sFolderLoc ) Then            ' Check if the folder is there (it shouldn't be)
        CreateDirs ( sFolderLoc )                    ' Create the folder, using a sub since we can't natively create nested folders
    End If
    Set Infile = fso.OpenTextFile(sInFile,ForWriting,True)    ' Create the properties file; this way we can just continue the rest of the
    InFile.Close                                            ' script as if the file had been there all along.
End If

Set InFile = fso.OpenTextFile(sInFile, ForReading)                ' This will be the original file we read in
Set OutFile = fso.OpenTextFile(sOutFile, ForWriting, True)        ' This is the revised file we create

' Basically we're going to:    Iterate through InFile file line by line
'                            Check each line to see if it matches one of the properties we want to change
'                            If it does, drop the line; we'll re-add at the end since there's no need to keep the file in order
'                            Otherwise just copy the line as it exists to the new file

LineCount = 0                                                ' Line counter

Do Until ( InFile.AtEndOfStream OR ( LineCount > MAXLINES ))
    sCurrentLine = InFile.ReadLine                            ' Read a line from InFile
    DebugText "Read line: " & sCurrentLine
    i = instr(sCurrentLine,"=")                                ' Find the split between the property and it's value
    If i > 0 Then                                            ' If we have an '=' then we have a property/value and not something else e.g. a comment (#)
        sParam = Left(sCurrentLine,(i-1))                    ' Split out the property
        sValue = Right(sCurrentLine, Len(sCurrentLine)-i)    ' Split out the value
        DebugText "Parameter: " & sParam & " | Value: " & sValue
        bFound = False                                       
        For j = 0 to ParamCount                                ' Loop through the list of parameters we want to set
            If sParam = dictParams("property")(j) Then        ' We've found a line matching the parameter we want to set so we are going to
                bFound = True                                ' skip copying it and instead replace it with our desired parameter/value
            End If
        Next
        If NOT bFound Then                                    ' If the line is NOT something we want to set/change, write it out, otherwise ignore it
            OutFile.WriteLine sParam & "=" & sValue            ' Technically we could just write out the entire line, but I split this up in case
        End If                                                ' I want to add some additional logic to the script down the road
    Else
        OutFile.WriteLine sCurrentLine                        ' Since we didn't find an '=' this is most likely a comment; just copy the line
    End If
    LineCount = LineCount + 1                                ' Increment the line count
Loop

For i = 0 to ParamCount                                        ' This is where we're adding the parameters and values we want to the new file
    OutFile.WriteLine dictParams("property")(i) & "=" & dictParams("value")(i)
Next

InFile.Close
OutFile.Close

fso.DeleteFile sInFile & ".bak"                                ' Delete any prior .bak files
fso.MoveFile sInFile, sInFile & ".bak"                        ' Copy the existing deployment.properties to deployment.properties.bak
fso.MoveFile sOutFile, sInFile                                ' Copy deployment.newproperties to deployment.properties

WScript.Quit ( 0 )                                            ' And we're done

' ******* Support Routines below
Function FileExists(file)
    Dim fso
    Set fso = CreateObject("Scripting.FileSystemObject")
    If (fso.FileExists(file)) Then
        FileExists = True
    Else
        FileExists = False
    End If
End Function

Private Function DebugText(text)
   If SHOWDEBUG Then
      MsgBox text
   End If
End Function

Function FolderExists(fldr)
    Dim fso
    Set fso = CreateObject("Scripting.FileSystemObject")
    If (fso.FolderExists(fldr)) Then
        FolderExists = True
    Else
        FolderExists = False
    End If
End Function

Sub CreateDirs( MyDirName )
' This subroutine creates multiple folders like CMD.EXE's internal MD command.
' By default VBScript can only create one level of folders at a time (blows
' up otherwise!).
'
' Argument:
' MyDirName   [string]   folder(s) to be created, single or
'                        multi level, absolute or relative,
'                        "d:\folder\subfolder" format or UNC
'
' Written by Todd Reeves
' Modified by Rob van der Woude
' http://www.robvanderwoude.com

    Dim arrDirs, i, idxFirst, objFSO, strDir, strDirBuild

    ' Create a file system object
    Set objFSO = CreateObject( "Scripting.FileSystemObject" )

    ' Convert relative to absolute path
    strDir = objFSO.GetAbsolutePathName( MyDirName )

    ' Split a multi level path in its "components"
    arrDirs = Split( strDir, "\" )

    ' Check if the absolute path is UNC or not
    If Left( strDir, 2 ) = "\\" Then
        strDirBuild = "\\" & arrDirs(2) & "\" & arrDirs(3) & "\"
        idxFirst    = 4
    Else
        strDirBuild = arrDirs(0) & "\"
        idxFirst    = 1
    End If

    ' Check each (sub)folder and create it if it doesn't exist
    For i = idxFirst to Ubound( arrDirs )
        strDirBuild = objFSO.BuildPath( strDirBuild, arrDirs(i) )
        If Not objFSO.FolderExists( strDirBuild ) Then
            objFSO.CreateFolder strDirBuild
        End if
    Next

    ' Release the file system object
    Set objFSO= Nothing
End Sub

No comments:

Post a Comment