'TITLE: GENERATE PARTITIONS FOR OS390 CLUSTERED INDEXES.BAS 'DESCRIPTION: This macro provides and interface to add multiple ' partitions to clustered indexes. A list of tables is provided. ' Selecting a table will load the clustered indexes to be partitioned. ' The storage parameters are uniform across partitions. 'dim ER/Studio variables Dim diag As Diagram Dim mdl As Model Dim ent As Entity Dim indx As Index Dim indxpart As DB2IdxPartition Dim indxcol As IndexColumn Dim sto As DB2StoGroup 'dim array variables Dim tables () As String Dim clusteredindexes () As String Dim indexedcolumns () As String Dim stogroups () As String Dim blank() As String Dim tableindx As Integer Dim indexindx As Integer Dim indexselected As Boolean 'partition variables Dim NumberInc As Integer Dim NumberStart As Integer Dim NumberEnd As Integer Dim location As String Dim locationopt As Integer Dim gbpcacheopt As Integer Dim priqty_val As Integer Dim secqty_val As Integer Dim freepage_val As Integer Dim pctfree_val As Integer Dim gbpcache_val As Integer Function GetTables ReDim tables ( 0 To mdl.Entities.Count - 1) As String i = 0 For Each ent In mdl.Entities tables(i) = ent.TableName i = i + 1 Next dhQuickSort(tables()) End Function Function GetClusteredIndexes ( tblname As String ) Set ent = mdl.Entities.Item(tblname) Dim indxcount As Integer For Each indx In ent.Indexes If indx.Clustered = True Then count = count + 1 End If Next If count > 0 Then ReDim clusteredindexes (0 To count - 1) As String i = 0 For Each indx In ent.Indexes If indx.Clustered = True Then clusteredindexes(i) = indx.Name i = i + 1 End If Next Else ReDim clusteredindexes(0) clusteredindexes(0) = "NO CLUSTERED INDEXES" End If End Function Function GetIndexedColumns ( tblname As String, indxname As String ) Set ent = mdl.Entities.Item(tblname) Set indx = ent.Indexes.Item(indxname) If indxname <> "NO CLUSTERED INDEXES" Then ReDim indexedcolumns(0 To indx.IndexColumns.Count - 1) j = 0 For i = 1 To indx.IndexColumns.Count For Each indxcol In indx.IndexColumns If indxcol.SequenceNo = i Then indexedcolumns(j) = indxcol.ColumnName j = j + 1 End If Next Next End If End Function Function getstogroups If mdl.DB2StoGroups.Count > 0 Then ReDim stogroups (0 To mdl.DB2StoGroups.Count - 1) For Each sto In mdl.DB2StoGroups stogroups(i) = sto.Name Next End If End Function Function generatepartition ( tblname As String, indxname As String ) Set ent = mdl.Entities.Item(tblname) Set indx = ent.Indexes.Item(indxname) For i = 1 To 254 indx.DB2IdxPartitions.Remove(i) Next For i = NumberStart To NumberEnd Step NumberInc Set indxpart = indx.DB2IdxPartitions.Add(i,CStr(i)) indxpart.FreePage = freepage_val indxpart.PctFree = pctfree_val indxpart.PriQty = priqty_val indxpart.SecQty = secqty_val If locationopt = 0 Then indxpart.IsStoGroup = False indxpart.StorageLocation = location Else indxpart.IsStoGroup = True indxpart.StorageLocation = location End If Debug.Print gbpcache_val Select Case gbpcache_val Case 0 indxpart.GBPCache = "CHANGE" Case 1 indxpart.GBPCache = "ALL" Case 2 indxpart.GBPCache = "NONE" End Select Next End Function Sub Main Dim dbplat As String Debug.Clear Set diag = DiagramManager.ActiveDiagram Set mdl = diag.ActiveModel Debug.Print mdl.DatabasePlatform Debug.Print dbplat If mdl.MajorPlatform = "IBM DB2" Then GetTables GetClusteredIndexes(tables(0)) GetIndexedColumns(tables(0),clusteredindexes(0)) getstogroups ReDim blank (0) As String blank(0) = "" Begin Dialog UserDialog 820,371,"Partition Options",.partitionHandler ' %GRID:10,7,1,1 ListBox 40,28,200,112,tables(),.tablelist Text 20,7,60,14,"Tables:",.Text1 DropListBox 310,28,250,91,clusteredindexes(),.indexlist ListBox 310,77,250,70,indexedcolumns(),.columnlist Text 300,7,160,14,"Clustered Indexes:",.Text2 Text 300,56,140,14,"Indexed Columns:",.Text3 PushButton 520,329,100,28,"Apply",.apply PushButton 650,329,100,28,"Close",.CloseDialog GroupBox 270,154,530,154,"Storage Options",.GroupBox1 GroupBox 20,154,220,154,"Partition Options",.GroupBox2 OptionGroup .locationoption OptionButton 290,189,90,14,"VCAT",.Vcat OptionButton 290,217,130,14,"STOGROUP",.StoGroup DropListBox 420,217,120,70,stogroups(),.Stogrouplist,1 TextBox 420,182,120,21,.Vcattxt Text 340,252,60,14,"PRIQTY",.textbox1 Text 340,280,70,14,"SECQTY",.textbox2 TextBox 420,245,90,21,.PriQty TextBox 420,273,90,21,.SecQty Text 40,189,90,14,"Start Value",.Text4 Text 40,224,90,14,"End Value",.Text5 Text 40,259,90,14,"Increment",.Text6 TextBox 130,182,90,21,.startvalue TextBox 130,217,90,21,.endvalue TextBox 130,252,90,21,.Increment Text 580,182,90,14,"Percent free",.Text7 Text 580,217,90,14,"Free Page",.Text8 TextBox 680,175,90,21,.PercentFree TextBox 680,210,90,21,.FreePage OptionGroup .gbpoption OptionButton 670,245,90,14,"Changed",.OptionButton1 OptionButton 670,266,90,14,"All",.OptionButton2 OptionButton 670,287,90,14,"None",.OptionButton3 Text 580,259,80,14,"GBP Cache",.Text9 End Dialog Dim dlg As UserDialog Dialog dlg, -2 Else MsgBox("The active model must be a DB2 OS/390 model.",,"ERROR!") End If End Sub
Rem See DialogFunc help topic for more information. Private Function partitionHandler(DlgItem$, Action%, SuppValue&) As Boolean Select Case Action% Case 1 ' Dialog box initialization 'initialize dialog defaults DlgText "Stogrouplist", "DTA1" DlgEnable "vcattxt",False DlgValue "locationoption", 1 DlgText "PriQty", "720" DlgText "SecQty", "720" DlgText "PercentFree", "10" DlgText "FreePage", "31" DlgText "startvalue", "1" DlgText "endvalue", "254" DlgText "increment", "1" indexselected = True Case 2 ' Value changing or button pressed Select Case DlgItem Case "locationoption" If DlgValue("locationoption") = 0 Then DlgEnable "vcattxt",True DlgEnable "Stogrouplist",False DlgEnable "PriQty",False DlgEnable "SecQty",False Else DlgEnable "vcattxt",False DlgEnable "Stogrouplist",True DlgEnable "PriQty",True DlgEnable "SecQty",True End If Case "tablelist" GetClusteredIndexes(tables(SuppValue)) GetIndexedColumns(tables(SuppValue), clusteredindexes(0)) DlgListBoxArray "indexlist",clusteredindexes() DlgListBoxArray "columnlist",blank() tableindx = SuppValue indexselected = False partitionHandler = True Case "indexlist" GetIndexedColumns(tables(tableindx), clusteredindexes(SuppValue)) DlgListBoxArray "columnlist",indexedcolumns() indexindx = SuppValue indexselected = True partitionHandler = True Case "columnlist" partitionHandler = True Case "apply" If clusteredindexes(indexindx) = "NO CLUSTERED INDEXES" Then MsgBox("NO CLUSTERED INDEX ON SELECTED TABLE.",,"ERROR!") partitionHandler = True Else If indexselected = False Then MsgBox("Please Select an Index.",,"ERROR!") partitionHandler = True Else NumberStart = CLng(DlgText("startvalue")) NumberEnd = CLng(DlgText("endvalue")) NumberInc = CLng(DlgText("Increment")) If DlgValue("locationoption") = 0 Then location = DlgText("vcattxt") locationopt = DlgValue("locationoption") Else location = DlgText("stogrouplist") locationopt = DlgValue("locationoption") End If gbpcache_val = DlgValue("gbpoption") If IsNumeric(DlgText("PriQty")) Then priqty_val = CLng(DlgText("PriQty")) End If If IsNumeric(DlgText("SecQty")) Then secqty_val = CLng(DlgText("SecQty")) End If If IsNumeric(DlgText("FreePage")) Then freepage_val = CLng(DlgText("FreePage")) End If If IsNumeric(DlgText("PercentFree")) Then pctfree_val = CLng(DlgText("PercentFree")) End If generatepartition(tables(tableindx), clusteredindexes(indexindx)) partitionHandler = True End If End If End Select Rem partitionHandler = True ' Prevent button press from closing the dialog box Case 3 ' TextBox or ComboBox text changed Case 4 ' Focus changed Case 5 ' Idle Rem partitionHandler = True ' Continue getting idle actions Case 6 ' Function key End Select End Function ' From "VBA Developer's Handbook" ' by Ken Getz and Mike Gilbert ' Copyright 1997; Sybex, Inc. All rights reserved. ' Quicksort for simple data types. ' Indicate that a parameter is missing. Const dhcMissing = -2 Sub dhQuickSort(varArray As Variant, _ Optional intLeft As Integer As Integer ' From "VBA Developer's Handbook" ' by Ken Getz and Mike Gilbert ' Copyright 1997; Sybex, Inc. All rights reserved. ' Entry point for sorting the array. ' This technique uses the recursive Quicksort ' algorithm to perform its sort. ' In: ' varArray: ' A variant pointing to an array to be sorted. ' This had better actually be an array, or the ' code will fail, miserably. You could add ' a test for this: ' If Not IsArray(varArray) Then Exit Sub ' but hey, that would slow this down, and it's ' only YOU calling this procedure. ' Make sure it's an array. It's your problem. ' intLeft: ' intRight: ' Lower and upper bounds of the array to be sorted. ' If you don't supply these values (and normally, you won't) ' the code uses the LBound and UBound functions ' to get the information. In recursive calls ' to the sort, the caller will pass this information in. ' To allow for passing integers around (instead of ' larger, slower variants), the code uses -2 to indicate ' that you've not passed a value. This means that you won't ' be able to use this mechanism to sort arrays with negative ' indexes, unless you modify this code. ' Out: ' The data in varArray will be sorted. Dim i As Integer Dim j As Integer Dim varTestVal As Variant Dim intMid As Integer If intLeft = dhcMissing Then intLeft = LBound(varArray) If intRight = dhcMissing Then intRight = UBound(varArray) If intLeft < intRight Then intMid = (intLeft + intRight) \ 2 varTestVal = UCase(varArray(intMid)) i = intLeft j = intRight Do Do While UCase(varArray(i)) < varTestVal i = i + 1 Loop Do While UCase(varArray(j)) > varTestVal j = j - 1 Loop If i <= j Then SwapElements varArray, i, j i = i + 1 j = j - 1 End If Loop Until i > j ' To optimize the sort, always sort the ' smallest segment first. If j <= intMid Then Call dhQuickSort(varArray, intLeft, j) Call dhQuickSort(varArray, i, intRight) Else Call dhQuickSort(varArray, i, intRight) Call dhQuickSort(varArray, intLeft, j) End If End If End Sub
Private Sub SwapElements(varItems As Variant, intItem1 As Integer, intItem2 As Integer) Dim varTemp As Variant varTemp = varItems(intItem2) varItems(intItem2) = varItems(intItem1) varItems(intItem1) = varTemp End Sub