Prepare PDM model for Database Script Generation, by fixing some problems
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
Be the first to leave a comment
You must be Logged on to comment or reply to a post.