Skip to Content

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
To report this post you need to login first.

Be the first to leave a comment

You must be Logged on to comment or reply to a post.

Leave a Reply