'TITLE: INDEX NAMING.BAS 'DESCRIPTION: This macro can be used to apply naming conventions to ' all types of indexes. It provides an option to use the selected ' tables or all tables. ' The prefix and suffix variables can be used to add company ' specific conventions to the beginning and/or end of the target ' name. ' The target name can be either the existing name, table name, ' tablespace name or database name. The tablespace and database ' can only be used for applicable platforms such as Oracle or ' DB2. ' Truncate parameters can also be specified to remove the first N ' characters or the last N characters of the target name. Another ' parameter can also be used to limit the total number of characters ' in the target name. These are applied before the prefix and ' suffix are added. 'ER/Studio variables Dim mdl As Model Dim diag As Diagram Dim indx As Index Dim ent As Entity Dim submdl As SubModel Dim so As SelectedObject 'truncate variables Dim starttrunc As Integer Dim endtrunc As Integer Dim totaltrunc As Integer Dim inistarttrunc As String Dim iniendtrunc As String Dim initotaltrunc As String 'Dialog variables Dim BaseName As String Dim basenametype As Integer Dim prefix As String Dim suffix As String Dim IndexType As String Dim addincrement As Boolean Dim usetruncate As Boolean Dim looptype As Integer Dim IncrementType As Integer Dim errorstring As String Sub Main Debug.Clear Dim IndxName As String Dim i As Integer inistarttrunc = "0" iniendtrunc = "0" initotaltrunc = "ALL" Begin Dialog UserDialog 520,406,"Index Naming Convention",.dialogfunction ' %GRID:10,7,1,1 OKButton 300,364,90,28 CancelButton 410,364,90,28 Text 40,266,90,14,"Suffix",.Text1 Text 40,231,90,14,"Prefix",.Text2 GroupBox 20,63,450,49,"Index Type",.Groupbox OptionGroup .IndexChoice OptionButton 40,84,90,14,"Primary",.OptionButton2 OptionButton 140,84,90,14,"Unique",.OptionButton1 OptionButton 250,84,120,14,"Non Unique",.OptionButton3 OptionButton 380,84,60,14,"All",.OptionButton10 GroupBox 20,119,480,77,"Using",.GroupBox2 OptionGroup .NameChoice OptionButton 80,140,170,14,"Existing Name",.OptionButton9 OptionButton 80,168,160,14,"Tablespace Name",.OptionButton5 OptionButton 280,168,130,14,"Database Name",.OptionButton6 OptionButton 280,140,110,14,"Table Name",.OptionButton4 TextBox 120,224,90,21,.Prefix TextBox 120,259,90,21,.Suffix CheckBox 30,301,230,21,"Add Increment at end of name",.increment PushButton 310,238,150,28,"Truncate Parameters",.truncate OptionGroup .loopChoice OptionButton 40,14,140,14,"Selected Objects",.OptionButton7 OptionButton 40,35,100,14,"All Objects",.OptionButton8 Text 70,322,190,14,"(Duplicate Indexes on table)",.Text3 CheckBox 290,210,190,14,"Use truncate parameters",.truncparam PushButton 310,280,150,28,"Preview Names",.Preview CheckBox 20,378,260,14,"Save errors to C:\IXnameslog.txt",.errorlog OptionGroup .incrementtype OptionButton 90,343,90,14,"Numeric",.OptionButton11 OptionButton 90,357,110,14,"Alphabetical",.OptionButton12 End Dialog Dim dlg As UserDialog Set diag = DiagramManager.ActiveDiagram Set mdl = diag.ActiveModel Set submdl = mdl.ActiveSubModel If Dialog(dlg) = -1 Then basenametype = dlg.namechoice Debug.Print "basenametype: " & basenametype prefix = dlg.prefix Debug.Print "Prefix: " & prefix suffix = dlg.suffix Debug.Print "Suffix: " & suffix addincrement = dlg.increment Debug.Print "addincrement: " & addincrement usetruncate = dlg.truncparam Debug.Print "usetruncate: " & usetruncate looptype = dlg.loopchoice Debug.Print "looptype: " & looptype IncrementType = dlg.incrementtype Debug.Print "incrementtype: " & IncrementType Select Case dlg.indexchoice Case 0 IndexType = "P" Case 1 IndexType = "A" Case 2 IndexType = "I" Case 3 IndexType = "N" End Select Debug.Print "IndexType: " & IndexType If looptype = 0 Then For Each so In submdl.SelectedObjects If so.Type = 1 Then Set ent = mdl.Entities.Item(so.ID) i = 1 For Each indx In ent.Indexes If IndexType = "N" Then GoTo SKIP End If If indx.KeyType = IndexType Then SKIP: IndxName = "" Select Case basenametype Case 0 IndxName = NameIndex(indx.Name, i) Case 1 If ent.StorageLocation = "" Then errorstring = errorstring & "Tablespace field for " & ent.TableName & " is blank." & vbCrLf errorstring = errorstring & vbTab & "Index: " & ent.TableName & "." & indx.Name & " name not changed." & vbCrLf Else IndxName = NameIndex(ent.StorageLocation, i) End If Case 2 If ent.DatabaseLocation = "" Then errorstring = errorstring & "Database field for " & ent.TableName & " is blank." & vbCrLf errorstring = errorstring & vbTab & "Index: " & ent.TableName & "." & indx.Name & " name not changed." & vbCrLf Else IndxName = NameIndex(ent.DatabaseLocation, i) End If Case 3 IndxName = NameIndex(ent.TableName, i) End Select If addincrement = True Then i = i + 1 Else IndxName = IndxName End If indx.Name = IndxName End If Next End If Next Else For Each ent In mdl.Entities i = 1 For Each indx In ent.Indexes If IndexType = "N" Then GoTo SKIP1 End If If indx.KeyType = IndexType Then SKIP1: IndxName = "" Select Case basenametype Case 0 IndxName = NameIndex(indx.Name, i) Case 1 If ent.StorageLocation = "" Then errorstring = errorstring & "Tablespace field for " & ent.TableName & " is blank." & vbCrLf errorstring = errorstring & vbTab & "Index: " & ent.TableName & "." & indx.Name & " name not changed." & vbCrLf Else IndxName = NameIndex(ent.StorageLocation, i) End If Case 2 If ent.DatabaseLocation = "" Then errorstring = errorstring & "Database field for " & ent.TableName & " is blank." & vbCrLf errorstring = errorstring & vbTab & "Index: " & ent.TableName & "." & indx.Name & " name not changed." & vbCrLf Else IndxName = NameIndex(ent.DatabaseLocation, i) End If Case 3 IndxName = NameIndex(ent.TableName, i) End Select If addincrement = True Then i = i + 1 Else IndxName = IndxName End If indx.Name = IndxName End If Next Next End If If dlg.errorlog = 1 Then Open "C:\IXnameslog.txt" For Output As #1 Print #1, errorstring Close #1 End If End If End Sub Function NameIndex (bname As String, i As Integer) As String Dim IXname As String IXname = bname If usetruncate = True Then If starttrunc <> 0 And Len(IXname) > starttrunc Then IXname = Right(IXname, Len(IXname) - starttrunc) End If If endtrunc <> 0 And Len(IXname) > endtrunc Then IXname = Left(IXname, Len(IXname) - endtrunc) End If If totaltrunc <> 0 And Len(IXname) > totaltrunc Then IXname = Left(IXname, totaltrunc) End If End If If prefix <> "" Then IXname = prefix & IXname End If If addincrement = True Then If IncrementType = 0 Then IXname = IXname & i Else Dim num As Integer num = 64 + i Debug.Print num IXname = IXname & Chr(num) End If End If If suffix <> "" Then IXname = IXname & suffix End If NameIndex = IXname End Function
Rem See DialogFunc help topic for more information. Private Function dialogfunction(DlgItem$, Action%, SuppValue&) As Boolean Dim platform As String Select Case Action% Case 1 ' Dialog box initialization Case 2 ' Value changing or button pressed If DlgItem = "truncate" Then Begin Dialog UserDialog 410,245,"Truncate Options",.truncHandler ' %GRID:10,7,1,1 TextBox 280,56,90,21,.starttrunc TextBox 280,98,90,21,.endtrunc TextBox 280,140,90,21,.totaltrunc Text 50,14,290,28,"Note: These operations will be performed before the prefix and suffix are added.",.Text1 Text 20,56,240,28,"Specify number of chars to remove from START of target name.",.Text2 Text 20,98,220,28,"Specify number of chars to remove at the END of target name.",.Text3 Text 20,140,230,28,"Specify number of chars to use in target name. (total, after truncating)",.Text4 OKButton 150,203,100,28 Text 60,168,300,21,"(ALL, or number of characters starting from left)",.Text5 End Dialog Dim dlg As UserDialog 'defaults for truncate variables dlg.starttrunc = inistarttrunc dlg.endtrunc = iniendtrunc dlg.totaltrunc = initotaltrunc Dialog dlg If dlg.endtrunc = "" Then endtrunc = 0 Else endtrunc = CStr(dlg.endtrunc) End If If dlg.starttrunc = "" Then starttrunc = 0 Else starttrunc = CStr(dlg.starttrunc) End If If dlg.totaltrunc = "ALL" Or dlg.totaltrunc = "" Then totaltrunc = 0 Else totaltrunc = CStr(dlg.totaltrunc) End If dialogfunction = True ElseIf DlgItem = "Preview" Then platform = Left(mdl.DatabasePlatform, 14) If mdl.Logical = True And DlgValue("NameChoice") > 0 And DlgValue("NameChoice") < 3 Then MsgBox("Tablespace and Database Names in Using option is only for physical models.",,"Error!") dialogfunction = True ElseIf platform <> "IBM DB2 OS/390" And DlgValue("NameChoice") = 2 Then MsgBox("Database Name in Using option is only for OS390 physical models.",,"Error!") dialogfunction = True Else basenametype= DlgValue("NameChoice") prefix = DlgText("Prefix") suffix = DlgText("Suffix") addincrement = DlgValue("increment") usetruncate = DlgValue("truncparam") looptype = DlgValue("loopChoice") IncrementType = DlgValue("incrementtype") Select Case DlgValue("IndexChoice") Case 0 IndexType = "P" Case 1 IndexType = "A" Case 2 IndexType = "I" Case 3 IndexType = "N" End Select Begin Dialog UserDialog 400,273,"Index Names",.NamesHandler ' %GRID:10,7,1,1 TextBox 30,14,350,217,.IndxNames,1 OKButton 140,245,90,21 End Dialog Dim dlgNames As UserDialog Dialog dlgNames dialogfunction = True End If ElseIf DlgItem = "OK" Then platform = Left(mdl.DatabasePlatform, 14) If mdl.Logical = True And DlgValue("NameChoice") > 0 And DlgValue("NameChoice") < 3 Then MsgBox("Tablespace and Database Names in Using option is only for physical models.",,"Error!") dialogfunction = True ElseIf platform <> "IBM DB2 OS/390" And DlgValue("NameChoice") = 2 Then MsgBox("Database Name in Using option is only for OS390 physical models.",,"Error!") dialogfunction = True End If End If Rem dialogfunction = True ' Prevent button press from closing the dialog box Case 3 ' TextBox or ComboBox text changed Case 4 ' Focus changed Case 5 ' Idle Rem dialogfunction = True ' Continue getting idle actions Case 6 ' Function key End Select End Function
Rem See DialogFunc help topic for more information. Private Function NamesHandler(DlgItem$, Action%, SuppValue&) As Boolean Select Case Action% Case 1 ' Dialog box initialization Dim i As Integer If looptype = 0 Then For Each so In submdl.SelectedObjects If so.Type = 1 Then Set ent = mdl.Entities.Item(so.ID) i = 1 For Each indx In ent.Indexes If IndexType = "N" Then GoTo SKIP End If If indx.KeyType = IndexType Then SKIP: IndxName = "" Select Case basenametype Case 0 IndxName = NameIndex(indx.Name, i) Case 1 If ent.StorageLocation = "" Then errorstring = errorstring & "Tablespace field for " & ent.TableName & " is blank." & vbCrLf errorstring = errorstring & vbTab & "Index: " & ent.TableName & "." & indx.Name & " name not changed." & vbCrLf Else IndxName = NameIndex(ent.StorageLocation, i) End If Case 2 If ent.DatabaseLocation = "" Then errorstring = errorstring & "Database field for " & ent.TableName & " is blank." & vbCrLf errorstring = errorstring & vbTab & "Index: " & ent.TableName & "." & indx.Name & " name not changed." & vbCrLf Else IndxName = NameIndex(ent.DatabaseLocation , i) End If Case 3 IndxName = NameIndex(ent.TableName, i) End Select If addincrement = True Then i = i + 1 Else IndxName = IndxName End If DlgText "IndxNames", DlgText("IndxNames") & IndxName & vbCrLf End If Next End If Next Else For Each ent In mdl.Entities i = 1 For Each indx In ent.Indexes If IndexType = "N" Then GoTo SKIP2 End If If indx.KeyType = IndexType Then SKIP2: IndxName = "" Select Case basenametype Case 0 IndxName = NameIndex(indx.Name, i) Case 1 If ent.StorageLocation = "" Then errorstring = errorstring & "Tablespace field for " & ent.TableName & " is blank." & vbCrLf errorstring = errorstring & vbTab & "Index: " & ent.TableName & "." & indx.Name & " name not changed." & vbCrLf Else IndxName = NameIndex(ent.StorageLocation, i) End If Case 2 If ent.DatabaseLocation = "" Then errorstring = errorstring & "Database field for " & ent.TableName & " is blank." & vbCrLf errorstring = errorstring & vbTab & "Index: " & ent.TableName & "." & indx.Name & " name not changed." & vbCrLf Else IndxName = NameIndex(ent.DatabaseLocation, i) End If Case 3 IndxName = NameIndex(ent.TableName, i) End Select If addincrement = True Then i = i + 1 Else IndxName = IndxName End If DlgText "IndxNames", DlgText("IndxNames") & IndxName & vbCrLf End If Next Next End If Case 2 ' Value changing or button pressed Rem NamesHandler = True ' Prevent button press from closing the dialog box Case 3 ' TextBox or ComboBox text changed Case 4 ' Focus changed Case 5 ' Idle Rem NamesHandler = True ' Continue getting idle actions Case 6 ' Function key End Select End Function
Rem See DialogFunc help topic for more information. Private Function truncHandler(DlgItem$, Action%, SuppValue&) As Boolean Select Case Action% Case 1 ' Dialog box initialization 'defaults for truncate variables DlgText "starttrunc", inistarttrunc DlgText "endtrunc", iniendtrunc DlgText "totaltrunc", initotaltrunc Case 2 ' Value changing or button pressed If DlgItem = "OK" Then inistarttrunc = DlgText("starttrunc") iniendtrunc = DlgText("endtrunc") initotaltrunc = DlgText("totaltrunc") End If Rem truncHandler = True ' Prevent button press from closing the dialog box Case 3 ' TextBox or ComboBox text changed Case 4 ' Focus changed Case 5 ' Idle Rem truncHandler = True ' Continue getting idle actions Case 6 ' Function key End Select End Function