Attribute VB_Name = "udfUse"
'----------------------------------------------------------------------------
'
' (c) Copyright IBM Corp. 2007 All rights reserved.
'
' The following sample of source code ("Sample") is owned by International
' Business Machines Corporation or one of its subsidiaries ("IBM") and is
' copyrighted and licensed, not sold. You may use, copy, modify, and
' distribute the Sample in any form without payment to IBM, for the purpose of
' assisting you in the development of your applications.
'
' The Sample code is provided to you on an "AS IS" basis, without warranty of
' any kind. IBM HEREBY EXPRESSLY DISCLAIMS ALL WARRANTIES, EITHER EXPRESS OR
' IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
' MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. Some jurisdictions do
' not allow for the exclusion or limitation of implied warranties, so the above
' limitations or exclusions may not apply to you. IBM shall not be liable for
' any damages you suffer as a result of using, copying, modifying or
' distributing the Sample, even if IBM has been advised of the possibility of
' such damages.
'----------------------------------------------------------------------------
'
' SOURCE FILE NAME: udfUse.bas
'
' SAMPLE: How to work with user defined types and user defined functions
'
' This module calls the user defined functions in C or CLI.
'
' Before running this sample, you must create the user defined
' functions in the udfsrv sample library provided with CLI or
' C samples. To create the udfsrv.lib, follow the directions
' in the README file for the CLI or C samples.
'
' USER DEFINED FUNCTIONS IN C/CLI:
' ScalarUDF()
' ClobScalarUDF()
' ScUDFReturningErr()
' ScratchpadScUDF()
' TableUDF()
'
' FORMS USED:
' frmMain (Demo.frm)
'
'----------------------------------------------------------------------------
'
' For more information on the sample programs, see the README file.
'
' For information on building ADO applications with Visual Basic,
' see the Developing ADO.NET and OLE DB Applications book.
'
' For information on using SQL statements, see the SQL Reference.
'
' For the latest information on programming, compiling, and running DB2
' applications, visit the DB2 Information Center:
' http://publib.boulder.ibm.com/infocenter/db2luw/v9r7/index.jsp
'----------------------------------------------------------------------------
Option Explicit
'This procedure catalogs an user defined function ScalarUDF, scalar
'UDF, and shows an example in using the UDF.
Public Function CallUDFScalarUDF(strMsg As String, _
con As ADODB.Connection) _
As ADODB.Recordset
'declare variables
Dim strSQL As String
Dim strMsgText As String
'catalog the UDF
strSQL = "CREATE FUNCTION ScalarUDF(CHAR(5), DOUBLE) " & vbCrLf & _
" RETURNS DOUBLE " & vbCrLf & _
" EXTERNAL NAME 'udfsrv!ScalarUDF' " & vbCrLf & _
" FENCED " & vbCrLf & _
" CALLED ON NULL INPUT " & vbCrLf & _
" NOT VARIANT " & vbCrLf & _
" NO SQL " & vbCrLf & _
" PARAMETER STYLE DB2SQL " & vbCrLf & _
" LANGUAGE C " & vbCrLf & _
" NO EXTERNAL ACTION"
strMsg = strSQL
ExecuteSQLCommand strSQL, strMsgText, con
strMsg = strMsg & vbCrLf & strMsgText
'use the UDF and return the results
strSQL = _
"SELECT name, job, salary, ScalarUDF(job, salary) AS udf" & vbCrLf & _
" FROM staff " & vbCrLf & _
" WHERE name LIKE 'S%'"
strMsg = strMsg & vbCrLf & vbCrLf & strSQL
Set CallUDFScalarUDF = ExecuteSQLCommand(strSQL, strMsgText, con)
strMsg = strMsg & vbCrLf & strMsgText
'drop the existing selected UDF
strSQL = "DROP FUNCTION ScalarUDF"
strMsg = strMsg & vbCrLf & vbCrLf & strSQL
ExecuteSQLCommand strSQL, strMsgText, con
strMsg = strMsg & vbCrLf & strMsgText
End Function
'This procedure catalogs an user defined function ClobScalarUDF, CLOB
'scalar UDF, and shows an example in using the UDF.
Public Function CallUDFClobScalarUDF(strMsg As String, _
con As ADODB.Connection) _
As ADODB.Recordset
'declare variables
Dim strSQL As String
Dim strMsgText As String
'catalog the UDF
strSQL = "CREATE FUNCTION ClobScalarUDF(CLOB(5K)) " & vbCrLf & _
" RETURNS INTEGER " & vbCrLf & _
" EXTERNAL NAME 'udfsrv!ClobScalarUDF' " & vbCrLf & _
" FENCED " & vbCrLf & _
" NOT VARIANT " & vbCrLf & _
" NO SQL " & vbCrLf & _
" PARAMETER STYLE DB2SQL " & vbCrLf & _
" LANGUAGE C " & vbCrLf & _
" NO EXTERNAL ACTION"
strMsg = strSQL
ExecuteSQLCommand strSQL, strMsgText, con
strMsg = strMsg & vbCrLf & strMsgText
'use the UDF and return the results
strSQL = _
"SELECT empno, resume_format, ClobScalarUDF(resume) " & vbCrLf & _
" FROM emp_resume " & vbCrLf & _
" WHERE resume_format = 'ascii'"
strMsg = strMsg & vbCrLf & vbCrLf & strSQL
Set CallUDFClobScalarUDF = ExecuteSQLCommand(strSQL, strMsgText, con)
strMsg = strMsg & vbCrLf & strMsgText
'drop the existing selected UDF
strSQL = "DROP FUNCTION ClobScalarUDF"
strMsg = strMsg & vbCrLf & vbCrLf & strSQL
ExecuteSQLCommand strSQL, strMsgText, con
strMsg = strMsg & vbCrLf & strMsgText
End Function
'This procedure catalogs an user defined function ScratchpadScUDF,
'scratchpad scalar UDF, and shows an example in using the UDF.
Public Function CallUDFScratchpadScUDF(strMsg As String, _
con As ADODB.Connection) _
As ADODB.Recordset
'declare variables
Dim strSQL As String
Dim strMsgText As String
'catalog the UDF
strSQL = "CREATE FUNCTION ScratchpadScUDF() " & vbCrLf & _
" RETURNS INTEGER " & vbCrLf & _
" EXTERNAL NAME 'udfsrv!ScratchpadScUDF' " & vbCrLf & _
" FENCED " & vbCrLf & _
" SCRATCHPAD 10 " & vbCrLf & _
" FINAL CALL " & vbCrLf & _
" VARIANT " & vbCrLf & _
" NO SQL " & vbCrLf & _
" PARAMETER STYLE DB2SQL " & vbCrLf & _
" LANGUAGE C " & vbCrLf & _
" NO EXTERNAL ACTION"
strMsg = strSQL
ExecuteSQLCommand strSQL, strMsgText, con
strMsg = strMsg & vbCrLf & strMsgText
'use the UDF and return the results
strSQL = "SELECT ScratchpadScUDF(), name, job " & vbCrLf & _
" FROM staff " & vbCrLf & _
" WHERE name LIKE 'S%'"
strMsg = strMsg & vbCrLf & vbCrLf & strSQL
Set CallUDFScratchpadScUDF = ExecuteSQLCommand(strSQL, strMsgText, con)
strMsg = strMsg & vbCrLf & strMsgText
'drop the existing selected UDF
strSQL = "DROP FUNCTION ScratchpadScUDF"
strMsg = strMsg & vbCrLf & vbCrLf & strSQL
ExecuteSQLCommand strSQL, strMsgText, con
strMsg = strMsg & vbCrLf & strMsgText
End Function
'This procedure catalogs an user defined function ScUDFReturningErr,
'scalar UDF that returns error, and shows an example in using the UDF.
Public Function CallUDFScUDFReturningErr(strMsg As String, _
con As ADODB.Connection) _
As ADODB.Recordset
'declare variables
Dim strSQL As String
Dim strMsgText As String
'catalog the UDF
strSQL = _
"CREATE FUNCTION ScUDFReturningErr(DOUBLE, DOUBLE) " & vbCrLf & _
" RETURNS DOUBLE " & vbCrLf & _
" EXTERNAL NAME 'udfsrv!ScUDFReturningErr' " & vbCrLf & _
" FENCED " & vbCrLf & _
" NOT VARIANT " & vbCrLf & _
" NO SQL " & vbCrLf & _
" PARAMETER STYLE DB2SQL" & vbCrLf & _
" LANGUAGE C " & vbCrLf & _
" NO EXTERNAL ACTION"
strMsg = strSQL
ExecuteSQLCommand strSQL, strMsgText, con
strMsg = strMsg & vbCrLf & strMsgText
'use the UDF and return the results
strSQL = _
"SELECT name, job, ScUDFReturningErr(salary, 0.00) " & vbCrLf & _
" FROM staff " & vbCrLf & _
" WHERE name LIKE 'S%'"
strMsg = strMsg & vbCrLf & vbCrLf & strSQL
Set CallUDFScUDFReturningErr = _
ExecuteSQLCommand(strSQL, strMsgText, con)
strMsg = strMsg & vbCrLf & strMsgText
'drop the existing selected UDF
strSQL = "DROP FUNCTION ScUDFReturningErr"
strMsg = strMsg & vbCrLf & vbCrLf & strSQL
ExecuteSQLCommand strSQL, strMsgText, con
strMsg = strMsg & vbCrLf & strMsgText
End Function
'This procedure catalogs an user defined type, a sourced column function,
'a new table, and shows an example in using the UDF with the new table.
Public Function CallUDFSourcedColUDF(strMsg As String, _
con As ADODB.Connection) _
As ADODB.Recordset
'declare variables
Dim strSQL As String
Dim strMsgText As String
'catalog the UDF
strSQL = "CREATE DISTINCT TYPE CNUM AS INTEGER WITH COMPARISONS"
strMsg = strSQL
ExecuteSQLCommand strSQL, strMsgText, con
strMsg = strMsg & vbCrLf & strMsgText
strSQL = _
"CREATE FUNCTION MAX(CNUM) " & vbCrLf & _
" RETURNS CNUM source sysibm.max(integer)"
strMsg = strMsg & vbCrLf & vbCrLf & strSQL
ExecuteSQLCommand strSQL, strMsgText, con
strMsg = strMsg & vbCrLf & strMsgText
strSQL = _
"CREATE TABLE CUSTOMER(CustNum CNUM NOT NULL, " & vbCrLf & _
" CustName CHAR(30) NOT NULL)"
strMsg = strMsg & vbCrLf & vbCrLf & strSQL
ExecuteSQLCommand strSQL, strMsgText, con
strMsg = strMsg & vbCrLf & strMsgText
strSQL = _
"INSERT INTO CUSTOMER " & vbCrLf & _
" VALUES(CAST(1 AS CNUM), 'JOHN WALKER'), " & vbCrLf & _
" (CAST(2 AS CNUM), 'BRUCE ADAMSON'), " & vbCrLf & _
" (CAST(3 AS CNUM), 'SALLY KWAN')"
strMsg = strMsg & vbCrLf & vbCrLf & strSQL
ExecuteSQLCommand strSQL, strMsgText, con
strMsg = strMsg & vbCrLf & strMsgText
'use the UDF and return the results
strSQL = "SELECT CAST(MAX(CustNum) AS INTEGER) FROM customer"
strMsg = strMsg & vbCrLf & vbCrLf & strSQL
Set CallUDFSourcedColUDF = ExecuteSQLCommand(strSQL, strMsgText, con)
strMsg = strMsg & vbCrLf & strMsgText
'drop the existing selected UDF
strSQL = "DROP TABLE CUSTOMER"
strMsg = strMsg & vbCrLf & vbCrLf & strSQL
ExecuteSQLCommand strSQL, strMsgText, con
strMsg = strMsg & vbCrLf & strMsgText
strSQL = "DROP FUNCTION MAX(CNUM)"
strMsg = strMsg & vbCrLf & vbCrLf & strSQL
ExecuteSQLCommand strSQL, strMsgText, con
strMsg = strMsg & vbCrLf & strMsgText
strSQL = "DROP DISTINCT TYPE CNUM"
strMsg = strMsg & vbCrLf & vbCrLf & strSQL
ExecuteSQLCommand strSQL, strMsgText, con
strMsg = strMsg & vbCrLf & strMsgText
End Function
'This procedure catalogs an user defined function TableUDF
'and shows an example in using the UDF.
Public Function CallUDFTableUDF(strMsg As String, _
con As ADODB.Connection) _
As ADODB.Recordset
'declare variables
Dim strSQL As String
Dim strMsgText As String
'catalog the UDF
strSQL = "CREATE FUNCTION TableUDF(DOUBLE) " & vbCrLf & _
" RETURNS TABLE(name VARCHAR(20), " & vbCrLf & _
" job VARCHAR(20), " & vbCrLf & _
" salary DOUBLE) " & vbCrLf & _
" EXTERNAL NAME 'udfsrv!TableUDF' " & vbCrLf & _
" LANGUAGE C " & vbCrLf & _
" PARAMETER STYLE DB2SQL " & vbCrLf & _
" NOT DETERMINISTIC " & vbCrLf & _
" FENCED " & vbCrLf & _
" NO SQL " & vbCrLf & _
" NO EXTERNAL ACTION " & vbCrLf & _
" SCRATCHPAD 10 " & vbCrLf & _
" FINAL CALL " & vbCrLf & _
" DISALLOW PARALLEL " & vbCrLf & _
" NO DBINFO "
strMsg = strSQL
ExecuteSQLCommand strSQL, strMsgText, con
strMsg = strMsg & vbCrLf & strMsgText
'use the UDF and return the results
strSQL = _
"SELECT udfTable.name, udfTable.job, udfTable.salary " & vbCrLf & _
" FROM TABLE(TableUDF(1.5)) AS udfTable"
strMsg = strMsg & vbCrLf & vbCrLf & strSQL
Set CallUDFTableUDF = ExecuteSQLCommand(strSQL, strMsgText, con)
strMsg = strMsg & vbCrLf & strMsgText
'drop the existing selected UDF
strSQL = "DROP FUNCTION TableUDF"
strMsg = strMsg & vbCrLf & vbCrLf & strSQL
ExecuteSQLCommand strSQL, strMsgText, con
strMsg = strMsg & vbCrLf & strMsgText
End Function