'#Reference {9B8C2BA4-CC29-44B0-99B3-693EB4595A9D}#1.0#0#D:\Public\IPQueue\ReleaseMinSize\IPQueue.dll#IPQueue 1.0 Type Library ' The import file has to be in the following format. ' '************************************************************************* '[File_Info] 'Type = DD_Import; 'Name = test.vpp; 'Version = ERStudio4.2; ' '[Default] 'Name = Def1; 'Value = Def1-Val; ' '[Rule] 'Name = Rule1; 'Value = Rule1-Val; ' '[UserDatatype] 'Name = UDT1; ' '[UserDatatype] 'Name = UDT2; 'DataType = Decimal; 'DataLength = 20; 'DataScale = 3; 'Bind_Default = Def1; 'Bind_Rule = Rule1; ' '[Domain] 'Name = Dom1; 'Column = Dom1-Col; ' '[Domain] 'Name = Dom2; 'Column = Dom2-Col; 'DataType = Decimal; 'DataLength = 20; 'DataScale = 3; 'Bind_Default = Def1; 'Bind_Rule = Rule1; 'Bind_UserDatatype = UDT1; 'Identity = 1; 'IdentityIncrement = 2; 'IdentitySeed = 100; ' '[Domain] 'Name = Dom3; 'Column = Dom3-Col; 'DataType = counter; 'DataLength = 20; 'DataScale = 3; 'CheckConstraint = constraint_test; 'DeclaredDefault = default_test; 'Bind_UserDatatype = UDTTest3; 'Identity = 1; 'IdentityIncrement = 2; 'IdentitySeed = 100; ' '************************************************************************* ' 'GENERAL FORMAT: '*************** 'The section headers are wrapped in a open and close square brackets ("[]"), and 'all the value pairs (i.e. property = value) indicating different Data Dictionary 'object properties have to end in a semi-colon (";"). The macro will not work if these 'specific syntax are not used. All the section header names (i.e. Default, Rule, 'UserDataType, Domain) and value pair property names (i.e. Name, Column, DataType) are 'all case sensitive. Group the objects together, and preferably in 'Default, Rule, 'UserDatatype, and Domain order. The Rules, Defaults, and UserDatatypes'that are bound 'to other objects have to be declared before the object they are bound to. If the 'properties of the Data Dictionary objects are duplicated (i.e. there are 2 DataLengths 'given in a Domain section), the last one in the list of property value pairs in that 'section will be the one that is set for that property. ' 'File_Info: '********* 'Properties available: 'Type 'Name 'Version ' 'The [File_Info] section contains some information that we verify internally, 'since this file format will be used for other file functions later on. The 'Type has to indicate "DD_Import" and the actual file name has to match the 'file name that will be given during the execution of the macro. If the Type 'and Filename don't match in the verification the program will not work. The 'version property needs the ERStudio version entered, to be used later for other 'verification purposes. ' 'Default and Rule: '***************** 'Properties available: 'Name 'Value ' 'The [Default] and [Rule] section can only be created by giving both the name 'and the value (constraint/default). ' 'UserDatatype: '************* 'Properties available: 'Name 'DataType 'DataLength 'DataScale 'Bind_Default 'Bind_Rule ' 'The UserDatatype name is a mandatory property to declare in the file. 'And a UserDataType can be created with only a name specified. The 'other properties are defaulted as follows: ' 'DataType = CHAR 'DataLength = 18 'And no Default or Rule binding. ' 'You can also create a UserDatatype by specifying it's properties explicitly. 'Of course the DataLength and DataScale depends on the Datatype selected. 'If they are not supported, then they will not affect the Dictionary object. 'See the list of Datatypes below ( not case sensitive). You can also specify 'Defaults and Rules to bind to this UserDatatype. Just specify the names '(case-sensitive) for the Bind-Default and Bind_Rule properties. Just leave 'out the properties that you don't want to declare or reset. ' 'Domain: '******* 'Properties available: 'Name 'Column 'DataType 'DataLength 'DataScale 'Bind_Default 'Bind_Rule 'Bind_UserDatatype 'Identity 'IdentityIncrement 'IdentitySeed 'CheckConstraint 'DeclaredDefault ' 'The Domain Name and Column name are mandatory properties to declare in the file. 'And a Domain can be created with only the Name and Column Name specified. The 'other properties are defaulted as follows: ' 'DataType = CHAR 'DataLength = 10 'Identity = 0 'And no Default,Rule, or UserDatatype bindings. ' 'You can also create a Domain by specifying it's properties explicitly. 'The Identity property takes 0 (False) or 1 (True) as the input value. Of 'course the properties DataLength, DataScale, Identity, IdentitySeed, and 'IdentityIncrement all depend on the Datatype selected. If they are not 'supported, then they will not affect the Dictionary object. See the list 'of Datatypes below ( not case sensitive). You can also specify Defaults, 'Rules, and UserDatatypes to bind to this Domain. Just specify the name '(case-sensitive) for the Bind-Default, Bind_Rule, Bind_UserDataType properties. 'There is also another way of specifying constraints and defaults without 'using inding. Use the CheckConstraint and DeclaredDefault properties to 'set the constraint and default values. This properties can be used instead 'of the Bind_Default and Bind_Rule properties. And as usual, just leave out 'the properties that you don't want to declare or reset. ' 'DataTypes For UserDatatype And Domain: '************************************** 'these are the same things you see in the combo box selection when you 'choose the DataType in the Domain or UserDatatype editors. ' 'BINARY 'BIT 'CHAR 'NCHAR 'DATE 'DECIMAL 'DECIMALN 'DATETIME 'DATETIMN 'TEXT 'FLOATN 'FLOAT 'INTEGER 'INTN 'IMAGE/LONG BINARY 'LONG VARCHAR 'MLSLABEL/VARCHAR 'MONEY 'MONEYN 'NUMERICN 'NUMERIC 'PICTURE 'ROWID/VARCHAR 'SMALLDATETIME 'SERIAL/INTEGER 'REAL/SMALLFLOAT 'SMALLINT 'SMALLMONEY 'TIME/DATETIME 'TINYINT 'TIMESTAMP/DATE 'NTEXT/LONG NVARCHAR 'NVARCHAR 'VARCHAR 'VARBINARY/BLOB 'COUNTER 'DOUBLE PRECISION 'UNIQUEID 'BIGINT ' '************************************************************************* 'This macro is used to import Data Dictionary objects from a file. 'The imported file has to follow a specific format guideline. '************************************************************************* Sub Main 'declare needed variables Dim diag As Diagram Dim ddm As Dictionary Dim ipq As FmtRead Dim filename As Variant Dim nRetHeader As Long Dim nRetPair As Long Dim csObjName As Variant Dim csObjValue As Variant Dim csHeader As Variant Dim csProperty As Variant Dim csValue As Variant 'define value for important variables Set ipq = New FmtRead Set diag = DiagramManager.ActiveDiagram Set ddm = diag.Dictionary 'get the filenameto import filename = GetFilePath$ 'exit if no filename given If filename = "" Then MsgBox "No file has been selected. Program is terminating!" Exit Sub Else 'variables to indicate that the file is verified Dim bFileType As Boolean Dim bFileName As Boolean bFileType = False bFileName = False 'process the given file ipq.ReadFile filename ipq.GetNextHeader nRetHeader, csHeader 'Check for validity of the file If nRetHeader <> 0 And csHeader = "[File_Info]" Then ipq.GetNextValuePair nRetPair, csProperty, csValue 'extract the actual filename from the full path name 'returned by the GetFilePath function Dim csFile As String Dim Idx As Integer csFile = filename Idx = InStrRev(csFile,"\") Idx = Len(csFile) - Idx csFile = Right$(csFile,Idx) 'loop through the value pairs and compare with proper values While nRetPair <> 0 'do we have the right file type If csProperty = "Type" Then If csValue = "DD_Import" Then bFileType = True End If 'do the file name match in the file 'info and the getfilepath function ElseIf csProperty = "Name" Then If csValue = csFile Then bFileName = True End If End If ipq.GetNextValuePair nRetPair, csProperty, csValue Wend End If 'file information is verified so import the Data Dictionary objects If bFileType = True And bFileName = True Then 'indicators if mandatory properties are already given Dim bNameGiven As Boolean Dim bValueGiven As Boolean 'loop through all the section headers ipq.GetNextHeader nRetHeader, csHeader While nRetHeader <> 0 'these variables has to be reset to false for each loop 'through a header and it's accompanying value pairs bNameGiven = False bValueGiven = False 'Check for new Defaults If csHeader = "[Default]" Then ipq.GetNextValuePair nRetPair, csProperty, csValue 'loop through the defaults value pairs to get the needed property values While nRetPair <> 0 If csProperty = "Name" Then csObjName = csValue bNameGiven = True ElseIf csProperty = "Value" Then csObjValue = csValue bValueGiven = True End If ipq.GetNextValuePair nRetPair, csProperty, csValue Wend 'create the new default If bNameGiven = True And bValueGiven = True Then ddm.Defaults.Add(csObjName,csObjValue) Else MsgBox "The given properties for creating a Default were incomplete or some are not valid!" + vbCrLf + "The Default " + _ "with property '" + csProperty + " = " + csValue + "' will not be created!" End If 'Check for new Rule ElseIf csHeader = "[Rule]" Then ipq.GetNextValuePair nRetPair, csProperty, csValue 'get rule name and value While nRetPair <> 0 If csProperty = "Name" Then csObjName = csValue bNameGiven = True ElseIf csProperty = "Value" Then csObjValue = csValue bValueGiven = True End If ipq.GetNextValuePair nRetPair, csProperty, csValue Wend 'create new rule If bNameGiven = True And bValueGiven = True Then ddm.Rules.Add(csObjName,csObjValue) Else MsgBox "The given properties for creating a Rule were incomplete or some are not valid!" + vbCrLf + "The Rule with" + _ " property '" + csProperty + " = " + csValue + "' will not be created!" End If 'Check for new UserDatatypes ElseIf csHeader = "[UserDatatype]" Then Dim udt As UserDatatype ipq.GetNextValuePair nRetPair, csProperty, csValue 'get UDT name first to enable creation of UDT with default properties If csProperty = "Name" Then bNameGiven = True Set udt = ddm.UserDatatypes.Add (csValue) Else MsgBox "Error in file format! The Userdatatype name has to be entered first. The UserDatatype" + vbCrLf + _ "with leading property '" + csProperty + " = " + csValue + "' will not be created!" End If 'loop through the rest of the UDT properties If bNameGiven = True Then ipq.GetNextValuePair nRetPair, csProperty, csValue While nRetPair <> 0 'call function to set the other given properties Call Import_UDT_Properties(udt,ddm,csProperty,csValue) ipq.GetNextValuePair nRetPair, csProperty, csValue Wend End If 'Check for new Domain ElseIf csHeader = "[Domain]" Then ipq.GetNextValuePair nRetPair, csProperty, csValue 'get domain name and column name first to create a domain with default properties If nRetPair <> 0 And csProperty = "Name" Then csObjName = csValue bNameGiven = True 'get column name ipq.GetNextValuePair nRetPair, csProperty, csValue If nRetPair <> 0 And csProperty = "Column" And bNameGiven = True Then csObjValue = csValue bValueGiven = True Else MsgBox "Error in file format! The Domain column name"+ vbCrLf +"has to be entered before the other" + _ " properties." + vbCrLf + " The domain '" + csObjName + "' will not be created!" End If Else MsgBox "Error in file format! The Domain name has to be entered first. The domain" + vbCrLf + "with leading" + _ " property '" + csProperty + " = " + csValue + "' will not be created!" End If 'create the domain with defaulted properties Dim dom As Domain If bNameGiven = True And bValueGiven = True Then Set dom = ddm.Domains.Add (csObjName,csObjValue) 'now loop through the rest of the Domain properties ipq.GetNextValuePair nRetPair, csProperty, csValue While nRetPair <> 0 'call function to set the other given properties Call Import_Domain_Properties(dom,ddm,csProperty,csValue) ipq.GetNextValuePair nRetPair, csProperty, csValue Wend End If End If 'next header to process ipq.GetNextHeader nRetHeader, csHeader Wend Else MsgBox "The file information section [File_Info] is missing from the beginning" + vbCrLf + _ "of the file, or it has invalid entries. The import function failed!" End If End If End Sub '************************************************************************* 'This function sets the optional properties of UserDatatypes 'that can be specified in the import file. '************************************************************************* Sub Import_UDT_Properties(udt As UserDatatype, ddm As Dictionary, csProperty As Variant, csValue As Variant) Dim num As Integer Dim def As Default Dim rl As Rule Dim nId As Integer nId = 0 If csProperty = "Name" Then MsgBox "The name for UserDatatype " + udt.Name + " cannot be reset!" ElseIf csProperty = "DataType" Then udt.Datatype = csValue ElseIf csProperty = "DataLength" Then num = Val(csValue) udt.DataLength = num ElseIf csProperty = "DataScale" Then num = Val(csValue) udt.DataScale = num ElseIf csProperty = "Bind_Default" Then 'get the default ID to use for declaring the binding default For Each def In ddm.Defaults If def.Name = csValue Then nId = def.ID Next def 'default not found popup error message If nId = 0 Then MsgBox "UserDatatype '" + udt.Name + "' cannot bind to the given default!" + vbCrLf + _ "The specified Default name '" + csValue + "' does not exist!" End If 'set the binding ( zero is default) udt.DefaultId = nId ElseIf csProperty = "Bind_Rule" Then 'get the rule ID to use for declaring the binding rule For Each rl In ddm.Rules If rl.Name = csValue Then nId = rl.ID Next rl 'rule not found popup error message If nId = 0 Then MsgBox "UserDatatype '" + udt.Name + "' cannot bind to the given rule!"+ vbCrLf + _ "The specified Rule name '" + csValue + "' does not exist!" End If 'set the binding ( zero is default) udt.RuleId = nId Else MsgBox "The UserDatatype property '" + csProperty + " = " + csValue + "'" + "is unknown!" End If End Sub '************************************************************************* 'This function sets the optional properties of Domain 'that can be specified in the import file. '************************************************************************* Sub Import_Domain_Properties(dom As Domain, ddm As Dictionary, csProperty As Variant, csValue As Variant) Dim num As Integer Dim bIdentity As Boolean Dim def As Default Dim rl As Rule Dim udt As UserDatatype Dim nId As Integer nId = 0 'see which property has to be set If csProperty = "Name" Or csProperty = "Column" Then MsgBox "The name or column name for Domain " + dom.Name + " cannot be reset!" ElseIf csProperty = "DataType" Then dom.Datatype = csValue ElseIf csProperty = "DataLength" Then num = Val(csValue) dom.DataLength = num ElseIf csProperty = "DataScale" Then num = Val(csValue) dom.DataScale = num ElseIf csProperty = "Bind_Default" Then 'get the default ID to use for declaring the binding default For Each def In ddm.Defaults If def.Name = csValue Then nId = def.ID Next def 'default not found popup error message If nId = 0 Then MsgBox "Domain '" + dom.Name + "' cannot bind to the given default!" + vbCrLf + _ "The specified Default name '" + csValue + "' does not exist!" End If 'set the binding ( zero is default) dom.DefaultId = nId ElseIf csProperty = "Bind_Rule" Then 'get the rule ID to use for declaring the binding rule For Each rl In ddm.Rules If rl.Name = csValue Then nId = rl.ID Next rl 'rule not found popup error message If nId = 0 Then MsgBox "Domain '" + dom.Name + "' cannot bind to the given rule!"+ vbCrLf + _ "The specified Rule name '" + csValue + "' does not exist!" End If 'set the binding ( zero is default) dom.RuleId = nId ElseIf csProperty = "Bind_UserDatatype" Then 'get the UserDatatype ID to use for declaring the binding UserDatatype For Each udt In ddm.UserDatatypes If udt.Name = csValue Then nId = udt.ID Next udt 'udt not found popup error message If nId = 0 Then MsgBox "Domain '" + dom.Name + "' cannot bind to the given userdatatype!" + vbCrLf + _ "The specified UserDatatype name '"+ csValue + "' does not exist!" End If 'set the binding ( zero is default) dom.UserDatatypeId = nId ElseIf csProperty = "CheckConstraint" Then 'set user-defined constraint dom.CheckConstraint = csValue ElseIf csProperty = "DeclaredDefault" Then 'set user-defined default dom.DeclaredDefault = csValue ElseIf csProperty = "Identity" Then bIdentity = Val(csValue) dom.Identity = bIdentity ElseIf csProperty = "IdentityIncrement" Then If dom.Identity = True Then num = Val(csValue) dom.IdentityIncrement = num End If ElseIf csProperty = "IdentitySeed" Then If dom.Identity = True Then num = Val(csValue) dom.IdentitySeed = num End If Else MsgBox "The Domain property '" + csProperty + " = " + csValue + "'" + "is unknown!" End If End Sub