Publish date: 2003-04-23
Work with InterBase triggers (VB)
'This sample demonstrates as to work with Interbase triggers
'through the ADODB from Visual Basic
'Required:
' 1. LCPI OLE DB Provider for Interbase.
' 2. LCPI IB Provider Samples ActiveX DLL
' 3. Microsoft ActiveX Data Objects 2.6
' 4. Microsoft Excel 9.0.
' 5. Employee.ibp with connection parameters to employee.gdb
Sub Sample14()
Dim con As New ADODB.Connection 'connection
'clone transaction object
Dim con_clone As New IBPSamples.TADOConnectionClone
'open connection
con.Open "file name=" & ThisWorkBook.Path & "\Db.ibp"
con.BeginTrans 'start transaction
'set connection to the clone connection object
con_clone.Connection = con
Dim cmd As New ADODB.Command 'command
Dim rs As ADODB.Recordset 'recordset
'other declares
Dim strForDebug As String
Set cmd.ActiveConnection = con 'set the active connection
'getting the list of user triggers (non system triggers and non check trigger)
cmd.CommandText = "select RDB$TRIGGER_NAME, RDB$TRIGGER_TYPE, " & Chr(13) & _
"RDB$TRIGGER_INACTIVE, RDB$RELATION_NAME " & Chr(13) & _
"from RDB$TRIGGERS" & Chr(13) & _
"where ((RDB$SYSTEM_FLAG = 0) or (RDB$SYSTEM_FLAG is NULL)) and " & Chr(13) & _
"(RDB$TRIGGER_NAME not in " & Chr(13) & _
"(select RDB$TRIGGER_NAME from RDB$CHECK_CONSTRAINTS))" & Chr(13) & _
" order by RDB$RELATION_NAME " 'order by table name where trigger is declared
'execute the command
Set rs = cmd.Execute
'**********************************************************************
'********************* list of the triggers *************************
'**********************************************************************
Do While Not rs.EOF
'table name where trigger is declared
strForDebug = "[table " & rs.Fields("rdb$RELATION_NAME").Value & "] "
'trigger type
Select Case Int(rs.Fields("rdb$TRIGGER_TYPE").Value)
Case 1
strForDebug = strForDebug & "BEFORE_INSERT"
Case 2
strForDebug = strForDebug & "AFTER_INSERT "
Case 3
strForDebug = strForDebug & "BEFORE_UPDATE"
Case 4
strForDebug = strForDebug & "AFTER_INSERT "
Case 5
strForDebug = strForDebug & "BEFORE_DELETE"
Case 6
strForDebug = strForDebug & "AFTER_DELETE "
End Select
'trigger name
strForDebug = strForDebug & " trigger " & rs.Fields("rdb$TRIGGER_NAME").Value
'check trigger activity
If rs.Fields("rdb$TRIGGER_INACTIVE").Value <> 1 Then
strForDebug = strForDebug & " is Active"
Else
strForDebug = strForDebug & " is Inactive"
End If
'list of triggers
Debug.Print strForDebug
rs.MoveNext
Loop
Debug.Print "----------------------------------------------------------"
'***************** Deactivate all user definded triggers **************
cmd.CommandText = "UPDATE RDB$TRIGGERS trg" & Chr(13) & _
"SET trg.RDB$TRIGGER_INACTIVE=1" & Chr(13) & _
"where ((RDB$SYSTEM_FLAG = 0) or (RDB$SYSTEM_FLAG is NULL)) and " & Chr(13) & _
"(RDB$TRIGGER_NAME not in " & Chr(13) & _
"(select RDB$TRIGGER_NAME from RDB$CHECK_CONSTRAINTS))"
cmd.Execute
Debug.Print "------- All user definded Triggers is Inactive ----------"
'***************** Activate all user definded triggers ****************
cmd.CommandText = "UPDATE RDB$TRIGGERS trg" & Chr(13) & _
"SET trg.RDB$TRIGGER_INACTIVE=0" & Chr(13) & _
"where ((RDB$SYSTEM_FLAG = 0) or (RDB$SYSTEM_FLAG is NULL)) and " & Chr(13) & _
"(RDB$TRIGGER_NAME not in " & Chr(13) & _
"(select RDB$TRIGGER_NAME from RDB$CHECK_CONSTRAINTS))"
cmd.Execute
Debug.Print "------- All user definded Triggers is Active ----------"
'***************** Add New Trigger *************************************
'create exception for our trigger
cmd.CommandText = "insert into rdb$exceptions (rdb$exception_name, rdb$message) " & _
"values ('IBPROVIDER_EMPL_ADD_NEW'," & _
"'You try to add new employer!!!')"
cmd.Execute
Debug.Print "------- Exeption for trigger is created ----------"
'create new trigger on table employee
cmd.CommandText = "create trigger IBPTrigger for employee " & Chr(13) & _
"active before insert position 0 " & Chr(13) & _
"as begin " & Chr(13) & _
" exception IBPROVIDER_EMPL_ADD_NEW; " & Chr(13) & _
"end "
cmd.Execute
con.CommitTrans
con.BeginTrans
Debug.Print "------- Trigger is created ----------"
'Check of the trigger in a separate transaction
Debug.Print "------- Test our trigger ----------"
Dim con_test_trigger As ADODB.Connection
Set con_test_trigger = con_clone.Clone
con_test_trigger.BeginTrans
Dim cmd_test As New ADODB.Command
Set cmd_test.ActiveConnection = con_test_trigger
cmd_test.CommandText = _
"INSERT INTO EMPLOYEE (EMP_NO,DEPT_NO,FIRST_NAME,LAST_NAME," & Chr(13) & _
"JOB_CODE,JOB_GRADE,JOB_COUNTRY,SALARY)" & Chr(13) & _
"VALUES (1,'600','Pinocio','Karlos','VP',2,'USA',105900);"
On Error Resume Next
'test our trigger
cmd_test.Execute
If Err Then
MsgBox Err.Description, vbCritical, "Interbase Exception"
con_test_trigger.RollbackTrans
Else
con_test_trigger.CommitTrans
End If
On Error GoTo 0
con_test_trigger.Close
'end of separate transaction block
Debug.Print "------- Drop our Trigger ----------"
'***************** Drop our Trigger *************************************
cmd.CommandText = "drop trigger IBPTrigger"
cmd.Execute
Debug.Print "------- Drop our exception ----------"
'delete exception for our trigger
cmd.CommandText = "delete from rdb$exceptions " & _
"where rdb$exception_name = 'IBPROVIDER_EMPL_ADD_NEW' "
cmd.Execute
'***************** Close all objects ************************************
rs.Close
con.CommitTrans
con.Close
Debug.Print "Done..."
End Sub