Bluebeam User name swap script and backup user prefs
Option Explicit
''2020-06-25 RON.ALLEN@KTGY.COM
Const ForReading = 1 ''TEXT FILE CONSTANTS
Const ForWriting = 2
Const ForAppending = 8
Const TristateUseDefault = -2 ''TEXT FILE WRITE CONSTANTS
Const TristateTrue = -1 ''unicode
Const TristateFalse = 0 ''ascii
''regex''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Const strBBrepl = "([\s\S]{1,}<General>)([\s\S]{1,}<UserName>)(.+)(<\/UserName>)([\s\S]{1,})"
''REGEX OVERVIEW:''$1'''''''''''''''''''$2''''''''''''''''''''$3''$4''''''''''''$5
''''''''''''Replacement="$1$2" & UserName & "$4$5"
'''''''''''''''''''''''''''''Any Char''<General>'Any Char'''<USER>'*ID*''</USER>off+(Rest of file)
''REgex [\s\S]{1,} = one or more of *any+every* character including newline/beak
''Keys in to find closest match of <GENERAL> XML START WITH <USER> INSIDE IT, extracts the user ID and all fields are replaced.
''vba ref active ds library
MAIN
Sub MAIN()
''NOTE - This is a blunt 'hack and swap' using REGEX. - Ron.Allen
Dim WS 'AS New WshShell ''WSH Windows scripting host
Dim fpBB 'AS String ''file path bluebeam for each version - will iterate versions
Dim fn 'AS String ''File name
Dim objFold 'AS Folder '' BB folder
Dim objSf 'AS Folder ''Subfolder iterate
Dim objTXTfile 'AS TextStream ''r/w text file
Dim strTXT 'AS String ''String to hold XML file (Watch for unicode issues?)
Dim strUsername 'AS String ''user Name String to replace
Dim Pass 'AS Boolean ''pass fail on find
Dim strMsg 'AS String ''String message builder
Dim FSO 'As New FileSystemObject ''Direct access to files (Be careful!)
Set FSO = CreateObject("Scripting.FileSystemObject") ''Create FSO object
''''''''GET USER FIRST AND LAST NAME FROM LDAP''''''''''''''''''''''''''
''Pull from full name and title - outlook? AD? **LDAP**:
Dim objSysInfo
Dim objcurrentuser
Set objSysInfo = CreateObject("ADSystemInfo")
Set objcurrentuser = GetObject("LDAP://" & objSysInfo.UserName)
strUsername = objcurrentuser.givenName & " " & objcurrentuser.LastName
Set objcurrentuser = Nothing
Set objSysInfo = Nothing
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''User Path E.G.
''C:\Users\ron.allen\AppData\Roaming\Bluebeam Software\Revu\19\UserPreferences.xml
Set WS = CreateObject("WScript.Shell")
fpBB = WS.ExpandEnvironmentStrings("%APPDATA%") & "\Bluebeam Software\Revu\" ''Revu path
Set objFold = FSO.GetFolder(fpBB) ''Set working folder
Dim i
For Each objSf In objFold.SubFolders ''Run thorugh subfolders for version match
''18,19,20 uses userpref xml file <<<<EDIT FOR ADDING NEW VERSIONS!
If (objSf.Name = "18" Or objSf.Name = "19" Or objSf.Name = "20") _
And _
FSO.FileExists(objSf.Path & "\UserPreferences.xml") _
Then
strMsg = strMsg & "REVU " & objSf.Name & ":" & vbCr ''inform REVU verison modified
'''WScript.Echo objSf.Path & "\UserPreferences.xml" <<<debug
''Get text file (each 2019, 2019, 2020 folder)
Set objTXTfile = _
FSO.OpenTextFile( _
objSf.Path & "\UserPreferences.xml", _
ForReading, _
False, _
TristateFalse)
strTXT = objTXTfile.ReadAll ''Read the TXT file into a string
objTXTfile.Close ''Close it
Pass = False ''Set pass to false - if true it will continue with the file
Pass = regex_REPL(strTXT, strBBrepl, "$1$2" & strUsername & "$4$5") ''Test the REGulaeEXpressions replace see regex101.com for REGEX~!
If Not Pass Then ''If failed and didn't find it - add to message
strMsg = strMsg & "FAIL! Username change: " & vbCr & _
objSf.Path & "\UserPreferences.xml" ''Add to message
Else ''Else it passed
strMsg = strMsg & "PASS! usernmae change: " & vbCr & _
objSf.Path & "\UserPreferences.xml" ''Add to message
''add backup original here
strMsg = strMsg & vbCr & BackupSingleFile(objSf.Path & "\UserPreferences.xml", False, False)
Set objTXTfile = _
FSO.CreateTextFile(objSf.Path & _
"\UserPreferences.xml", _
True, _
False)
objTXTfile.Write (strTXT)
objTXTfile.Close
End If
Else
strMsg = strMsg & vbCr & "FOLDER SKIP: " & vbCr & _
objSf.Path & "\UserPreferences.xml"
End If
strMsg = strMsg & vbCr
i = i + 1: If i > 4 Then Stop
Next ''objSf
MsgBox strMsg, vbOKOnly
End Sub
''backup single file to redord_FN folder file and return string message
'Private Function BackupSingleFile(StrFP As String, _
' Optional BackupFolderAppendFN As Boolean = False, _
' Optional CleanBackupFolderName As Boolean = True) As String
Private Function BackupSingleFile(StrFP, _
BackupFolderAppendFN, _
CleanBackupFolderName)
''takes Filename and optional clean up folder name and makes a copy of the file to a folder of the same name
''optional clean removes any funky characters and replaces with a "-" and removes duplicte "-"
Dim ObjFile ''As File ''file object
Dim FSO ''As FileSystemObject
Set FSO = CreateObject("Scripting.FileSystemObject") ''Create FSO object
Dim objFolder ''As Folder ''Current folder
Dim strRecordFolderName ''As String ''record folder name "RECORD-" + base Filename
Dim strFN ''As String ''str base file nmae no extension
Dim strExt ''As String ''filename extension
Dim dateMod ''As Date ''DATE for date mosified
dim WshShell 'AS WshShell ''For opening file folder to check if there are a ton of backups in there
If Not FSO.FileExists(StrFP) Then ''If file does NOT exist- warn
BackupSingleFile = BackupSingleFile & "NOT FOUND: " & StrFP ''mesage returned
Exit Function
End If
''else continue...
Set ObjFile = FSO.GetFile(StrFP)
strFN = FSO.GetBaseName(StrFP) ''base file name w/o extension
strExt = FSO.GetExtensionName(StrFP) ''extension for file - i.e. .xml
dateMod = ObjFile.DateLastModified ''date last modified for timestamp
''condition for typical RECORD folder name
''or RECORD-[File Name Append] for cleaner tracking of backed up individual files
If Not BackupFolderAppendFN Then ''Just use RECORD for backup folder
strRecordFolderName = "RECORD"
Else ''If append FN, then append the filename
strRecordFolderName = "RECORD-" & UCase(strFN)
If CleanBackupFolderName Then ''If cleanup FN apply to appended FN on record folde rname
''RECORD folder name - stick to base characters - replaec others with "-"
regex_REPL strRecordFolderName, "[^A-Za-z0-9\.\,\(\)\+\=]{1,}", "-"
''RECORD folder name - remove trailing "-"
regex_REPL strRecordFolderName, "\-{1,}$", ""
End If
End If
''parent folder for RECORD folder creation
Set objFolder = ObjFile.ParentFolder ''Current folder
If FSO.FolderExists(objFolder.Path & "\" & strRecordFolderName) Then 'see if user prefs backup folder exists
Set objFolder = FSO.GetFolder(objFolder.Path & "\" & strRecordFolderName) ''it does, use it
Else
Set objFolder = FSO.CreateFolder(objFolder.Path & "\" & strRecordFolderName) ''it didn't create and use that
End If
''format the NEW filename for the copied file...
strFN = objFolder.Path & "\" & strFN & "-" _
& Year(dateMod) & "-" _
& Right("00" & Month(dateMod), 2) & "-" _
& Right("00" & Day(dateMod), 2) & "-" _
& Right("00" & Month(dateMod), 2) & "t" _
& Right("00" & Hour(dateMod), 2) _
& Right("00" & Minute(dateMod), 2)
If Hour(dateMod) < 12 Then ''add redundant a/p to help id as time format
strFN = strFN & "a"
Else
strFN = strFN & "p"
End If
strFN = strFN & "." & strExt ''Filename + Datemod in YYYY-MM-DDtHHnna/p
''copy file to backp user prefs folder and append with date time - if exists, overwrite as necessary
ObjFile.Copy strFN, True
''verify in messages if fail pass:
If FSO.FileExists(strFN) Then
BackupSingleFile = BackupSingleFile & vbCr & "BACKUP EXISTS: " & strFN
Set WshShell = WScript.CreateObject("WScript.Shell") ''open RECORD locaiton
WshShell.Run "Explorer /e, " & objFolder.Path
set WshShell = nothing
Else
BackupSingleFile = BackupSingleFile & vbCr & "BACKUP FAIL: " & strFN
End If
End Function
Private Sub testre()
Debug.Print regex_REPL("123<General>456<Username>ron.allen</Username>789", _
strBBrepl, "$1$2" & "New.User.ID.SOMCREDENTIAL" & "$4$5")
End Sub
''regex_REPL
''strSource (called BYREF= "by reference = whatever I do to it here changes the variable from the call!
''strPattern= for the pattern to search
''strRepl = character to replace string, see regex101.com for REGEX~! find/match.replace!
Public Function regex_REPL(ByRef strSource, strPattern, strRepl) 'AS Boolean
Dim objRegEx 'AS New REGEXP ''VBS Regex declare
Dim Found 'AS Boolean ''Found check
Set objRegEx = CreateObject("vbscript.regexp") ''VBS Regex
objRegEx.Pattern = strPattern ''Pattern to match
objRegEx.Global = True ''Thorugh entire string global = true
objRegEx.IgnoreCase = True ''Ignore CaSe of letters
Found = objRegEx.Test(strSource) ''Test if matches string
regex_REPL = Found ''set function success/fail
If Not Found Then ''If test failed - no need to execute- not found
Exit Function ''exit function
End If
strSource = objRegEx.Replace(strSource, strRepl) ''Byref replaces strsource with replaced values
End Function
Comments
Post a Comment