'Option Explicit Const APPNAME = "landfx" Const IDOK = 1 Const IDABORT = 3 Const HKEY_CURRENT_USER = &H80000001 Const HKEY_LOCAL_MACHINE = &H80000002 ' these guys are for reading the cuifile Const ForReading = 1, ForWriting = 2, ForAppending = 8 Function InstallAcadProfile( ) Dim INSTALLDIR, InstallCompare, objReg, fso, acadVersions, release, regRoots, prodkey, Myprodkey, _ prodname, Result, aProfiles, profileX, AcadPath, PathArray, NewPath, pathx, RootFolder, i, cuifile, _ oxmlcui, node1, selset, omycui, menu1, myUID, DelFlag, pop1, typex, grouppos, menupos, tempx, wsset, wsx, _ ctbx, CTBPath, objWMIService, colFiles, errResult, oCIM, CTBfiles, objFile, filearray INSTALLDIR = "C:\LandFX\" InstallCompare = Mid(INSTALLDIR,1,Len(INSTALLDIR) - 1) ' drop the last \ for comparing paths Dim InstallPaths(4) InstallPaths(0) = INSTALLDIR InstallPaths(1) = INSTALLDIR & "SLIDES" InstallPaths(2) = INSTALLDIR & "PATTERNS" InstallPaths(3) = INSTALLDIR & "FONTS" InstallPaths(4) = INSTALLDIR & "IMAGES" Const PopMenus = 5 ' number of pop menus to install Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv") Set fso = CreateObject("Scripting.FileSystemObject") ' checking for if files exist Set oCIM = GetObject ("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2") ' for copying ctb files objReg.EnumKey HKEY_CURRENT_USER, "SOFTWARE\Autodesk\AutoCAD", acadVersions For Each release In acadVersions ' R16.1, R17.0 If Left(release,1) = "R" Then ' not FTPConnect, ARX, etc. objReg.EnumKey HKEY_CURRENT_USER, "SOFTWARE\Autodesk\AutoCAD\" & release, regRoots If IsArray(regRoots) Then For Each prodkey In regRoots ' ACAD401:209 If Left(prodkey,4) = "ACAD" Then ' there's something called AdImaging in there MyProdkey = release & "\" & prodkey Result = objReg.GetStringValue(HKEY_LOCAL_MACHINE,"SOFTWARE\Autodesk\AutoCAD\" & MyProdkey,"ProductName",prodname) If Result = 0 Then objReg.EnumKey HKEY_CURRENT_USER, "SOFTWARE\Autodesk\AutoCAD\" & MyProdkey & "\Profiles", aProfiles If IsArray(aProfiles) Then For Each profileX In aProfiles ' first, the path objReg.GetStringValue HKEY_CURRENT_USER,"SOFTWARE\Autodesk\AutoCAD\" & MyProdkey & "\Profiles\" & profileX & "\General","ACAD",AcadPath If TypeName(AcadPath) = "String" Then ' somehow a profile might not have this PathArray = Split(AcadPath,";") ' first, we remove all lfx path entries NewPath = "" For Each pathx in PathArray If pathx <> "" Then If InStr(1,pathx,InstallCompare,1) = 0 Then ' not a member of install path If InStr(1,pathx,"LandFX",1) = 0 Then ' not anything referencing LandFX NewPath = NewPath & pathx & ";" End If End If End If Next ' path ' so NewPath has all lfx paths removed ' add our paths here For Each i In InstallPaths NewPath = NewPath & i & ";" Next ' okay, write the path back objReg.SetStringValue HKEY_CURRENT_USER,"SOFTWARE\Autodesk\AutoCAD\" & MyProdkey & "\Profiles\" & profilex & "\General","ACAD",NewPath End If ' remove group entries i = 1 DelFlag = False objReg.GetStringValue HKEY_CURRENT_USER,"SOFTWARE\Autodesk\AutoCAD\" & MyProdkey & "\Profiles\" & profilex & "\Menus","Group" & CStr(i),menu1 Do While TypeName(menu1) = "String" If InStr(1,menu1,APPNAME,1) > 0 Then objReg.DeleteValue HKEY_CURRENT_USER,"SOFTWARE\Autodesk\AutoCAD\" & MyProdkey & "\Profiles\" & profilex & "\Menus","Group" & CStr(i) DelFlag = True Else If DelFlag Then ' then we need to adjust this guy down one objReg.DeleteValue HKEY_CURRENT_USER, "SOFTWARE\Autodesk\AutoCAD\" & MyProdkey & "\Profiles\" & profilex & "\Menus","Group" & CStr(i) objReg.SetStringValue HKEY_CURRENT_USER,"SOFTWARE\Autodesk\AutoCAD\" & MyProdkey & "\Profiles\" & profilex & "\Menus","Group" & CStr(i - 1),menu1 End If End If i = i + 1 objReg.GetStringValue HKEY_CURRENT_USER,"SOFTWARE\Autodesk\AutoCAD\" & MyProdkey & "\Profiles\" & profilex & "\Menus","Group" & CStr(i),menu1 Loop ' remove pop entries objReg.EnumValues HKEY_CURRENT_USER, "SOFTWARE\Autodesk\AutoCAD\" & MyProdkey & "\Profiles\" & profilex & "\Menus", pop1, typex If IsArray(pop1) Then ' somehow on clean machines no values here For Each i In pop1 If Left(i,3) = "Pop" Then ' a pop menu value objReg.GetStringValue HKEY_CURRENT_USER,"SOFTWARE\Autodesk\AutoCAD\" & MyProdkey & "\Profiles\" & profilex & "\Menus",i,menu1 If InStr(1,menu1,APPNAME,1) > 0 Then ' one of ours objReg.DeleteValue HKEY_CURRENT_USER,"SOFTWARE\Autodesk\AutoCAD\" & MyProdkey & "\Profiles\" & profilex & "\Menus",i End If End If Next End If ' if installing, add group entry and pop entries grouppos = 1 menupos = 1 ' need to step thru values in Menus key, find largest Group number, and largest Acad pop entry objReg.EnumValues HKEY_CURRENT_USER, "SOFTWARE\Autodesk\AutoCAD\" & MyProdkey & "\Profiles\" & profilex & "\Menus", pop1, typex If IsArray(pop1) Then For Each i In pop1 If Left(i,3) = "Pop" Then ' a pop menu value objReg.GetStringValue HKEY_CURRENT_USER,"SOFTWARE\Autodesk\AutoCAD\" & MyProdkey & "\Profiles\" & profilex & "\Menus",i,menu1 'If Left(menu1,4) = "ACAD" Then ' an acad group ' let's look at all, so if user custom tempx = CInt(Mid(i,4)) If tempx >= menupos And tempx < 100 Then ' ignore the 50x range of acad menus menupos = tempx + 1 End If 'End If ElseIf Left(i,5) = "Group" Then ' a group tempx = CInt(Mid(i,6)) If tempx >= grouppos Then grouppos = tempx + 1 End If End If Next End If ' okay, grouppos is set to our next available menugroup number, ' and menupos is set to one after the last acad menu objReg.SetStringValue HKEY_CURRENT_USER,"SOFTWARE\Autodesk\AutoCAD\" & MyProdkey & "\Profiles\" & profilex & "\Menus",_ "Group" & CStr(grouppos),UCase(APPNAME) & " " & INSTALLDIR & UCase(APPNAME) For i = 1 To PopMenus objReg.SetStringValue HKEY_CURRENT_USER,"SOFTWARE\Autodesk\AutoCAD\" & MyProdkey & "\Profiles\" & profilex & "\Menus",_ "Pop" & CStr(menupos),APPNAME & " " & "pop" & CStr(i) menupos = menupos + 1 Next ' lastly, let's copy the CTB files objReg.GetStringValue HKEY_CURRENT_USER,"SOFTWARE\Autodesk\AutoCAD\" & MyProdkey & "\Profiles\" & profileX & "\General","PrinterStyleSheetDir",CTBPath If TypeName(CTBPath) = "String" Then If Right(CTBPath,1) <> "\" Then CTBPath = CTBPath & "\" End If Set CTBfiles = oCIM.ExecQuery ("Select * from CIM_DataFile where " _ & "drive = '" & Left(INSTALLDIR,2) & "' and " _ & "path = '" & Mid(Replace(INSTALLDIR,"\","\\"),3) & "Administration\\' and " _ & "extension = 'ctb'") For Each objFile in CTBfiles ctbx = objFile.Name filearray = Split(ctbx,"\") ctbx = filearray(UBound(filearray)) ' just the filename If Not fso.FileExists(CTBPath & ctbx) Then errResult = objFile.Copy(CTBPath & ctbx) End If Next ' and the same for the STB Set CTBfiles = oCIM.ExecQuery ("Select * from CIM_DataFile where " _ & "drive = '" & Left(INSTALLDIR,2) & "' and " _ & "path = '" & Mid(Replace(INSTALLDIR,"\","\\"),3) & "Administration\\' and " _ & "extension = 'stb'") For Each objFile in CTBfiles ctbx = objFile.Name filearray = Split(ctbx,"\") ctbx = filearray(UBound(filearray)) ' just the filename If Not fso.FileExists(CTBPath & ctbx) Then errResult = objFile.Copy(CTBPath & ctbx) End If Next End If ' if ctb path read from registry Next ' profiles End If ' has profiles ' for everything else, if we have a CUI file, we make changes there. ' foreach this one, and localmachine, myprodkey, acadlocation \UserDataCache objReg.GetStringValue HKEY_CURRENT_USER,"SOFTWARE\Autodesk\AutoCAD\" & MyProdkey,"RoamableRootFolder",RootFolder RootFolder = RootFolder & "Support\" If fso.FileExists(Rootfolder & "ACAD.CUI") Then 'copy acad.cui to acad.cui.lfx Set cuifile = fso.GetFile(RootFolder & "ACAD.CUI") cuifile.Copy(RootFolder & "ACAD.CUI.LFX") ' open up the cui file Set oxmlcui = CreateObject("MSXML2.DOMdocument") oxmlcui.load(RootFolder & "ACAD.CUI") ' first, remove the partial menu group Set node1 = oxmlcui.selectNodes("//PartialMenuFile[. = """ & APPNAME & ".cui""]") If node1.Length > 0 Then Set node1 = node1.nextNode oxmlcui.selectSingleNode("//CommonItems").removeChild(node1) End If ' now remove the pop menus Set selset = oxmlcui.selectNodes("//WSPop[@MenuGroup=""" + UCase(APPNAME) + """]") If selset.Length > 0 Then For Each node1 In selset node1.parentNode.removeChild(node1) Next End If ' and remove the toolbars Set selset = oxmlcui.selectNodes("//WSToolbar[@MenuGroup=""" + UCase(APPNAME) + """]") If selset.Length > 0 Then For Each node1 In selset node1.parentNode.removeChild(node1) Next End If ' first, let's add the menu group ' let's grab the last menu group as an example Set node1 = oxmlcui.selectSingleNode("//CommonItems").lastChild.cloneNode(1) node1.text = APPNAME & ".cui" oxmlcui.selectSingleNode("//CommonItems").appendChild(node1) ' we need to open up our cui to find our puid's Set omycui = CreateObject("MSXML2.DOMdocument") omycui.load(INSTALLDIR & APPNAME & ".cui") ' first, the popmenus Set selset = omycui.selectNodes("//PopMenu") For Each node1 In selset Set wsset = oxmlcui.selectNodes("//WSPopRoot") If wsset.Length > 0 Then For Each wsx In wsset ' for each workspace pop menu root If wsx.hasChildNodes Then ' avoid empty workspace ' get the node to clone Set menu1 = wsx.firstChild.cloneNode(1) menu1.setAttribute "MenuGroup", UCase(APPNAME) menu1.setAttribute "Display", "1" menu1.firstChild.setAttribute "MajorVersion", "16" menu1.firstChild.setAttribute "MinorVersion", "2" menu1.firstChild.setAttribute "UserVersion", "1" ' get the uid of this item myUID = node1.getAttribute("UID") menu1.setAttribute "pUID", myUID menu1.setAttribute "UID", "FX_" & myUID wsx.appendChild(menu1) End If Next ' each workspace End If ' workspace has pop menu root Next ' each pop menu ' and our toolbars Set selset = omycui.selectNodes("//Toolbar[@ToolbarVisible=""show""]") For Each node1 In selset Set wsset = oxmlcui.selectNodes("//WSToolbarRoot") If wsset.Length > 0 Then For Each wsx In wsset ' for each workspace toolbar root If wsx.hasChildNodes Then ' avoid empty workspace ' get the node to clone Set menu1 = wsx.firstChild.cloneNode(1) menu1.setAttribute "MenuGroup", UCase(APPNAME) menu1.setAttribute "Display", "1" menu1.setAttribute "ToolbarOrient", "floating" menu1.setAttribute "rows", "1" menu1.setAttribute "dockrow", "1" menu1.setAttribute "dockcolumn", "1" menu1.firstChild.setAttribute "MajorVersion", "16" menu1.firstChild.setAttribute "MinorVersion", "2" menu1.firstChild.setAttribute "UserVersion", "1" ' get the uid of this item myUID = node1.getAttribute("UID") menu1.setAttribute "pUID", myUID menu1.setAttribute "UID", "FX_" & myUID menu1.setAttribute "xval", node1.getAttribute("xval") menu1.setAttribute "yval", node1.getAttribute("yval") wsx.appendChild(menu1) End If Next ' workspace End If ' workspace has toolbar root Next ' toolbar ' and save it back oxmlcui.save(RootFolder & "ACAD.CUI") End If ' cui file exists End If ' queried product name End If ' if acad version Next ' prodkey End If ' not empty version folder End If ' not ftpconnect Next ' each acad version InstallAcadProfile = IDOK End Function InstallAcadProfile()