create table Customer ( ID uniqueidentifier ROWGUIDCOL NOT NULL, First varchar (30) NOT NULL, Last varchar (30) NOT NULL )
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
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
Still have questions? We can help. Submit a case to Technical Support.