How to create a Trigger and assign a TriggerTemplate using PowerDesigner VBScript? - vbscript

I'm using PowerDesigner v16 and I created an Extension; in this Extension a MetaClass of the Table type was added; in this MetaClass an Event Handler was created, using VBScript, to go through all the tables and create some fields / columns (attributes) default in all tables.
But now I want to take advantage of that I'm going through all the tables and also through VBScript to create a standard Trigger that is in TriggerTemplate, and I don´t know how to do this through VBScript.
My main question is: how to create a Trigger using VBScript and assign a TriggerTemplate?
Can you provide me with an example?
Possibly related question:
PowerDesigner - Assign a TriggerTemplate to a trigger through VBScript?
Below is the function I use to go through the entire table and check if there are standard columns:
Note: This function is performed in a PowerDesigner Extencion using PDM modeling. And the path of this extension is as follows: DEFAULT COLUMNS::Profile\Table\Event Handlers\Initialize
'******************************************************************************
' Função para checar se a coluna já existe na tabela.
'******************************************************************************
function ColumnExists(tab, name)
'output "ClassName: " + tab.ClassName
'Checa se a o objeto passano no parâmetro "tab" é do tipo Table (tabela)
if tab.ClassName = "Table" then
dim col
'Passa por todas as colunas da tabela
for each col in tab.Columns
'Checa se o nome da coluna atual já existe igual ao passado por parâmetro ("name")
if col.Name = name then
'output "... já existe " + col.Name
ColumnExists = true
exit function
end if
next
end if
ColumnExists = false
end function
'******************************************************************************
' Função responsável por criar as colunas padrao de uma tabela.
'******************************************************************************
Sub DoCreateColumns(tab)
' Checa se o objeto passado no parâmetro ("tab") é do tipo "Table"
if not tab.ClassName = "Table" then exit sub
dim c
dim myColumns, column
' Executa função "DefaultColumns()" serve para criar um array com todas as colunas padrão
myColumns = DefaultColumns()
'Passa por todas as colunas salvas'
for each column in myColumns
'Checa se esta coluna é um ID
if column.Name = "ID_" then
' Adiciona o nome da tabela junto com a palavra ID
column.Name = "ID_" + tab.Name
column.Code = column.Name
end if
'Checa se a coluna ja existe
if not ColumnExists(tab, column.Name) then
set c = tab.Columns.CreateNewAt(column.Position)
c.Name = column.Name
c.Code = column.Code
c.domain = column.Domain
c.Mandatory = column.Mandatory
output "... adding column " + column.Name + " table " + tab.Name
end if
next
End Sub

I created a SAP SQL Anywhere 17 PDM with one table, saved it as a .pdm file; then added a trigger based on a template on this table, and saved the model as a new .pdm file. By comparing the files, I get some hints of the representation of triggers + templates.
Especially that the trigger template is attached to the trigger. Through a shortcut, as the template is in the DBMS while the trigger is in the model.
<o:Table Id="o9">
<a:Name>Table_1</a:Name>
<a:Code>TABLE_1</a:Code>
<c:Triggers>
<o:Trigger Id="o10">
<a:Name>Trigger_1</a:Name>
<a:Code>TRIGGER_1</a:Code>
<c:BaseTrigger.TriggerItems>
<o:Shortcut Ref="o5"/>
<o:Shortcut Ref="o6"/>
</c:BaseTrigger.TriggerItems>
<c:TriggerTemplate> <===
<o:Shortcut Ref="o4"/> <===
</c:TriggerTemplate>
</o:Trigger>
</c:Triggers>
Looking at the help file SAP PowerDesigner 16 OLE Help, I see the TriggerTemplate as a property of the BaseTrigger class, from which Trigger is derived.
Here is an example which uses that.
option explicit
' create model
dim mdl : set mdl = CreateModel(PDPdm.cls_PdmModel, "|DBMS=SAP SQL Anywhere 17")
' create table and trigger
dim tbl : set tbl = mdl.CreateObject(PDPdm.cls_Table)
dim trig : set trig = tbl.CreateObject(PDPdm.cls_Trigger)
' set trigger template
SetTemplate trig, "BeforeUpdateTrigger"
function SetTemplate(trg, typ)
SetTemplate = false
' find template
dim db : set db = trg.Model.DBMS
' in case of shared DBMS instead of embedded one
if db.IsShortcut() then set db = db.TargetObject
dim tm, found
for each tm in db.TriggerTemplates
if tm.name = typ then
set found = tm
exit for
end if
next
if IsEmpty(found) then exit function
' create shortcut alongside the table
dim fld : set fld = trg.Parent.Folder
dim short : set short = found.CreateShortcut(fld)
' assign, and initialize
set trg.TriggerTemplate = short
trg.InitFromTemplate
SetTemplate = true
end function

Related

Error when try to use "ScriptControl" from "MSScriptControl" in VbsScript

I trying to run this code:
Dim jsonString, jsonDictionary
jsonString = "{ ""name"": ""John"", ""age"": 30, ""city"": ""New York"" }"
Set jsonDictionary = JSONToDictionary(jsonString)
MsgBox(jsonDictionary.Item("name")) ' -> "John"
MsgBox(jsonDictionary.Item("age")) ' -> 30
MsgBox(jsonDictionary.Item("city")) ' -> "New York"
Function JSONToDictionary(jsonString)
' Crea un objeto de script
Set jsonObject = CreateObject("ScriptControl")
' Establece la sintaxis JSON como el lenguaje de script
jsonObject.Language = "JScript"
' Utiliza el método eval() del objeto de script para parsear la cadena JSON
Set jsonDictionary = eval("(" + jsonString + ")")
' Devuelve el objeto diccionario
JSONToDictionary = jsonDictionary
End Function
But I get the error: "The ActiveX component can't create the object: 'ScriptControl' ".
Also I get the error: "System: This operation is not supported with BTT enabled".
I've tried everything but it doesn't work, would you know how to fix it?

Compiler error: method or datamember not found vb6 (Addnew)

Private Sub Command1_Click()
Dim contador As Integer
Dim tabla As TableDef
Dim columna As Field
Dim baseDeDatos As Database
Dim directorioDB As String
Set tabla = baseDeDatos.OpenTable("Empleados")
tabla.AddNew
tabla!Legajo = Text1.Text
tabla.AddNew
tabla!Nombre = Text2.Text
If Text3.Text > 19 And Text3.Text < 51 Then
tabla.AddNew
tabla!Edad = Text3.Text
Label4.Caption = "Terminado"
Else
Label4.Caption = "Registro no cargado. Rango de edad entre 20 y 50 años"
End If
tabla.Update
If contador = 10 Then
Command1.Caption = "Cargados 10 registros"
Else
contador = contador + 1
End If
End Function
Private Sub Form_Load()
Dim tabla As TableDef
Dim columna As Field
Dim baseDeDatos As Database
Dim directorioDB As String
Set archivo = New FileSystemObject
If Not archivo.FileExists("C:\Users\tam45949\Desktop\tp2programacion2.mdb") Then
Set baseDeDatos = DBEngine.Workspaces(0).CreateDatabase("C:\Users\tam45949\Desktop\tp2programacion2.mdb", dbLangSpanish)
End If
Set baseDeDatos = OpenDatabase("C:\Users\tam45949\Desktop\tp2programacion2.mdb")
Set tabla = baseDeDatos.CreateTableDef("Empleados")
Set columna1 = tabla.CreateField("Legajo", dbInteger)
tabla.Fields.Append (columna1)
Set columna2 = tabla.CreateField("Nombre", dbText, 30)
tabla.Fields.Append (columna2)
Set columna3 = tabla.CreateField("Edad", dbInteger)
tabla.Fields.Append (columna3)
baseDeDatos.TableDefs.Append tabla
End Sub
Private Sub Form_Terminate()
tabla.Close
baseDeDatos.Close
End Sub
Link to the library list
I don't know what is the problem with the code and i searched on the net a couple of hours and i still can't find se solution. The problem should be in the Addnew function, i guess there is a missing library.
Hope you can help me, i'm new with v b 6.0. Thanks!.
Probably you don't have a correct reference to DAO (or ADO), check in project references if you are able to use Microsoft Data Object (DAO) or ADO with recordset.
The method AddNew in general is the old way to work with recordsets and common in DAO code. I believe that you can move the code to use ADO and improve your statements with update , insert and delete and not using AddNew or Edit

Removing diachritics accents from words

Please help me to change this code to accept a parameter in the command line
Function to remove accents - diachritics.
Function EliminarAcentos(texto)
Dim i, s1, s2
s1 = "ÀÁÂÃÄÅÇÈÉÊËÌÍÎÏÒÓÔÕÖÙÚÛÜàáâãäåçèéêëìíîïòóôõöùúûü"
s2 = "AAAAAACEEEEIIIIOOOOOUUUUaaaaaaceeeeiiiiooooouuuu"
If Len(texto) <> 0 Then
For i = 1 To Len(s1)
texto = Replace(texto, Mid(s1,i,1), Mid(s2,i,1))
Next
End If
EliminarAcentos = texto
End Function
I need to run the script like this:
>remove_accents Dídímênsô
Didimenso
The error you mention in your comment ("remove_acentos.vbs(1, 36) Erro de compilação do Microsoft VBScript: ')' esperado") is not caused by the code you published.
This
Option Explicit
Function EliminarAcentos(texto)
Dim i, s1, s2
s1 = "ÀÁÂÃÄÅÇÈÉÊËÌÍÎÏÒÓÔÕÖÙÚÛÜàáâãäåçèéêëìíîïòóôõöùúûü"
s2 = "AAAAAACEEEEIIIIOOOOOUUUUaaaaaaceeeeiiiiooooouuuu"
If Len(texto) <> 0 Then
For i = 1 To Len(s1)
texto = Replace(texto, Mid(s1,i,1), Mid(s2,i,1))
Next
End If
EliminarAcentos = texto
End Function
Dim texto : texto = "ÀÁÂÃÄÅÇÈÉÊËÌÍÎÏÒÓÔÕÖÙÚÛÜàáâãäåçèéêëìíîïòóôõöùúûü"
If WScript.Arguments.Count > 0 Then texto = WScript.Arguments(0)
WScript.Echo EliminarAcentos(texto)
compiles and runs successfully - to demonstrate the use of .Arguments.

Check if a string contains specific characters using VBS script

My script is doing the following point :
Retrieve all my selected folder files
Class them by date (From the recent one to the older)
Show them in a window
Here is my VBS Script (I retrieve it here):
Option Explicit
Const PathMDB = "C:\Users\C8461789\Desktop\test_script"
MsgBox TriRepertoire,,"Enumération " & PathMDB
'---lister les fichiers du répertoire ---
Function TriRepertoire()
Dim fso, fichier, fileItem
Dim i, imax, z, valeur, cible, liste
Set fso = CreateObject("Scripting.FileSystemObject")
imax = 0
'début de l'énumération
For Each fichier In fso.GetFolder(PathMDB).Files
Set fileItem = fso.GetFile(fichier)
imax = imax + 1
ReDim Preserve Tableau(2, imax)
Tableau(1, imax) = Fichier.Name
Tableau(2, imax) = FileItem.DateLastModified
'---trier les fichiers par ordre décroissant de création ---
Do
Valeur = 0
For i = 1 To imax - 1
If InStr(Tableau(1,i), "average", vbTextCompare) > 0 Then
If CDate(Tableau(2, i)) < CDate(Tableau(2, i + 1)) Then
For z = 1 To 2
Cible = Tableau(z, i)
Tableau(z, i) = Tableau(z, i + 1)
Tableau(z, i + 1) = Cible
Next
Valeur = 1
End If
End If
Next
Loop While Valeur = 1
Set fileItem = nothing
Next
'Affichage du résultat classé
For i = 1 To imax
'If IsNull(Tableau) Then
liste = liste &vbTab& Tableau(1, i) &vbCr
'End If
Next
TriRepertoire = liste
Set fso = nothing
End Function
In order to filter by name my retrieved files, I would like to add the following condition :
For each file name, if it contains "average", add the file name to the table
Else, do nothing
I tried to use
If InStr(Tableau(1,i), "average", vbTextCompare) > 0 Then
But it shows me this error :
You are using InStr incorrectly. Your code:
InStr(Tableau(1,i), "average", vbTextCompare)
The signature for InStr is:
InStr([start,]string1,string2[,compare])
But the gotcha here is that it has two optional parameters, one of them being in the front, with a special condition:
Optional. Specifies the starting position for each search. The search begins at the first character position (1) by default. This parameter is required if compare is specified
So because you are using the fourth parameter with the value vbTextCompare, you need to specify the starting point in the first parameter as well, which would be 1 (first character) in your case. So, the corrected code is:
InStr(1, Tableau(1,i), "average", vbTextCompare)
The error message you see basically complains that the first parameter is expected to be an integer, but you are feeding it a string.
See InStr docs.

name a file using a record in the database using vbs

well, i´m trying to make a visualscript which creates a file where a recordset is written in it and the name of the file is as a record of the database, to put an example, I want a query, the query is written in the file, and the name of the file is one of the rows of a table, here is my code:
Dim Filename
Dim Connection
Dim commandoSQL
Dim Archivo
Dim Nombre
Dim objFSO
Dim outputFile
Call Main
Sub Main
Set objFSO=CreateObject("Scripting.FileSystemObject")
Call startConnection() Set commandoSQL = Connection.Execute("select rest_def.obj_num, hdr_def.line_01, hdr_def.line_02, hdr_def.line_03, hdr_def.line_04, hdr_def.line_05, hdr_def.line_06, trlr_def.line_01, trlr_def.line_02, trlr_def.line_03, trlr_def.line_04, trlr_def.line_05, trlr_def.line_06, trlr_def.line_07, trlr_def.line_08, trlr_def.line_09, trlr_def.line_10, trlr_def.line_11, trlr_def.line_12 from rest_def inner join hdr_def on hdr_def.obj_num rest_def.obj_num inner join trlr_def on trlr_def.obj_num = hdr_def.obj_num where hdr_def.obj_num = 101")
'Archivo = "D:\archives\"
Set Filename = Connection.Execute("Select obj_num FROM rest_def")
Nombre = Filename.getString
Archivo = "D:\archives\" + Nombre + ".txt"
Set outputFile = objFSO.CreateTextFile(Archivo,True)
outputFile.Write commandoSQL & vbCrLf
outputFile.Close
Call closeConnection()
End Sub
Sub startConnection()
Set Connection = WScript.CreateObject("ADODB.Connection")
Connection.Open "DSN=milo; UID=dataBase; PWD=password"
End Sub
Sub closeConnection()
Connection.Close
End Sub
So if the data of Filename is 7890, I want the file to be named as 7890.txt with all the recordset written in the file... help please, this is my first attempt with vbs...
If you want to use ADODB objects in VBScript I'd recommend reading the ADO API Reference first to familiarise yourself the various objects.
In this particular case the line
Set Filename = Connection.Execute("Select obj_num FROM rest_def")
returns a ADODB.Recordset object, to access the results of the query you would use the Fields collection and either pass an ordinal position of the returned field in this case 0 or a named field which would be obj_num.
That would change this line from
Nombre = Filename.getString
to
Nombre = Filename.Fields("obj_num").Value
Also there is no such method as getString() for the ADODB.Recordset object.
Changing the Main() sub procedure to
Sub Main
Set objFSO=CreateObject("Scripting.FileSystemObject")
Call startConnection()
Set Filename = Connection.Execute("Select obj_num FROM rest_def")
'Continue to iterate through the recordset until we reach the last
'record (EOF).
Do While Not Filename.EOF
Nombre = Filename.Fields("obj_num").Value & ""
Archivo = "D:\archives\" & Nombre & ".txt"
Set outputFile = objFSO.CreateTextFile(Archivo, True)
outputFile.Write commandoSQL & vbCrLf
outputFile.Close
'Move to next record
Call Filename.MoveNext()
Loop
Call closeConnection()
End Sub
should work. It depends if you want to create a file for each record returned but from your limited explanation this is my interpretation.

Resources