Selectively Update OS390 Table Storage

      'TITLE:  SELECTIVELY UPDATE OS390 TABLE STORAGE PARAMETERS.BAS
      'DESCRIPTION:  This macro provides a list of tables from the active
      '	physical model.  The tables in the right box will be updated
      '	with the specified storage parameters.  Tables can be added
      '	and removed from the updated list.
      'AUTHOR:  Jason Tiret
      'CONTACT:  http://support.embarcadero.com/
      'DATE:  3/13/2002
      'LAST UPDATE:  7/3/2003
      
      
      Dim Databases() As String
      Dim Tablespaces() As String
      
      'Global ERStudio Variables
      Dim mdl As Model
      Dim diag As Diagram
      Dim submdl As SubModel
      Dim so As SelectedObject
      Dim ent As Entity
      
      
      
      Function setupTablespaces()
      	
      	Dim i, count As Integer
      	Dim tblspc As DB2Tablespace
      
      	i = 0
      	count = mdl.DB2Tablespaces.Count - 1
      
      	If count < 0 Then
      
      		ReDim Tablespaces(0)
      
      	Else
      
      		ReDim Tablespaces(0 To count)
      
      		For Each tblspc In mdl.DB2Tablespaces
      
      			Tablespaces(i) = tblspc.Name
      			i = i + 1
      
      		Next
      
      	End If
      
      End Function
      
      Function setupDatabases()
      	
      	Dim i, count As Integer
      	Dim db As DB2Database
      
      	i = 0
      	count = mdl.DB2Databases.Count - 1
      
      	If count < 0 Then
      
      		ReDim database(0)
      
      	Else
      
      		ReDim Databases(0 To count)
      
      		For Each db In mdl.DB2Databases
      
      			Databases(i) = db.Name
      			i = i + 1
      
      		Next
      
      	End If
      
      
      End Function
      
      
      Sub Main
      
      	Debug.Clear
      
      	'set ERStudio variables
      	Set diag = DiagramManager.ActiveDiagram
      	Set mdl = diag.ActiveModel
      	Set submdl = mdl.ActiveSubModel
      
      	Dim count As Integer
      	Dim DBplatform As String
      
      	If mdl.MajorPlatform <> "IBM DB2" Then
      
      	MsgBox("Physical Model platform must be DB2 OS/390",,"Error!")
      
      	Else
      
      
      	setupTablespaces()
      	setupDatabases()
      
      
      	'Create the dialog
      	Begin Dialog UserDialog 730,308,"DB2 Storage Parameters" ' %GRID:10,7,1,1
      		GroupBox 20,14,320,98,"Location",.GroupBox3
      		Text 40,63,80,14,"Tablespace:",.Text1
      		OKButton 400,259,130,28
      		CancelButton 560,259,130,28
      		Text 40,35,80,14,"Database:",.Text2
      		DropListBox 140,28,180,112,Databases(),.Database,1
      		DropListBox 140,56,180,175,Tablespaces(),.TableSpace,1
      		CheckBox 60,126,90,14,"Encoding",.EncodingChbx
      		CheckBox 200,126,130,14,"Restrict On Drop",.restrictChbx
      		OptionGroup .EncodingOpt
      			OptionButton 100,147,90,14,"ASCII",.OptionButton1
      			OptionButton 100,168,90,14,"EBCDIC",.OptionButton2
      		GroupBox 30,189,310,49,"Logging",.GroupBox4
      		CheckBox 60,210,170,14,"Log Data Changes",.LogDataChbx
      		GroupBox 370,14,330,98,"Table Procedures",.GroupBox5
      		Text 400,42,90,14,"Edit Proc:",.Text3
      		Text 400,70,90,14,"Valid Proc:",.Text4
      		TextBox 490,42,170,21,.Editproc
      		TextBox 490,70,170,21,.ValidProc
      		GroupBox 370,133,330,105,"Audit Option",.GroupBox6
      		OptionGroup .AuditOpt
      			OptionButton 450,154,90,14,"None",.OptionButton3
      			OptionButton 450,182,90,14,"Changes",.OptionButton4
      			OptionButton 450,210,90,14,"All",.OptionButton5
      	End Dialog
      	Dim dlg As UserDialog
      
      
      	'initialize dialog, -1 is the OK button, 0 is the CANCEL
      	If Dialog(dlg,-2) = -1 Then
      
      		For Each so In submdl.SelectedObjects
      
      			If so.Type = 1 Then
      
      				Set ent = mdl.Entities.Item(so.ID)
      
      				'Update the tablespace and database location with the give tablespace name
      				If dlg.Database <> "" Then
      					ent.DatabaseLocation = dlg.Database
      				End If
      
      				If dlg.TableSpace <> "" Then
      					ent.StorageLocation = dlg.TableSpace
      				End If
      
      
      				'Update the Edit proc
      				If dlg.editproc <> "" Then
      					ent.DB2EditProc = dlg.editproc
      					Debug.Print DiagramManager.GetLastErrorString
      				End If
      
      				'Update the Valid proc
      				If dlg.validproc <> "" Then
      					ent.DB2ValidProc = dlg.validproc
      					Debug.Print DiagramManager.GetLastErrorString
      				End If
      
      				'Update the restrict option
      				If dlg.restrictchbx = 1 Then
      					ent.DB2RestrictOnDrop = True
      				Else
      					ent.DB2RestrictOnDrop = False
      				End If
      
      				'Update encoding option
      				If dlg.encodingchbx = 1 Then
      
      					'determine which type of encoding
      					If dlg.encodingopt = 0 Then
      						ent.DB2Encoding = "ASCII"
      					Else
      						ent.DB2Encoding = "EBCDIC"
      					End If
      
      				Else
      
      					ent.DB2Encoding = "NONE"
      
      				End If
      
      
      				'Update audit option
      				If dlg.auditopt = 0 Then
      					ent.DB2Auditing = "NONE"
      				ElseIf dlg.auditopt = 1 Then
      					ent.DB2Auditing = "CHANGES"
      				Else
      					ent.DB2Auditing = "ALL"
      				End If
      
      				'Update logging option
      				If dlg.logdatachbx = 1 Then
      					ent.DB2DataCaptureChg = True
      				Else
      					ent.DB2DataCaptureChg = False
      				End If
      
      
      
      			End If
      
      		Next
      
      	End If
      
      	End If
      
      
      End Sub