Reserving a new GUID in SQL Server
From Support
Introduction
There is a need to generate a GUID (globally universal ID) for use as a foreign key. If the GUID column is left off on the value list of the INSERT statement, a new GUID is generated automatically for a column with the uniqueidentifier type. However, the program needs to know what this GUID is, in order to use it in related tables. It is impractical using RPG2SQL to retrieve this last-assigned GUID.
Instead, one can generate a new GUID by using the newid() function in a SELECT statement against a single-row table. Then use that value explicitly in an INSERT into the SQL Server table.
For testing, table: Customer was created as follows:
create table Customer ( ID uniqueidentifier ROWGUIDCOL NOT NULL, First varchar (30) NOT NULL, Last varchar (30) NOT NULL )
Initial Setup
It is necessary to have a single-row table that can be used for this and other situations where a single value needs to be returned. So first, create this table, or use one that already exists. It does not matter what columns are in it - we will use a single INTEGER column.
create table singlerow (filler int not null)
Then add one row
insert into singlerow values(1)
This needs to be done only once.
Here is source for the driver command CRT1ROWTBL (Create Single-row Table), the command processor CRT1ROWTBC, and the RPGLE program CRT1ROWTBR that actually does the work:
CRT1ROWTBL
CMD PROMPT('Create Single-row Table')
PARM KWD(HOST) TYPE(*CHAR) LEN(100) DFT(*CURRENT) +
MIN(0) EXPR(*YES) CASE(*MIXED) +
PROMPT('RPG2SQL Server IP Address')
PARM KWD(SQLSERVER) TYPE(*CHAR) LEN(100) +
DFT('1.1.1.1') MIN(0) EXPR(*YES) +
CASE(*MIXED) PROMPT('SQL Server IP Address')
PARM KWD(SQLDATABSE) TYPE(*CHAR) LEN(100) +
DFT('pubs') MIN(0) EXPR(*YES) +
CASE(*MIXED) PROMPT('SQL Server Database')
PARM KWD(SQLUSER) TYPE(*CHAR) LEN(50) DFT('sa') +
MIN(0) EXPR(*YES) CASE(*MIXED) +
PROMPT('SQL Server User ID')
PARM KWD(SQLPASS) TYPE(*CHAR) LEN(50) DFT(' ') +
MIN(0) EXPR(*YES) CASE(*MIXED) +
PROMPT('SQL Server Password')
CRT1ROWTBC
PGM PARM(&IPADDR &SQLSERVER &SQLDATABSE &SQLUSER +
&SQLPASS)
DCL VAR(&IPADDR) TYPE(*CHAR) LEN(100)
DCL VAR(&SQLSERVER) TYPE(*CHAR) LEN(100)
DCL VAR(&SQLDATABSE) TYPE(*CHAR) LEN(100)
DCL VAR(&SQLUSER) TYPE(*CHAR) LEN(50)
DCL VAR(&SQLPASS) TYPE(*CHAR) LEN(50)
/********************************************************/
/* ERROR HANDLING VARIABLES */
/********************************************************/
DCL VAR(&ERRORSW) TYPE(*LGL) /* Std err */
DCL VAR(&MSGID) TYPE(*CHAR) LEN(7) /* Std err */
DCL VAR(&MSGDTA) TYPE(*CHAR) LEN(100) /* Std err */
DCL VAR(&MSGF) TYPE(*CHAR) LEN(10) /* Std err */
DCL VAR(&MSGFLIB) TYPE(*CHAR) LEN(10) /* Std err */
DCL VAR(&TXT1ST) TYPE(*CHAR) LEN(100) /* Std err */
DCL VAR(&TXT2ND) TYPE(*CHAR) LEN(100) /* Std err */
MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(STDERR1))
/***************************************************************/
/* Get current PC IP address if passed in. */
/***************************************************************/
IF COND(&IPADDR *EQ *CURRENT) THEN(DO)
RSQIP IPADDR(&IPADDR)
ENDDO
/***************************************************************/
/* Call program to write to SQL Server Table */
/***************************************************************/
CALL PGM(CRT1ROWTBR) PARM(&IPADDR &SQLSERVER +
&SQLDATABSE &SQLUSER &SQLPASS)
/*******************************************************************/
/* HANDLE ERRORS */
/*******************************************************************/
STDERR1: /* Standard error handling routine */
IF &ERRORSW SNDPGMMSG MSGID(CPF9999) +
MSGF(QCPFMSG) MSGTYPE(*ESCAPE) /* Func chk */
CHGVAR &ERRORSW '1' /* Set to fail ir error occurs */
STDERR2: RCVMSG MSGTYPE(*DIAG) MSGDTA(&MSGDTA) MSGID(&MSGID) +
MSGF(&MSGF) MSGFLIB(&MSGFLIB)
IF (&MSGID *EQ ' ') GOTO STDERR3
SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
MSGDTA(&MSGDTA) MSGTYPE(*DIAG)
GOTO STDERR2 /* Loop back for addl diagnostics */
STDERR3: RCVMSG MSGTYPE(*EXCP) MSGDTA(&MSGDTA) MSGID(&MSGID) +
MSGF(&MSGF) MSGFLIB(&MSGFLIB)
IF (&MSGID *EQ ' ') GOTO STDERR4
SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
MSGDTA(&MSGDTA) MSGTYPE(*ESCAPE)
GOTO STDERR3 /* Loop back for addl exceptions */
STDERR4: RCVMSG MSGTYPE(*INFO) MSG(&TXT1ST) SECLVL(&TXT2ND) +
MSGDTA(&MSGDTA) MSGID(&MSGID) MSGF(&MSGF) +
MSGFLIB(&MSGFLIB)
IF (&TXT1ST *EQ ' ') GOTO STDERR5
SNDPGMMSG MSG(&TXT1ST) MSGTYPE(*INFO)
GOTO STDERR4 /* Loop back for addl info msgs */
STDERR5: RCVMSG MSGTYPE(*COMP) MSG(&TXT1ST) SECLVL(&TXT2ND) +
MSGDTA(&MSGDTA) MSGID(&MSGID) MSGF(&MSGF) +
MSGFLIB(&MSGFLIB)
IF (&MSGID *EQ ' ') RETURN
SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
MSGDTA(&MSGDTA) MSGTYPE(*COMP)
GOTO STDERR5 /* Loop back for addl comp msgs */
ENDPGM
CRT1ROWTBR
H BNDDIR('RJSRPGSQL':'QC2LE') DFTACTGRP(*NO) ACTGRP(*NEW)
*********************************************************************
* Program Name: GUIDCREATR
* Purpose:
* 1) Connects to a RPG2SQL server using specified IP address.
* 2) Opens database connection to SQL Server database: 'pubs'.
* 3) Creates a New SQL Server Table: singlerow in 'pubs' database.
* 4) Inserts a single record into singlerow.
* 5) Closes ADO connection.
* 6) Closes RPGSQL server connection.
*
* Note: This sample does no error checking. In your own code you
* will need to check the return codes and last error by
* using the last error return info returned by the
* SQL_LastErrNum, SQL_LastErrMsg or SQL_LastFullErr message.
*
*********************************************************************
/COPY SOURCE,RPGSQLH
D quot S 1 INZ('''')
*-----------------------------------------------------------------------------
* Main Program Processing
*-----------------------------------------------------------------------------
C *ENTRY PLIST
C PARM IPADDR 100
C PARM SQLSERVER 100
C PARM SQLDATABSE 100
C PARM SQLUSER 50
C PARM SQLPASS 50
*-----------------------------------------------------------------------------
* Connect to RPG/SQL Server
*-----------------------------------------------------------------------------
C* ** Connect to RPG SQL Server
C Eval SQL_Socket = SQL_Connect(%TRIM(IPADDR))
C* ** Exit with Error Return - TCP Server Connect
C If SQL_Socket = -999
C Eval Rtn = -1
C Eval *INLR = *On
C Return
C Endif
*-----------------------------------------------------------------------------
* Open ADO SQL Server Database Connection
*-----------------------------------------------------------------------------
* ** Open SQL Server Connection
C Eval Rtn = SQL_DBOpenConn(SQL_Socket:
C 'Driver={SQL Server}; ' +
C 'Server=' + %TRIMR(SQLSERVER) + ';' +
C 'Database=' + %TRIMR(SQLDATABSE) + ';' +
C 'Uid=' + %TRIMR(SQLUSER) + ';' +
C 'Pwd=' + %TRIMR(SQLPASS) + ';')
C* ** Exit after Error Return
C If Rtn <> 0
C Eval *INLR = *On
C Return
C Endif
*
*-----------------------------------------------------------------------------
* Create SQL Server table: singlerow
* ** We ignore table creation errors. If the table already exists,
* we will be adding to the existing table.
*-----------------------------------------------------------------------------
C Eval Rtn = SQL_RunSQLExec(SQL_Socket:
C 'create table singlerow ' +
c '(filler int not null)')
*-----------------------------------------------------------------------------
* ** Run query to insert 1 record into SQL Server
* table: singlerow.
*-----------------------------------------------------------------------------
C Eval Rtn = SQL_RunSQLExec(SQL_Socket:
C 'insert into singlerow ' +
c 'values(1)')
*-----------------------------------------------------------------------------
* Close ADO Database Conection
*-----------------------------------------------------------------------------
C callp SQL_DBCloseConn(SQL_Socket)
*-----------------------------------------------------------------------------
C* Disconnect from RPGSQL server
*-----------------------------------------------------------------------------
C callp SQL_Disconnect(SQL_Socket)
C SETON LR
Get a new GUID
To get a GUID back to your RPG program, execute the following SELECT statement:
select newid() from singlerow
newid() will return a 38-character string value which is the new reserved GUID. Use it as a value for a column with the uniqueidentifier data type.
insert into Customer (ID, First, Last) values(NewID, 'John', 'Doe')
Here is source for the driver command INSNEWGUID (Insert New GUID in SQL Server), the command processor INSNEWUIDC, and the RPGLE program INSNEWUIDR that actually does the work:
INSNEWGUID
CMD PROMPT('Insert New GUID in SQL Server')
PARM KWD(HOST) TYPE(*CHAR) LEN(100) DFT(*CURRENT) +
MIN(0) EXPR(*YES) CASE(*MIXED) +
PROMPT('RPG2SQL Server IP Address')
PARM KWD(SQLSERVER) TYPE(*CHAR) LEN(100) +
DFT('1.1.1.1') MIN(0) EXPR(*YES) +
CASE(*MIXED) PROMPT('SQL Server IP Address')
PARM KWD(SQLDATABSE) TYPE(*CHAR) LEN(100) +
DFT('pubs') MIN(0) EXPR(*YES) +
CASE(*MIXED) PROMPT('SQL Server Database')
PARM KWD(SQLUSER) TYPE(*CHAR) LEN(50) DFT('sa') +
MIN(0) EXPR(*YES) CASE(*MIXED) +
PROMPT('SQL Server User ID')
PARM KWD(SQLPASS) TYPE(*CHAR) LEN(50) DFT(' ') +
MIN(0) EXPR(*YES) CASE(*MIXED) +
PROMPT('SQL Server Password')
INSNEWUIDC
PGM PARM(&IPADDR &SQLSERVER &SQLDATABSE &SQLUSER +
&SQLPASS)
DCL VAR(&IPADDR) TYPE(*CHAR) LEN(100)
DCL VAR(&SQLSERVER) TYPE(*CHAR) LEN(100)
DCL VAR(&SQLDATABSE) TYPE(*CHAR) LEN(100)
DCL VAR(&SQLUSER) TYPE(*CHAR) LEN(50)
DCL VAR(&SQLPASS) TYPE(*CHAR) LEN(50)
/********************************************************/
/* ERROR HANDLING VARIABLES */
/********************************************************/
DCL VAR(&ERRORSW) TYPE(*LGL) /* Std err */
DCL VAR(&MSGID) TYPE(*CHAR) LEN(7) /* Std err */
DCL VAR(&MSGDTA) TYPE(*CHAR) LEN(100) /* Std err */
DCL VAR(&MSGF) TYPE(*CHAR) LEN(10) /* Std err */
DCL VAR(&MSGFLIB) TYPE(*CHAR) LEN(10) /* Std err */
DCL VAR(&TXT1ST) TYPE(*CHAR) LEN(100) /* Std err */
DCL VAR(&TXT2ND) TYPE(*CHAR) LEN(100) /* Std err */
MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(STDERR1))
/***************************************************************/
/* Get current PC IP address if passed in. */
/***************************************************************/
IF COND(&IPADDR *EQ *CURRENT) THEN(DO)
RSQIP IPADDR(&IPADDR)
ENDDO
/***************************************************************/
/* Call program to write to SQL Server Table */
/***************************************************************/
CALL PGM(INSNEWUIDR) PARM(&IPADDR &SQLSERVER +
&SQLDATABSE &SQLUSER &SQLPASS)
/*******************************************************************/
/* HANDLE ERRORS */
/*******************************************************************/
STDERR1: /* Standard error handling routine */
IF &ERRORSW SNDPGMMSG MSGID(CPF9999) +
MSGF(QCPFMSG) MSGTYPE(*ESCAPE) /* Func chk */
CHGVAR &ERRORSW '1' /* Set to fail ir error occurs */
STDERR2: RCVMSG MSGTYPE(*DIAG) MSGDTA(&MSGDTA) MSGID(&MSGID) +
MSGF(&MSGF) MSGFLIB(&MSGFLIB)
IF (&MSGID *EQ ' ') GOTO STDERR3
SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
MSGDTA(&MSGDTA) MSGTYPE(*DIAG)
GOTO STDERR2 /* Loop back for addl diagnostics */
STDERR3: RCVMSG MSGTYPE(*EXCP) MSGDTA(&MSGDTA) MSGID(&MSGID) +
MSGF(&MSGF) MSGFLIB(&MSGFLIB)
IF (&MSGID *EQ ' ') GOTO STDERR4
SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
MSGDTA(&MSGDTA) MSGTYPE(*ESCAPE)
GOTO STDERR3 /* Loop back for addl exceptions */
STDERR4: RCVMSG MSGTYPE(*INFO) MSG(&TXT1ST) SECLVL(&TXT2ND) +
MSGDTA(&MSGDTA) MSGID(&MSGID) MSGF(&MSGF) +
MSGFLIB(&MSGFLIB)
IF (&TXT1ST *EQ ' ') GOTO STDERR5
SNDPGMMSG MSG(&TXT1ST) MSGTYPE(*INFO)
GOTO STDERR4 /* Loop back for addl info msgs */
STDERR5: RCVMSG MSGTYPE(*COMP) MSG(&TXT1ST) SECLVL(&TXT2ND) +
MSGDTA(&MSGDTA) MSGID(&MSGID) MSGF(&MSGF) +
MSGFLIB(&MSGFLIB)
IF (&MSGID *EQ ' ') RETURN
SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
MSGDTA(&MSGDTA) MSGTYPE(*COMP)
GOTO STDERR5 /* Loop back for addl comp msgs */
ENDPGM
INSNEWUIDR
H BNDDIR('RJSRPGSQL':'QC2LE') DFTACTGRP(*NO) ACTGRP(*NEW)
*********************************************************************
* Program Name: INSNEWUIDR
* Purpose:
* 1) Connects to a RPG2SQL server using specified IP address.
* 2) Opens database connection to SQL Server database: 'pubs'.
* 3) Gets new GUID using SQL Server Table: singlerow in 'pubs' database.
* 4) Inserts record with reserved GUID into Customer table.
* 5) Closes ADO connection.
* 6) Closes RPGSQL server connection.
*
* Note: This sample does no error checking. In your own code you
* will need to check the return codes and last error by
* using the last error return info returned by the
* SQL_LastErrNum, SQL_LastErrMsg or SQL_LastFullErr message.
*
*********************************************************************
/COPY SOURCE,RPGSQLH
D quot S 1 INZ('''')
*-----------------------------------------------------------------------------
* Main Program Processing
*-----------------------------------------------------------------------------
D ID S 38A
C *ENTRY PLIST
C PARM IPADDR 100
C PARM SQLSERVER 100
C PARM SQLDATABSE 100
C PARM SQLUSER 50
C PARM SQLPASS 50
*-----------------------------------------------------------------------------
* Connect to RPG/SQL Server
*-----------------------------------------------------------------------------
C* ** Connect to RPG SQL Server
C Eval SQL_Socket = SQL_Connect(%TRIM(IPADDR))
C* ** Exit with Error Return - TCP Server Connect
C If SQL_Socket = -999
C Eval Rtn = -1
C Eval *INLR = *On
C Return
C Endif
*-----------------------------------------------------------------------------
* Open ADO SQL Server Database Write Connection
*-----------------------------------------------------------------------------
* ** Open SQL Server Connection
C Eval Rtn = SQL_DBOpenConn(SQL_Socket:
C 'Driver={SQL Server}; ' +
C 'Server=' + %TRIMR(SQLSERVER) + ';' +
C 'Database=' + %TRIMR(SQLDATABSE) + ';' +
C 'Uid=' + %TRIMR(SQLUSER) + ';' +
C 'Pwd=' + %TRIMR(SQLPASS) + ';')
C* ** Exit after Error Return
C If Rtn <> 0
C Eval *INLR = *On
C Return
C Endif
*-----------------------------------------------------------------------------
* ** Run Query to Open ADO Recordset from singlerow
*-----------------------------------------------------------------------------
C Eval Rtn = SQL_RunSQLSel(SQL_Socket:
C 'select newid() from singlerow')
*-----------------------------------------------------------------------------
* ** If no error, Go to First (only) record
* in recordset and get the GUID in return.
* ** Requires only a single server pass
*-----------------------------------------------------------------------------
C If Rtn = 0
C Eval ID = SQL_MoveFirsBuf(SQL_Socket)
*-----------------------------------------------------------------------------
* ** Run Query to Insert Records into
* into SQL Server Table singlerow.
*-----------------------------------------------------------------------------
C Eval Rtn = SQL_RunSQLExec(SQL_Socket:
C 'insert into customer ' +
C '(ID,' +
C 'First,' +
C 'Last) ' +
C 'values(' +
C quot + %trimr(ID) + quot + ',' +
C quot + 'Vern' + quot + ',' +
C quot + 'Hamberg' + quot +
C ')')
C endif
*-----------------------------------------------------------------------------
* Close ADO Database Conection
*-----------------------------------------------------------------------------
C callp SQL_DBCloseConn(SQL_Socket)
*-----------------------------------------------------------------------------
C* Disconnect from RPGSQL server
*-----------------------------------------------------------------------------
C callp SQL_Disconnect(SQL_Socket)
C SETON LR
