Is it possible to save the local Sparx Enterprise Architect project preferences (Start > Preferences) to the database server?
We share the project through a database and have changed some settings for the project which seem to not be saved to the database and I suspect they are only saved in the local Windows registry.
There are two types of preferences in EA:
User preferences
Accessed through Start | Appearance | Preferences
Most of these settings are stored in the registry: Computer\HKEY_CURRENT_USER\Software\Sparx Systems\EA400\EA\OPTIONS
Model preferences
Accessed through Settings | Model | Options
These settings are stored in the repository itself.
EA does not support setting users settings on a model level out of the box.
Solution using EA-Matic
EA-Matic is a free open source add-in written by myself.
It supports executing scripts as a reaction to events such as EA_FileOpen()
This script below is used in order to ensure every user of the repository has these same settings.
It basically checks a number of registry values, and updates them if needed. Because EA only reads the registry when starting up, the script closes EA when it has updated a setting, asking the user to restart it.
'[path=\Projects\EA-Matic Scripts]
'[group=EA-Matic]
option explicit
!INC Local Scripts.EAConstants-VBScript
'
' Script Name: Fix Mandatory User Settings
' Author: Geert Bellekens
' Purpose: Check the mandatory user settings in the registry and set them correctly if needed
' Date: 2019-11-05
'
'EA-Matic
const REG_SZ = "REG_SZ"
const REG_DWORD = "REG_DWORD"
const REG_BINARY = "REG_BINARY"
function fixSettings
dim regPath
Dim regkey
dim regValue
dim existingValue
'place in the registry that contains all of the user settings
regPath = "HKEY_CURRENT_USER\Software\Sparx Systems\EA400\EA\OPTIONS\"
'get the EA version
dim eaVersion
eaVersion = Repository.LibraryVersion
dim settingsValid
settingsValid = true
'Fontname13 is only relevant for V15
if eaVersion > 1300 then
settingsValid = settingsValid AND validateRegValue(regPath, "FONTNAME13","Arial", REG_SZ)
else
settingsValid = settingsValid AND validateRegValue(regPath, "FONTNAME","Arial", REG_SZ)
end if
settingsValid = settingsValid AND validateRegValue(regPath, "SAVE_CLIP_FRAME","1", REG_DWORD)
settingsValid = settingsValid AND validateRegValue(regPath, "PRINT_IMAGE_FRAME","1", REG_DWORD)
settingsValid = settingsValid AND validateRegValue(regPath, "SAVE_IMAGE_FRAME","1", REG_DWORD)
settingsValid = settingsValid AND validateRegValue(regPath, "SORT_FEATURES","0", REG_DWORD)
settingsValid = settingsValid AND validateRegValue(regPath, "ALLOW_DUPLICATE_TAGS","1", REG_DWORD)
if not settingsValid then
msgbox "Mandatory user settings have been corrected." & vbNewLine & "Please restart EA",vbOKOnly+vbExclamation,"Corrected mandatory user settings!"
Repository.Exit
end if
end function
function validateRegValue(regPath, regKey, regValue, regType)
Dim shell
' Create the Shell object
Set shell = CreateObject("WScript.Shell")
dim existingValue
on error resume next
'read registry value
existingValue = shell.RegRead(regPath & regkey)
'if the key doesn't exist then RegRead throws an error
If Err.Number <> 0 Then
existingValue = ""
Err.Clear
end if
on error goto 0
'check the value in the registry with the desired value
if Cstr(existingValue) <> regValue then
'write the correct value to the registry
shell.RegWrite regPath & regkey, regValue, regType
'return false
validateRegValue = false
else
'value was already OK, return true
validateRegValue = true
end if
end function
function EA_FileOpen()
fixSettings
end function
In addition to Geerts excellent answer I would like to add that you can alter the registry location for the options (which go to registry and not to the database) by supplying an option to the command line when you open EA.
E.g. if you invoke EA with
"C:\Program Files (x86)\Sparx Systems\EA\EA.exe" /regkey:P1
it will create/access the key HKEY_CURRENT_USER\Software\Sparx Systems\P1 rather than \EA400 which is the default.
The options itself are found under the OPTIONS key below.
This gives you the opportunity to handle different settings out of the box. At least for those options Sparx decided to go to the registry rather than the database. (Editor's note: It will be an options jungle in any case)
Related
I am working on a model which is stored in a Postgresql Database. There exists a eapx file, to access this model.
Is it possible to write a script, to automatically export the Model to XML Files or similar, to create a regular snapshot?
You can use the EA.Project.ProjectTransfer() to export model to an eap(x) file.
Here's an example vbs script that can be executed by double-clicking it in the the windows explorer.
option explicit
' Purpose: Automated Project Transfer from DBMS to EAP file as weekly backup. See end of script for different databases that are backed up.
const logPath = "C:\shares\Backups\LogFile\"
const backupPath = "C:\shares\Backups\"
sub main
EADEV
MsgBox ("Back-up Finished.")
end sub
sub EADEV
Dim CurrentDate
Currentdate = (Year(Date) & (Right(String(2,"0") & Month(Date), 2)) & (Right(String(2,"0") & Day(Date), 2))) 'yyyymmdd'
dim repository
dim projectInterface
set repository = CreateObject("EA.Repository")
Dim FileName
Filename = "EA_Export.eap"
dim LogFilePath
LogFilePath = logPath&CurrentDate & " EA DEV (back-up).log"
dim TargetFilePath
TargetFilePath = logPath & "EA_Export.eap"
dim eapString
eapString = "DBType=1;Connect=Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=DB_Name;Data Source=ServerName;LazyLoad=1;"
'get project interface
set projectInterface = repository.GetProjectInterface()
projectInterface.ProjectTransfer eapString, TargetFilePath, LogFilePath
'close EA
repository.Exit
Dim newFilename
newFilename = backupPath & CurrentDate & " EA DEV (back-up).eap"
Dim Fso
Set Fso = WScript.CreateObject("Scripting.FileSystemObject")
Fso.MoveFile TargetFilePath, newFileName
end sub
main
In order to know what to put in the eapString you can connect to your database project and then save as a shortcut.
Then open the resulting file in a text editor and you'll find the connection string you need.
I have a script that will pin an item to the taskbar in all OS's except the Windows Insider builds. I converted it to a Powershell script and it also works on all OS's except the Windows Insider build. When I run it, I don't get any error messages, nothing in the Event Viewer. MS has been locking down the ability to programmatically pin items to both the Start Menu and the Taskbar. It looks like they're going further in upcoming releases. Has anyone else run into this? Here is the code I'm using.
Function PinItem(strFolder, strFile)
Dim ShortcutPath
Dim sKey1
Dim sKey2
Dim KeyValue
'----------------------------------------------------------------------
Set objFSO = CreateObject("Scripting.FileSystemObject")
ShortcutPath = strFolder & "\" & strFile
sKey1 = "HKCU\Software\Classes\*\shell\{:}\\"
sKey2 = Replace(sKey1, "\\", "\ExplorerCommandHandler")
'----------------------------------------------------------------------
With WScript.CreateObject("WScript.Shell")
KeyValue = .RegRead("HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer" & _
"\CommandStore\shell\Windows.taskbarpin\ExplorerCommandHandler")
.RegWrite sKey2, KeyValue, "REG_SZ"
With WScript.CreateObject("Shell.Application")
With .Namespace(objFSO.GetParentFolderName(ShortcutPath))
With .ParseName(objFSO.GetFileName(ShortcutPath))
.InvokeVerb("{:}")
End With
End With
End With
.Run("Reg.exe delete """ & Replace(sKey1, "\\", "") & """ /F"), 0, True
End With
End Function
I have been trying to come up with a script that will scan a specific subnet for an application not having been installed yet. I need to see if Lync is installed on some remote subnets before we turn up the sites live next month.
I have been running this as a logon script but it doesn't tell me what subnet they are in and it's not populating fast enough as users don't logoff.
On Error Resume Next
Set objShell = CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
set objSysInfo = CreateObject("ADSystemInfo")
Set objNetwork = WScript.CreateObject("WScript.Network")
strValue = objShell.RegRead("HKCU\Software\MRC Custom\Skype_Audit")
If strValue <> "Gathered 1.0" Then
objShell.RegWrite "HKCU\Software\MRC Custom\Skype_Audit", "Gathered 1.0"
x86 = objShell.ExpandEnvironmentStrings("%PROGRAMFILES(x86)%")
skypePath = x86 & "\Microsoft Office\Office15\lync.exe"
If objFSO.FileExists(skypePath) Then
version = objFSO.GetFileVersion(skypePath)
Else
version = "not installed"
End If
'Bind to the users DN
strUserPath = "LDAP://" & objSysInfo.UserName
set objUser = GetObject(strUserPath)
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
'Write Data to Log File
Const ForAppending = 8
strPath = "\\mcjunkinredman\data\userpub\Skype_Audit\Log.txt"
Set objTextFile = objFSO.OpenTextFile(strPath, ForAppending, True)
objTextFile.WriteLine objUser.samAccountName & "|" & objNetwork.ComputerName & "|" & version
End If
VBScript or PowerShell is fine, any help would be appreciated.
I wrote an article a while back that provides a script that connects to remote computers and retrieves the applications that are installed:
Windows IT Pro: Auditing 32-Bit and 64-Bit Applications with PowerShell
So, I'm using (after modification) this code, from here: How to set recurring schedule for xlsm file using Windows Task Scheduler
My error: Runtime error: Unknown runtime error.
I've searched far and wide to find an way to close the Excel process, but almost everybody uses .Quit sadly it gives the above error. I've also tried .Close, but that is not recognized
' Create a WshShell to get the current directory
Dim WshShell
Set WshShell = CreateObject("WScript.Shell")
' Create an Excel instance
Dim myExcelWorker
Set myExcelWorker = CreateObject("Excel.Application")
' Disable Excel UI elements
myExcelWorker.DisplayAlerts = False
myExcelWorker.AskToUpdateLinks = False
myExcelWorker.AlertBeforeOverwriting = False
myExcelWorker.FeatureInstall = msoFeatureInstallNone
' Tell Excel what the current working directory is
Dim strSaveDefaultPath
Dim strPath
strSaveDefaultPath = myExcelWorker.DefaultFilePath
strPath = "C:\Users\hviid00m\Desktop"
myExcelWorker.DefaultFilePath = strPath
' Open the Workbook specified on the command-line
Dim oWorkBook
Dim strWorkerWB
strWorkerWB = strPath & "\Status Report (Boxplots) TEST.xlsm"
Set oWorkBook = myExcelWorker.Workbooks.Open (strWorkerWB, , , , , , True)
' Build the macro name with the full path to the workbook
Dim strMacroName
strMacroName = "Refresh"
on error resume next
myExcelWorker.Run strMacroName
if err.number <> 0 Then
WScript.Echo "Fejl i macro"
End If
err.clear
on error goto 0
oWorkBook.Save
' Clean up and shut down
' Don’t Quit() Excel if there are other Excel instances
' running, Quit() will shut those down also
myExcelWorker.Quit <--- ERROR
Set oWorkBook = Nothing
Set myExcelWorker = Nothing
Set WshShell = Nothing
Found some code on a different side.
The reason why (as far as I understood) is that .Quit and .Close is for VBA not VBS.
' Clean up and shut down
' Don’t Quit() Excel if there are other Excel instances
' running, Quit() will shut those down also
Dim objWMIService, objProcess, colProcess
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\.\root\cimv2")
Set colProcess = objWMIService.ExecQuery ("Select * from Win32_Process Where Name = " & "'EXCEL.EXE'")
For Each objProcess in colProcess
objProcess.Terminate()
Next`
Set oWorkBook = Nothing
Set myExcelWorker = Nothing
Set WshShell = Nothing
Can you get mac addresses from Active Directory using Powershell? I am looking for a way to search for mac addresses in specific OUs if this is possible. Overall, I would like a dynamic way to find mac addresses for computers connected to the domain even if they are turned off and I thought AD might be a good way to go if possible. Thanks in advance for any help.
As the comments have said, that information is not held in Active Directory.
Consider using a computer start-up script to populate a field in AD with the mac address.
Also consider that many devices can have multiple mac addresses, some laptops may have 3 even.
This is an example based on a script I use (its in VBScript):
Option Explicit
Dim objRootDSE, objNetwork, objWMIService, objComputer
Dim strComputer, strMacAddresses
Dim colNetworkAdapterConfiguration, objNetworkAdapterConfiguration
Dim adoConnection, adoRecordset
strComputer = "."
strMacAddresses = ""
Set objRootDSE = GetObject("LDAP://RootDSE")
Set objNetwork = WScript.CreateObject("WScript.Network")
Set objWMIService = GetObject("Winmgmts:\\" & strComputer & "\root\cimv2")
Set colNetworkAdapterConfiguration = objWMIService.ExecQuery("Select * From Win32_NetworkAdapter Where AdapterType = 'Ethernet 802.3' OR AdapterType = 'Wireless'")
strMacAddresses = ""
If Not colNetworkAdapterConfiguration Is Nothing Then
For Each objNetworkAdapterConfiguration in colNetworkAdapterConfiguration
If strMacAddresses <> "" Then
strMacAddresses = strMacAddresses & " "
End If
strMacAddresses = strMacAddresses & Trim(objNetworkAdapterConfiguration.MACAddress)
Next
End If
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
If Err.Number <> 0 Then
WScript.Quit
End If
Set adoRecordset = adoConnection.Execute("<LDAP://" & objRootDSE.Get("defaultNamingContext") & ">;(&(objectCategory=Computer)(name=" & objNetwork.Computername & "));adspath;subtree")
If Err.Number <> 0 Then
WScript.Quit
End If
If Not adoRecordset.EOF Then
Set objComputer = GetObject(adoRecordset.Fields(0).Value)
objComputer.Put "extensionAttribute1", strMacAddresses
objComputer.SetInfo
End If
If Err.Number <> 0 Then
WScript.Quit
End If