Prepare PDM model for Database Script Generation, by fixing some problems

[Former Member]

Each time, I had several problems when generating the database creation script, so i created the following script to handle these issues.

which are mainly

• Collect and show the reference names that are longer than 128 characters, so we can shorten them.
• Stop the update and delete constrains for cyclic references, that start with: zRecursive, zRelDependent, zRelTwo, zzOptional, zRecyclec
• Stop generating the trigers.

'******************************************************************************

'* File:     __PDM_Before_Generation.vbs

'* Purpose:  Prepare PDM model for Database Script Generation, by doing the following:

'*           Collect and show the reference names that are longer than 128 characters, so we can shorten them.

'*           Stop the update and delete constrains for cyclic references, that start with: zRecursive, zRelDependent, zRelTwo, zzOptional, zRecyclec

'*           Stop generating the trigers

'* Title:   

'* Category:

'* Developer: Hussain Naji Al-Safafeer

'* Version:  1.0

'* Company:  Deve

'******************************************************************************

' This will collect the reference names that are longer than 128 characters, so we can shorten them.

' Will stop the update and delete constrains

' This will stop generating the trigers

Option Explicit

'-----------------------------------------------------------------------------

' Main function

'-----------------------------------------------------------------------------

' Get the current active model

Dim mdl

Dim Fldr

Dim RQ

Dim isFound

Dim strLongReferenceNames

dim iCountChanged, iCountNotChanged, iCountEntities

dim iAllTables

dim iAllIndex

dim glob_IndexFound

dim glob_iIndex_Removed

Set mdl = ActiveModel

call mainProcedure

sub mainProcedure()

   If (mdl Is Nothing) Then

      MsgBox "There is no Active Model"

      exit sub

   End If

   If Not mdl.IsKindOf(PdPDM.cls_Model) Then

      MsgBox "This is not PDM"

      exit sub

   end if

  

   Set Fldr = ActiveDiagram.Parent

   RQ = MsgBox ("Starting at Folder: " & Fldr.Name & " Is Run ?", vbYesNo + vbInformation,"Confirmation")

   if RQ= VbNo then

      exit sub

   end if

  

   '------------------------------------

   iCountChanged = 0

   iCountEntities = 0

   iCountNotChanged = 0

  

   FixReferences mdl

   output  "_____Reference Cardinality changed = " & iCountChanged & " in " & iCountEntities & " Entities. and not changed = " &  iCountNotChanged

  

   '------------------------------------

   iCountChanged = 0

   iCountEntities = 0

   iCountNotChanged = 0

   strLongReferenceNames = ""

  

   start_Reference_CheckName mdl

   output "_____Reference Longer than 128, found = " & iCountChanged & " in " & iCountEntities & " Entities. and not changed = " &  iCountNotChanged

   if strLongReferenceNames <> "" then

      output "References that are longer than 128 chars:"

      output "-------------------------------------------"

      output strLongReferenceNames

   End if

  

   '------------------------------------

   iCountChanged = 0

   iCountEntities = 0

   iCountNotChanged = 0

  

   start_StopGeneratingTrigers mdl

  

   output  "_____CLR Trigger, Deleted = " & iCountChanged & " in " & iCountEntities & " Entities. and not changed = " &  iCountNotChanged

  

 

End Sub

'References that start with:

' zRecursive

' zRelDependent

' zRelTwo

' zzOptional

' zRecyclec

' Will stop the update and delete constrains

Sub FixReferences(package)

   Dim ref

   For Each ref In package.References

      If IsObject(ref) Then

         If ref.IsShortcut = false Then

            iCountEntities = iCountEntities + 1

           

            If InStr(ref.Code, "zRecursive") >= 1 or InStr(ref.Code, "zRelDependent") >= 1 or InStr(ref.Code, "zRelTwo") >= 1 or InStr(ref.Code, "zzOptional") >= 1 or InStr(ref.Code, "zRecyclec") >= 1 Then

                isFound = false

                If ref.UpdateConstraint <> 0 Then

                    ref.UpdateConstraint = 0

                    isFound = true

                End If

                If ref.DeleteConstraint <> 0 Then

                    ref.DeleteConstraint = 0

                    isFound = true

                End If

               

                if isFound then iCountChanged = iCountChanged + 1

            else

               iCountNotChanged = iCountNotChanged + 1

            End If

           

         End If

      End If

   Next

  

   ' recurse all subpackages

   Dim subpackage

   For Each subpackage in package.Packages

      If Not subpackage.IsShortcut Then

         FixReferences subpackage

      End If

   Next

End Sub

'This will collect the reference names that are longer than 128 characters

Sub start_Reference_CheckName(package)

  Dim ref

  For Each ref In package.References

      If ref.IsShortcut = false Then

         iCountEntities = iCountEntities + 1

         If len(ref.Code) >= 128 Then

               iCountChanged = iCountChanged + 1

               strLongReferenceNames = strLongReferenceNames & vbCrLf & ref.Code

         else

               iCountNotChanged = iCountNotChanged + 1

         End If

      End If

  Next

  Dim subpackage

  For Each subpackage In package.Packages

      If Not subpackage.IsShortcut Then

          start_Reference_CheckName(subpackage)

      End If

  Next

End Sub

'This will stop generating the trigers

Sub start_StopGeneratingTrigers(package)

  dim oTable

  dim trig

  For Each oTable In package.Tables

      if oTable.IsShortcut = false then

     

         For Each trig In oTable.Triggers

            If trig.IsShortcut = false Then

                iCountEntities = iCountEntities + 1

                If InStr(trig.Code, "CLR Trigger_") >= 1 Then

                     iCountChanged = iCountChanged + 1

                     oTable.Triggers.Remove(trig)

                else

                     iCountNotChanged = iCountNotChanged + 1

                     trig.Generated = False

                End If

             End If

         Next

      End If

  Next

  Dim subpackage

  For Each subpackage In package.Packages

      If Not subpackage.IsShortcut Then

          start_StopGeneratingTrigers(subpackage)

      End If

  Next

End Sub

'-----------------------------------------------------------

 Function getTableColumn( tbl_,  name_)' As PdPDM.BaseColumn

     dim col

     For Each col In tbl_.Columns

    

         If col.Code = name_ Then

             set getTableColumn = col

             exit Function

         End If

     Next

     set getTableColumn =  Nothing

 End Function