All Keys information

'''
''' No Warrenty Provided for this code. Use at your own risk.
'''

Const HKEY_CLASSES_ROOT   = &H80000000
Const HKEY_CURRENT_USER   = &H80000001
Const HKEY_LOCAL_MACHINE  = &H80000002
Const HKEY_USERS          = &H80000003
Const REG_SZ        = 1
Const REG_EXPAND_SZ = 2
Const REG_BINARY    = 3
Const REG_DWORD     = 4
Const REG_MULTI_SZ  = 7


'' Looking at the local machines registry
Set reg = GetObject("winmgmts://./root/default:StdRegProv")

 '' Check the current user hive for values
FindAndDeleteKey HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Internet Settings\Connections"

'' get a list of user hives
  reg.EnumKey HKEY_USERS, "", subkeys
  If Not IsNull(subkeys) Then
    '' Iterate through each hive and call the sub to find and delete the values
    For Each sk In subkeys
        FindAndDeleteKey HKEY_USERS, sk & "\Software\Microsoft\Windows\CurrentVersion\Internet Settings\Connections"
    Next
  End If


''' sub '''
''Find and display the value of the related keys.
Sub FindAndDeleteKey(root, key)
  reg.EnumValues root, key, names, types
  If Not IsNull(names) Then
    For Each name In names
        '' For each value in this key searh for the two valeus we are looking for.
      If (name = "DefaultConnectionSettings") Or (name = "SavedLegacySettings") Then
        Dim strValue
        reg.GetBinaryValue root, key, name, strValue
        PrintData key, name, regReadBinary(strValue)
        '''''''''
        '' We have all the data we need, we could put a delete command here
        '' to remove the entry if the user has the permissions to do this.
        '''''''''
      End If
    Next
  End If
End Sub

Sub PrintData(heading,body,data)
    wScript.Echo VbCrLf + "#################"
    wScript.Echo "###  Key  ###"   
    wScript.Echo heading
    wScript.Echo "### Value ###"
    wScript.Echo body
    wScript.Echo "### Data  ###"
    wScript.Echo data
    wScript.Echo "#################" + VbCrLf
End Sub

''Convert REG_BINARY to ASCII String.
Function regReadBinary(aBin)
      Dim aInt(), i, iBinSize, sString, iChar, sChar
      If Err.Number = 0 Then
             iBinSize = UBound(aBin)
             ReDim aInt(iBinSize)
             For i = LBound(aBin) To UBound(aBin)
                   aInt(i) = CInt(aBin(i))
                   If aInt(i) <> 0 Then
                         iChar = aInt(i)
                         sChar = Chr(iChar)
                         sString = sString&sChar
                   End If
             Next
             regReadBinary=sString
      End If
End Function

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

FolderLister

Sub ShowSubFolders (Folder, Depth)  
column = 1
If Depth > 0 then        
For Each Subfolder in Folder.SubFolders            
ShowSubFolders Subfolder, Depth - 1        

ObjXL.ActiveSheet.Cells(icount,column).Value = Subfolder.Path
ObjXL.ActiveSheet.Cells(icount,column).select
CAFLink = Subfolder.Path
ObjXL.Workbooks(1).Worksheets(1).Hyperlinks.Add ObjXL.Selection, CAFLink
icount = icount + 1

Next    

End if
End Sub
' Specify Folder Depth (D)
D = 2
' Get CAF Path from user (rootfolder)
rootfolder = Inputbox("Enter CAF or folder path: " & chr(10) & "(e.g.\\Server\Root Folder Name\Folder\etc\)" & chr(10) & _
 chr(10) & "Folder Depth Currently Set to " & D & " folder levels " & chr(10), _
"Directory Tree Generator", "C:\Temp\")
'Run ShowSubFolders if something was entered in the CAF directory field, else just end
if rootfolder <> "" Then

outputfile = "C:\Temp\" & Year(now) & Month(now) & Day(now) & "DIR_MAP_V1.0.xlsx"
Set fso = CreateObject("scripting.filesystemobject")
if fso.fileexists(outputfile) then fso.deletefile(outputfile)

'Create Excel workbook
set objXL = CreateObject( "Excel.Application" )
objXL.Visible = False
objXL.WorkBooks.Add
'Counter 1 for writing in cell A1 within the excel workbook
icount = 1
'Run ShowSubfolders - D is the folder depth to parse
ShowSubfolders FSO.GetFolder(rootfolder), D  

'Lay out for Excel workbook
  objXL.Range("A1").Select
  objXL.Selection.EntireRow.Insert
  objXL.Selection.EntireRow.Insert
  objXL.Selection.EntireRow.Insert
  objXL.Selection.EntireRow.Insert
  objXL.Selection.EntireRow.Insert

  objXL.Columns(1).ColumnWidth = 90
  objXL.Range("A1").NumberFormat = "d-m-yyyy"
  objXL.Range("A1:A3").Select
  objXL.Selection.Font.Bold = True
  objXL.Range("A1:B3").Select
  objXL.Selection.Font.ColorIndex = 5
  objXL.Range("A2").Select
  ObjXL.ActiveSheet.Cells(1,1).Value = Day(now) & "-" & Month(now) & "-"& Year(now)
  ObjXL.ActiveSheet.Cells(2,1).Value = "DIRECTORY MAP FOLDER DEPTH:- " & D  
  ObjXL.ActiveSheet.Cells(3,1).Value = UCase(rootfolder)
  objXL.Range("A1").Select
  objXL.Selection.Font.Bold = True
'Finally close the workbook
  ObjXL.ActiveWorkbook.SaveAs(outputfile)
  ObjXL.Application.Quit
  Set ObjXL = Nothing
'Message when finished
  Set WshShell = CreateObject("WScript.Shell")
  Finished = Msgbox ("CAF Map Generated Here:-" & Chr(10) _
& outputfile & "." & Chr(10) _
& "Do you want to open the Folder Map now?", 65, "DIRECTORY Map Generator")
  if Finished = 1 then WshShell.Run "excel " & outputfile

end if

AllUsersTemplates

Templates Update

Option Explicit
'------------------------------------------------------------------------------------------------
' VBScript to deploy changes & deletions of document Templates
'
' NOTE: This script copies the files to/deletes files from each users' Templates folder, e.g
'       C:\Documents and Settings\<user>\Application Data\Microsoft\Templates
'------------------------------------------------------------------------------------------------

Dim IniFile
IniFile = "BTTemplate.INI"

'------------------------------------------------------------------------
' Preparations - create objects, define variables, get values, etc.
'------------------------------------------------------------------------

Const ForReading = 1, ForWriting = 2, ForAppending = 8
Const ScriptName = "BTTemplatesUpdate.vbs"
Const INIFileName = "INIs\SiteRef.INI"
Const RemoveTemplatesFileName = "INIs\RemoveTemplates.txt"
Const AllUsersTemplatesFolder = "C:\Documents and Settings\Default User\Application Data\Microsoft\Templates"
Const UserTemplatesPath = "\Application Data\Microsoft\Templates"

' Objects
Dim WshShell
Dim ObjEnv
Dim Fso
Dim Wshnetwork

' Variables
Dim NewTemplatesFolder
Dim UserTemplatesFolder
Dim RemoveTemplates()
ReDim RemoveTemplates(0)
Dim RmvTmplCount
Dim log
Dim LogFile
Dim CurrWorkDir

' INI File values
Dim TemplatePath
Dim TemplateFileSite

Set WshShell=wscript.createobject("wscript.shell")
Set ObjEnv= wshshell.environment("Process")
Set Fso = WScript.CreateObject("Scripting.FileSystemObject")
Set Wshnetwork=wscript.createobject("wscript.network")

On Error Resume Next

' Keep log in standard logs location
log = "C:\Windows\Appslogs\TemplatesUpdate.log"

'------------------------------------------------------------------------------------------------
' Ready...
'------------------------------------------------------------------------------------------------

' Set the location of the new Templates
CurrWorkDir = WshShell.CurrentDirectory & "\"


' Check for and, if necessary create the All Users Templates folder
If Not Fso.FolderExists(AllUsersTemplatesFolder) Then
Fso.CreateFolder(AllUsersTemplatesFolder)
End If

' Create or Open logfile and add entry
Set LogFile = Fso.OpenTextFile(log, ForAppending, True)
call Writelog("* * * Start Script * * *")

' Clear errors in case key doesn't exist
Err.Clear

' Check required files exist
CheckFiles

' Read SiteRef.INI and Delete Templates.txt files
ReadINIFiles
If Len(Trim(TemplatePath)) = 0 Then
' Report error and stop
ExitScript("104 No valid value for TemplatePath")

End If

If Len(Trim(TemplateFileSite)) = 0 Then
' Report error and stop
ExitScript("105 No valid value for TemplateFileSite")

End If


' Check referenced new templates folder exists
CheckTemplatesFolder

' Check correct PC for supplied templates
CheckPCTemplates

' Update the Templates held in All Users AND by each user
WriteLog("All checks passed... updating PC")
UpdateTemplates


' End
ExitScript("0 Script completed OK")

'------------------------------------------------------------------------------------------------
' Subroutines
'------------------------------------------------------------------------------------------------
' Check required files exist
Sub CheckFiles()

' Check INI and DeleteTemplates files exist...
'
' SiteRef.INI
If Not Fso.FileExists(CurrWorkDir & INIFileName) Then
  ' Report error and stop
  ExitScript("100 INI File (" & CurrWorkDir & INIFileName & ") not found")
End If

' DeleteTemplates
If Not Fso.FileExists(CurrWorkDir & RemoveTemplatesFileName) Then
  ' Report error and stop
  ExitScript("101 Delete Templates File (" & CurrWorkDir & RemoveTemplatesFileName & ") not found")
End If

End Sub
'------------------------------------------------------------------------------------------------
' Read the INI file
Sub ReadINIFiles()
Dim f1
Dim ReadLine

' Read the INI file. Store the TemplatePath and TemplateFileSite values, and build an
' array of the Templates to delete

  Set f1 = fso.OpenTextFile(CurrWorkDir & INIFileName, ForReading)
 
' Read all lines in the file
Do Until f1.AtEndOfStream
  ReadLine = Trim(f1.ReadLine)
 
  ' Ignore commented out and blank lines
  If Left(ReadLine,1) <> ";" And Len(ReadLine) > 0 Then
  ' If INI file there will be value labels - extract their values
  If Ucase(Left(ReadLine, 13)) = "TEMPLATEPATH=" Then
  TemplatePath = Mid(ReadLine,14)
WriteLog("TemplatePath = " & TemplatePath)  
 
  ElseIf Ucase(Left(ReadLine, 17)) = "TEMPLATEFILESITE=" Then
  TemplateFileSite = Mid(ReadLine,18)
WriteLog("TemplateFileSite = " & TemplateFileSite)  
 
  End If
End If
Loop

f1.Close
  Set f1 = Nothing


' Read the RemoveTemplates file and store in the RemoveTemplates() array

  Set f1 = fso.OpenTextFile(CurrWorkDir & RemoveTemplatesFileName, ForReading)
  RmvTmplCount = 0
 
' Read all lines in the file
Do Until f1.AtEndOfStream
  ReadLine = Trim(f1.ReadLine)
 
  ' Ignore commented out and blank lines
  If Left(ReadLine,1) <> ";" And Len(ReadLine) > 0 Then
 
RemoveTemplates(RmvTmplCount) = ReadLine

' Increment array count & redefine the array
RmvTmplCount = RmvTmplCount + 1
ReDim Preserve RemoveTemplates(RmvTmplCount)

End If
Loop

f1.Close
  Set f1 = Nothing

End Sub
'------------------------------------------------------------------------------------------------
' Check the Templates folder exists
Sub CheckTemplatesFolder()

If Not Fso.FolderExists(CurrWorkDir & "Templates") Then
  ' Templates folder not found - exit
  WriteLog("Error 102 Templates Folder (" & CurrWorkDir & "Templates" & "\" & TemplatePath & ") not found")
  ExitScript("102 Templates Folder not found")
  End If

End Sub
'------------------------------------------------------------------------------------------------
' Check PC has the previous version of the example Template
Sub CheckPCTemplates()

' Only need to check this is a suitable target PC if the TemplateFileSite value is not "no_check"
If Lcase(TemplateFileSite) <> "no_check" Then
' Check the named fie exists on the PC
If Not Fso.FileExists(AllUsersTemplatesFolder & "\" & TemplateFileSite) Then
' File not found - this is not a suitable PC
WriteLog("Error 103 TemplateFileSite (" & AllUsersTemplatesFolder & "\" & TemplateFileSite & ") not found")
ExitScript("103 TemplateFileSite file not found")
End If
End If

End Sub
'------------------------------------------------------------------------------------------------
' Update the Templates on the PC
Sub UpdateTemplates()
Dim f
Dim sf
Dim folderName
Dim x

' Ignore any error
On error Resume Next

NewTemplatesFolder = CurrWorkDir & "Templates" & "\" & TemplatePath

' Process every user folder (this includes Default User)
Set f = Fso.GetFolder("C:\Documents and Settings")
Set sf = f.SubFolders

' Copy to each user's Templates folder
For Each folderName In sf
WriteLog("Processing " & folderName)

' Set the Templates path
UserTemplatesFolder = folderName  & UserTemplatesPath

' If Users Templates folder does not exist, create one
If Not Fso.FolderExists(UserTemplatesFolder) Then
WriteLog(UserTemplatesFolder & " not found... creating")
Fso.CreateFolder(UserTemplatesFolder)
End If

' Copy new templates
FSO.DeleteFile(UserTemplatesFolder & "\*.*")
Fso.CopyFile NewTemplatesFolder & "\*.*", UserTemplatesFolder, True
If Err.Number <> 0 then
If Err.Number <> 76 Then ' Ignore "Path not found" - usually applies to All Users folder
call WriteLog(Err.Description & " Error # " & Err.Number & " - Possible error copying files")
End If
Err.Clear
End If

' Check for and if present delete files listed in the RemoveTemplate() array
For x = 0 to (RmvTmplCount - 1)
  If Fso.FileExists(UserTemplatesFolder & RemoveTemplates(x)) Then
  ' Delete the file
  WriteLog("Deleting file " & UserTemplatesFolder & RemoveTemplates(x))
  Fso.DeleteFile UserTemplatesFolder & RemoveTemplates(x), True
If Err.Number <> 0 then
call WriteLog(Err.Description & " Error # " & Err.Number & " - Possible error deleting file")
Err.Clear
End If
  End If
Next

' Reset user flag to force Templates location reset next time user logs on
WriteLog("Deleting user flag (" & UserTemplatesFolder & "\*Otmp.FLG" & ") to force Template folder location reset")
Fso.DeleteFile UserTemplatesFolder & "\*Otmp.FLG", True
If Err.Number <> 0 Then
' Ignore "File Not Found"
If Err.Number <> 53 Then
call WriteLog(Err.Description & " Error # " & Err.Number & " - Possible error deleting file")
End If
Err.Clear
End If

Next ' Loop to next User folder

End Sub
'------------------------------------------------------------------------------------------------
' Exit and report why
Function ExitScript(ExitText)
Dim ErrorCode

' Extract the error code from the start of the supplied text. This may not be 3 digits, so
' manipulate it
If IsNumeric(Left(ExitText,3)) Then
ErrorCode = Left(ExitText,3)
ElseIf IsNumeric("0" & Left(ExitText,2)) Then
ErrorCode = "0" & Left(ExitText,2)
Else
ErrorCode = "00" & Left(ExitText,1)
End If

' Log messages other than 999 codes
If ErrorCode <> "999" then
call Writelog("Script exiting with error: " & ExitText)
call Writelog("* * * End Script * * *")
LogFile.WriteLine
End If

' Exit the script & return the error code
Wscript.Quit ErrorCode
End Function

'------------------------------------------------------------------------------------------------
' Write entry to log
Function WriteLog(LogText)
LogFile.WriteLine Date() & " " & Time() & " " & ScriptName & ": " &  LogText
End Function

SIDFetch

PsGetsid.exe ANSI to TEXT Conversion Scripts
.....................................................................................................................................................................................................................................................................................................................................

SID Conversion

on error resume next
Const ForReading = 1
Const TristateTrue = -1 'UniCode
Dim WshShell : Set WshShell = CreateObject("WScript.Shell")
Windir = WshShell.ExpandEnvironmentStrings("%windir%")
FilePath = windir & "\Temp\userSID.txt"
'Convert supplied file to Ansi_File.txt

Set oFSO = CreateObject("scripting.filesystemobject")
Set oFile = oFSO.GetFile(FilePath)

Set oFileIn = oFSO.OpenTextFile(oFile.Path,ForReading,,TristateTrue)
Set oFileOut = oFSO.CreateTextFile(oFile.ParentFolder & "\ansi_" & oFile.Name,True,False)

oFileOut.Write oFileIn.ReadAll

SID Reader

Const ForReading = 1
Dim objWshShell : Set objWshShell = CreateObject("WScript.Shell")
Dim WshShell : Set WshShell = CreateObject("WScript.Shell")
Dim str1, Windir
Set objFSO = CreateObject("Scripting.FileSystemObject")
Windir = WshShell.ExpandEnvironmentStrings("%windir%")
Set objFile = objFSO.OpenTextFile(windir & "\Temp\ansi_userSID.txt", ForReading)

Do Until objFile.AtEndOfStream
    strNextLine = objFile.ReadLine
    If Len(strNextLine) > 0 Then
        strLine = strNextLine
    End If
Loop

objFile.Close
'Wscript.Echo strLine
str1 = "HKEY_LOCAL_MACHINE\SOFTWARE\SID\Current_UName\Usersid"

WshShell.Regwrite str1 ,strLine, "REG_SZ"

IniPathLocation

'##############################################
'Getting the Current user registry key value in a variable
On Error Resume Next

strComputer = "."

wbemImpersonationLevelImpersonate = 3
wbemAuthenticationLevelPktPrivacy = 6
Dim strINIPath


Dim objRegistry
Set objRegistry = CreateObject("Wscript.shell")
Set objshell = CreateObject("Wscript.shell")
Set FSO = CreateObject("Scripting.FileSystemObject")


Dim objWshShell : Set objWshShell = CreateObject("WScript.Shell")
'set wshShell = CreateObject("WScript.Shell")

Dim oReg,strHKCU
Dim strKeyParent
Dim ret
Dim strKeyName
Dim arrSubKeys
Dim strAppDataChk
Dim strNotesINI
Dim ConfigIni,ConfigXml
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_USERS = &H80000003

Set WshShell = CreateObject("WScript.Shell")

Set ObjFSO=CreateObject("Scripting.filesyStemObject")

strComputerName = "."

On Error Resume Next
strGUID = WScript.Arguments.Item(0)
strAppDataChk = objWshShell.RegRead("HKEY_USERS\" & strGUID & "\Software\Lotus\Notes\8.0\NotesIniPath")

str1 = "HKEY_LOCAL_MACHINE\SOFTWARE\SID\Current_UName\notesini\path"
WshShell.Regwrite str1 ,strAppDataChk, "REG_SZ"

Folder Size

On Error Resume Next

Dim oFS, oFolder, UserName, path1,UserProf
set oFS = WScript.CreateObject("Scripting.FileSystemObject")
Dim WshShell: Set WshShell = CreateObject("Wscript.Shell")'Declare Global Shell Object
'UserName = WshShell.ExpandEnvironmentStrings ("%USERNAME%")
UserName = WScript.Arguments.Item(0)
NoteFilesPath = WScript.Arguments.Item(1)
UserProf = WshShell.ExpandEnvironmentStrings ("%USERPROFILE%")
path1=chr(34) & UserProf & "\Local Settings\Application Data\Lotus\Notes\Data" & chr(34)
set oFolder = oFS.GetFolder(NoteFilesPath)
'ShowFolderDetails oFolder


sub ShowFolderDetails(oF)
dim F
    wscript.echo  oF.Size

end sub

Dim sh

'msgbox oFolder.Size
Size=oFolder.Size

'msgbox size
size=SizeOnDisk(Size,4096)

Set sh = CreateObject("Wscript.shell")

sh.RegWrite "HKLM\Software\Folder_size\CopyFoldersizeA", Size,"REG_SZ"

Function SizeOnDisk(intFileSize,intClusterSize)
        If (intFileSize <= intClusterSize) Then
                SizeOnDisk = intClusterSize
        Else
                Dim intBase : intBase = intFileSize / intClusterSize
                If Int(intBase) <> intBase Then
                        intBase = int(intBase) + 1
                        SizeOnDisk = (intBase * intClusterSize)
                End If
        End If
 End Function