VMS Tech Demo 2 - SQL Relay

Content:

Introduction
Background
Setup
C API
C++ API
VMS API
Embedded SQL
Conclusion

Introduction:

VSI has recently released SQL Relay client for VMS and I think that it is a very interesting technology that the VMS community should look into.

Background:

The general SQL Relay architecture is:

It is particular relevant for VMS because it allows for VMS applications to access databases where there are no client library for VMS.

Examples with a mix of databases without client libraries available for VMS and databases with client libraries available for VMS.

It is no secret that access to Oracle DB has been driving the SQL Relay initiative. Oracle will end support for native client library on VMS and VMS users need a way to access Oracle DB.

But there are actually many other databases that suddenly become available to VMS applications.

Note that using SQL Relay can be relevant even for databases where client libraries are available for VMS, because the same API can be used across databases.

Setup:

A new version of SQL Relay client is required. Version 1.9-0C or later.

My test setup has:

Applications on VMS
SQL Relay server on Windows
databases on both Windows and VMS

I have tested with the following languages for application:

C using C API
C++ using C++ API
Pascal using VMS API
Fortran using VMS API
C using embedded SQL (Oracle only)
Cobol using embedded SQL (Oracle only)

I have tested with the following databases:

MySQL on Windows
PostgreSQL on Windows<
DB2 on Windows
Oracle on Windows
ODBC to SQLServer on Windows
ODBC to MySQL on Windows
ODBC to PostgreSQL on Windows
ODBC to DB2 on Windows
MySQL on VMS
ODBC to Rdb on VMS
ODBC to MySQL on VMS
ODBC to Mimer on VMS

SQL Relay setup:

<?xml version="1.0"?>
<instances>
    <instance id="localmysql" port="9001" dbase="mysql">
        <users>
            <user user="arne" password="topsecret"/>
        </users>
        <connections>
            <connection string="host=localhost;db=Test;user=root;password="/>
        </connections>
    </instance>
    <instance id="localpgsql" port="9002" dbase="postgresql">
        <users>
            <user user="arne" password="topsecret"/>
        </users>
        <connections>
            <connection string="host=localhost;db=Test;user=postgres;password=hemmeligt"/>
        </connections>
    </instance>
    <instance id="localdb2" port="9003" dbase="db2" connections="1" maxconnections="1">
        <users>
            <user user="arne" password="topsecret"/>
        </users>
        <connections>
            <connection string="host=localhost;db=Test;user=arne;password=hemmeligt"/>
        </connections>
    </instance>
    <instance id="localora" port="9004" dbase="oracle">
        <users>
            <user user="arne" password="topsecret"/>
        </users>
        <connections>
            <connection string="oracle_sid=XE;user=arne;password=hemmeligt"/>
        </connections>
    </instance>
    <instance id="odbcsqlsrv" port="9005" dbase="odbc">
        <users>
            <user user="arne" password="topsecret"/>
        </users>
        <connections>
            <connection string="dsn=ARNEPC4_SQLSRV"/>
        </connections>
    </instance>
    <instance id="odbcmysql" port="9006" dbase="odbc">
        <users>
            <user user="arne" password="topsecret"/>
        </users>
        <connections>
            <connection string="dsn=ARNEPC4_MYSQL;user=root;password="/>
        </connections>
    </instance>
    <instance id="odbcpgsql" port="9007" dbase="odbc">
        <users>
            <user user="arne" password="topsecret"/>
        </users>
        <connections>
            <connection string="dsn=ARNEPC4_PGSQL;user=postgres;password=hemmeligt"/>
        </connections>
    </instance>
    <instance id="odbcdb2" port="9008" dbase="odbc">
        <users>
            <user user="arne" password="topsecret"/>
        </users>
        <connections>
            <connection string="dsn=ARNEPC4_DB2;user=arne;password=hemmeligt"/>
        </connections>
    </instance>
    <instance id="vmsmysql" port="9010" dbase="mysql">
        <users>
            <user user="arne" password="topsecret"/>
        </users>
        <connections>
            <connection string="host=192.168.0.10;db=Test;user=root;password="/>
        </connections>
    </instance>
    <instance id="odbcvmsrdb" port="9011" dbase="odbc">
        <users>
            <user user="arne" password="topsecret"/>
        </users>
        <connections>
            <connection string="dsn=ARNE1_RDB;user=arne;password=hemmeligt"/>
        </connections>
    </instance>
    <instance id="odbcvmsmimer" port="9013" dbase="odbc" connections="1" maxconnections="1">
        <users>
            <user user="arne" password="topsecret"/>
        </users>
        <connections>
            <connection string="dsn=ARNE1_MIMER;user=SYSADM;password=hemmeligt"/>
        </connections>
    </instance>
</instances>

Note that for a couple of databases I had to limit concurrent connections to one. But it may just be a problem in my setup.

Start:

sqlr-start -config all.conf -id localmysql
sqlr-start -config all.conf -id localpgsql
sqlr-start -config all.conf -id localdb2
sqlr-start -config all.conf -id localora
sqlr-start -config all.conf -id odbcsqlsrv
sqlr-start -config all.conf -id odbcmysql
sqlr-start -config all.conf -id odbcpgsql
sqlr-start -config all.conf -id odbcdb2
sqlr-start -config all.conf -id vmsmysql
sqlr-start -config all.conf -id odbcvmsrdb
sqlr-start -config all.conf -id odbcvmsmimer

Stop:

sqlr-stop -config all.conf -id localmysql
sqlr-stop -config all.conf -id localpgsql
sqlr-stop -config all.conf -id localdb2
sqlr-stop -config all.conf -id localora
sqlr-stop -config all.conf -id odbcsqlsrv
sqlr-stop -config all.conf -id odbcmysql
sqlr-stop -config all.conf -id odbcpgsql
sqlr-stop -config all.conf -id odbcdb2
sqlr-stop -config all.conf -id vmsmysql
sqlr-stop -config all.conf -id odbcvmsrdb
sqlr-stop -config all.conf -id odbcvmsmimer

Note that the SQL Relay API is database independent except for parameter placeholders and bindnames. Those use the convention of the database specific client library. The code below use some weird looking functions to generalize that. But if your code will only use one database or at least databases using the same style, then you can just hardcode placeholders and bindnames.

C API:

VMS SQL Relay client C API is the standard SQL Relay C API. And the demo code is the same as in C/C++ Database Access.

Demo code:

/* standard C headers */
#include <stdio.h>
#include <stdlib.h>
#include <string.h>

/* SQLRelay headers */
#include <sqlrelay/sqlrclientwrapper.h>

#define F2_MAX_LEN 50
#define MAX_REC 100

typedef char *(*ss2s)(char *s1, char *s2);
typedef char *(*sss2s)(char *s1, char *s2, char *s3);

/* table structure */
struct t1
{
    int f1;
    char f2[F2_MAX_LEN + 1];
};

/* error handling functions */
void con_exit(sqlrcon con)
{
    printf("SQLR connection error: %s\n", sqlrcon_errorMessage(con));
    exit(1);
}

void curs_exit(sqlrcur curs)
{
    printf("SQLR cursor error: %s\n", sqlrcur_errorMessage(curs));
    exit(1);
}

void other_exit(char *msg)
{
    printf("%s\n", msg);
    exit(1);
}

/* get f1 given f2 */
int t1_get_one(sqlrcon con, char *f2, sss2s placeholder, ss2s bindname)
{
    sqlrcur curs;
    int stat, f1;
    char sqlstr[40 + 2 * F2_MAX_LEN];
    /* get cursor */
    curs = sqlrcur_alloc(con);
    /* prepare */
    sprintf(sqlstr, "SELECT f1 FROM t1 WHERE f2 = %s", placeholder("1", "f2", "text"));
    sqlrcur_prepareQuery(curs, sqlstr);
    /* bind parameters */
    sqlrcur_inputBindString(curs, bindname("1", "f2"), f2);
    /* execute */
    stat = sqlrcur_executeQuery(curs);
    if(!stat) curs_exit(curs);
    /* process result */
    if(sqlrcur_getFieldByIndex(curs, 0, 0) == NULL)
    {
        other_exit("Row not found");
        return 0; /* will never be reached */
    }
    f1 = sqlrcur_getFieldAsIntegerByIndex(curs, 0, 0);
    sqlrcon_endSession(con);
    /* close cursor */ 
    sqlrcur_free(curs);
    return f1;
}

/* get all records */
int t1_get_all(sqlrcon con, struct t1 *buf, int bufsiz)
{
    sqlrcur curs;
    int stat, row, count;
    /* get cursor */
    curs = sqlrcur_alloc(con);
    /* execute */
    stat = sqlrcur_sendQuery(curs, "SELECT f1,f2 FROM t1");
    if(!stat) curs_exit(curs);
    /* process result */
    sqlrcur_setResultSetBufferSize(curs, 100);
    row = 0;
    count = 0;
    for(;;)
    {
        if(count >= bufsiz) break;
        if(sqlrcur_getFieldByIndex(curs, row, 0) == NULL) break;
        buf[count].f1 = sqlrcur_getFieldAsIntegerByIndex(curs, row, 0);
        strcpy(buf[count].f2, sqlrcur_getFieldByIndex(curs, row, 1));
        count++;
        row++;
    }
    sqlrcon_endSession(con);
    /* close cursor */ 
    sqlrcur_free(curs);
    return count;
}

/* add record */
void t1_put(sqlrcon con, int f1, char *f2, sss2s placeholder, ss2s bindname)
{
    sqlrcur curs;
    int stat, n;
    char sqlstr[40 + 2 * F2_MAX_LEN];
    /* get cursor */
    curs = sqlrcur_alloc(con);
    /* prepare */
    sprintf(sqlstr, "INSERT INTO t1 VALUES(%s, %s)", placeholder("1", "f1", "int"), placeholder("2", "f2", "text"));
    sqlrcur_prepareQuery(curs, sqlstr);
    /* bind parameters */
    sqlrcur_inputBindLong(curs, bindname("1", "f1"), f1);
    sqlrcur_inputBindString(curs, bindname("2", "f2"), f2);
    /* execute */
    stat = sqlrcur_executeQuery(curs);
    if(!stat) curs_exit(curs);
    n = sqlrcur_affectedRows(curs);
    if(n != 1)
    {
        other_exit("INSERT did not insert 1 row");
    }
    sqlrcon_endSession(con);
    /* close cursor */ 
    sqlrcur_free(curs);
}

/* delete record */
void t1_remove(sqlrcon con, int f1, sss2s placeholder, ss2s bindname)
{
    sqlrcur curs;
    int stat, n;
    char sqlstr[40 + 2 * F2_MAX_LEN];
    /* get cursor */
    curs = sqlrcur_alloc(con);
    /* prepare */
    sprintf(sqlstr, "DELETE FROM t1 WHERE f1 = %s", placeholder("1", "f1", "int"));
    sqlrcur_prepareQuery(curs, sqlstr);
    /* bind parameters */
    sqlrcur_inputBindLong(curs, bindname("1", "f1"), f1);
    /* execute */
    stat = sqlrcur_executeQuery(curs);
    if(!stat) curs_exit(curs);
    n = sqlrcur_affectedRows(curs);
    if(n != 1)
    {
        other_exit("DELETE did not delete 1 row");
    }
    sqlrcon_endSession(con);
    /* close cursor */ 
    sqlrcur_free(curs);
}

/* print all records */
void t1_dump(sqlrcon con)
{
    struct t1 buf[MAX_REC];
    int i, n;
    n = t1_get_all(con, buf, MAX_REC);
    for(i = 0; i < n; i++)
    {
        printf("%d \"%s\"\n", buf[i].f1, buf[i].f2);
    }
}

void test(char *host, int port, char *un, char *pw, sss2s placeholder, ss2s bindname)
{
    sqlrcon con;
    int f1;
    printf("Connect host=%s port=%d:\n", host, port); 
    /* open */
    con = sqlrcon_alloc(host, port, NULL, un, pw, 0, 1);
    sqlrcon_autoCommitOn(con);
    /* test t1_get_one */
    f1 = t1_get_one(con, "BB", placeholder, bindname);
    printf("%d\n", f1);
    /* test t1_get_all */
    t1_dump(con);
    /* test t1_put */
    t1_put(con, 999, "XXX", placeholder, bindname);
    t1_dump(con);
    /* test t1_remove */
    t1_remove(con, 999, placeholder, bindname);
    t1_dump(con);
    /* close */
    sqlrcon_free(con);
}

#define MAXIX 100

static int phix = 0;
static char phbuf[MAXIX][16];
static int bnix = 0;
static char bnbuf[MAXIX][16];

/* standard (ODBC, DB2, MySQL) */
static char *std_ph(char *num, char *nam, char *typ)
{
    return "?";
}

static char *std_bn(char *num, char *nam)
{
    return num;
}

/* PostgreSQL */
static char *pgsql_ph(char *num, char *nam, char *typ)
{
    char *buf = phbuf[phix];
    sprintf(buf, "$%s::%s", num, typ);
    phix = (phix + 1) % MAXIX;
    return buf;
}

static char *pgsql_bn(char *num, char *nam)
{
    return num;
}

/* Oracle */
static char *ora_ph(char *num, char *nam, char *typ)
{
    char *buf = phbuf[phix];
    sprintf(buf, ":%s", nam);
    phix = (phix + 1) % MAXIX;
    return buf;
}

static char *ora_bn(char *num, char *nam)
{
    return nam;
}

int main()
{
    test("arnepc4", 9001, "arne", "topsecret", std_ph, std_bn); /* 9001 = localmysql */
    test("arnepc4", 9002, "arne", "topsecret", pgsql_ph, pgsql_bn); /* 9002 = localpgsql */
    test("arnepc4", 9003, "arne", "topsecret", std_ph, std_bn); /* 9003 = localdb2 */
    test("arnepc4", 9004, "arne", "topsecret", ora_ph, ora_bn); /* 9004 = localora */
    test("arnepc4", 9005, "arne", "topsecret", std_ph, std_bn); /* 9005 = odbcsqlsrv */
    test("arnepc4", 9006, "arne", "topsecret", std_ph, std_bn); /* 9006 = odbcmysql */
    test("arnepc4", 9007, "arne", "topsecret", std_ph, std_bn); /* 9007 = odbcpgsql */
    test("arnepc4", 9008, "arne", "topsecret", std_ph, std_bn); /* 9008 = odbcdb2 */
    test("arnepc4", 9010, "arne", "topsecret", std_ph, std_bn); /* 9010 = vmsmysql */
    test("arnepc4", 9011, "arne", "topsecret", std_ph, std_bn); /* 9011 = vmsodbcrdb */
    test("arnepc4", 9013, "arne", "topsecret", std_ph, std_bn); /* 9013 = vmsodbcmimer */
    return 0;
}

Build:

$ cc/name=(as_is,shorten) sqlr.c
$ link sqlr + sys$input/option
sqlr$shr/share
$
$ exit

C++ API:

VMS SQL Relay client C++ API is the standard SQL Relay C++ API. And the demo code is the same as in C/C++ Database Access.

Demo code:

// standard C++ headers
#include <iostream>
#include <cstdio>
#include <cstdlib>
using namespace std;

/* SQLRelay headers */
#ifdef WIN32
#define RUDIMENTS_HAVE_CHAR16_T // hack to solve some rudiments vs VS2019 problem
#endif
#include <sqlrelay/sqlrclient.h>

#define F2_MAX_LEN 50
#define MAX_REC 100

typedef const char *(*ss2s)(const char *s1, const char *s2);
typedef const char *(*sss2s)(const char *s1, const char *s2, const char *s3);

// table structure
struct t1
{
    int f1;
    char f2[F2_MAX_LEN + 1];
};

class DB
{
public:
    // destruct instance
    virtual ~DB() { };
    // get f1 given f2
    virtual int T1GetOne(const char *f2) = 0;
    // get all records
    virtual int T1GetAll(struct t1 *buf, int bufsiz) = 0;
    // add record
    virtual void T1Put(int f1, const char *f2) = 0;
    // delete record
    virtual void T1Remove(int f1) = 0;
    // print all records
    void T1Dump();
};

// print all records
void DB::T1Dump()
{
    struct t1 buf[MAX_REC];
    int i, n;
    n = T1GetAll(buf, MAX_REC);
    for(i = 0; i < n; i++)
    {
        cout << buf[i].f1 << " " << buf[i].f2 << endl;
    }
}

class OOSQLR : public DB
{
private:
    sqlrconnection *con;
    sss2s placeholder;
    ss2s bindname;
    void ConnectionExit(sqlrconnection *con);
    void CursorExit(sqlrcursor *curs);
    void OtherExit(const char *msg);
public:
    // construct instance
    OOSQLR(const char *host, int port, const char *un, const char *pw, sss2s placeholder, ss2s bindname);
    // destruct instance
    virtual ~OOSQLR();
    // get f1 given f2
    virtual int T1GetOne(const char *f2);
    // get all records
    virtual int T1GetAll(struct t1 *buf, int bufsiz);
    // add record
    virtual void T1Put(int f1, const char *f2);
    // delete record
    virtual void T1Remove(int f1);
};

// error handling functions
void OOSQLR::ConnectionExit(sqlrconnection *con)
{
    cout << "SQLR connection error: " << con->errorMessage() << endl;
    exit(1);
}

void OOSQLR::CursorExit(sqlrcursor *curs)
{
    cout << "SQLR cursor error: " << curs->errorMessage() << endl;
    exit(1);
}

void OOSQLR::OtherExit(const char *msg)
{
    cout << msg << endl;
    exit(1);
}

// construct instance
OOSQLR::OOSQLR(const char *host, int port, const char *un, const char *pw, sss2s placeholder, ss2s bindname)
{
    con = new sqlrconnection(host, port, NULL, un, pw, 0, 1);
    con->autoCommitOn();
    this->placeholder = placeholder;
    this->bindname = bindname;
}

// destruct instance
OOSQLR::~OOSQLR()
{
    delete con;
}

// get f1 given f2
int OOSQLR::T1GetOne(const char *f2)
{
    // get cursor
    sqlrcursor *curs = new sqlrcursor(con);
    // prepare
    char sqlstr[40 + 2 * F2_MAX_LEN];
    sprintf(sqlstr, "SELECT f1 FROM t1 WHERE f2 = %s", placeholder("1", "f2", "text"));
    curs->prepareQuery(sqlstr);
    // bind parameters
    curs->inputBind(bindname("1", "f2"), f2);
    // execute
    int stat = curs->executeQuery();
    if(!stat) CursorExit(curs);
    // process result
    if(curs->getField((uint64_t)0, (uint32_t)0) == NULL)
    {
        OtherExit("Row not found");
        return 0; /* will never be reached */
    }
    int f1 = curs->getFieldAsInteger((uint64_t)0, (uint32_t)0);
    con->endSession();
    // close cursor 
    delete curs;
    return f1;
}

// get all records
int OOSQLR::T1GetAll(struct t1 *buf, int bufsiz)
{
    // get cursor
    sqlrcursor *curs = new sqlrcursor(con);
    // execute
    int stat = curs->sendQuery("SELECT f1,f2 FROM t1");
    if(!stat) CursorExit(curs);
    // process result
    curs->setResultSetBufferSize(100);
    int row = 0;
    int count = 0;
    for(;;)
    {
        if(count >= bufsiz) break;
        if(curs->getField((uint64_t)row, (uint32_t)0) == NULL) break;
        buf[count].f1 = curs->getFieldAsInteger((uint64_t)row, (uint32_t)0);
        strcpy(buf[count].f2, curs->getField((uint64_t)row, (uint32_t)1));
        count++;
        row++;
    }
    con->endSession();
    // close cursor
    delete curs;
    return count;
}

// add record
void OOSQLR::T1Put(int f1, const char *f2)
{
    // get cursor
    sqlrcursor *curs = new sqlrcursor(con);
    // prepare
    char sqlstr[40 + 2 * F2_MAX_LEN];
    sprintf(sqlstr, "INSERT INTO t1 VALUES(%s, %s)", placeholder("1", "f1", "int"), placeholder("2", "f2", "text"));
    curs->prepareQuery(sqlstr);
    // bind parameters
    curs->inputBind(bindname("1", "f1"), f1);
    curs->inputBind(bindname("2", "f2"), f2);
    // execute
    int stat = curs->executeQuery();
    if(!stat) CursorExit(curs);
    int n = curs->affectedRows();
    if(n != 1)
    {
        OtherExit("INSERT did not insert 1 row");
    }
    con->endSession();
    // close cursor 
    delete curs;
}

// delete record
void OOSQLR::T1Remove(int f1)
{
    // get cursor
    sqlrcursor *curs = new sqlrcursor(con);
    // prepare
    char sqlstr[40 + 2 * F2_MAX_LEN];
    sprintf(sqlstr, "DELETE FROM t1 WHERE f1 = %s", placeholder("1", "f1", "int"));
    curs->prepareQuery(sqlstr);
    // bind parameters
    curs->inputBind(bindname("1", "f1"), f1);
    // execute
    int stat = curs->executeQuery();
    if(!stat) CursorExit(curs);
    int n = curs->affectedRows();
    if(n != 1)
    {
        OtherExit("DELETE did not delete 1 row");
    }
    con->endSession();
    // close cursor
    delete curs;
}

void test(const char *host, int port, const char *un, const char *pw, sss2s placeholder, ss2s bindname)
{
    cout << "Connect host=" << host << " port=" << port << endl; 
    /* open */
    DB *db = new OOSQLR(host, port, un, pw, placeholder, bindname);
    /* test T1GetOne */
    int f1 = db->T1GetOne("BB");
    printf("%d\n", f1);
    /* test T1GetAll */
    db->T1Dump();
    /* test T1Put */
    db->T1Put(999, "XXX");
    db->T1Dump();
    /* test T1Remove */
    db->T1Remove(999);
    db->T1Dump();
}

#define MAXIX 100

static int phix = 0;
static char phbuf[MAXIX][16];
static int bnix = 0;
static char bnbuf[MAXIX][16];

/* standard (ODBC, DB2, MySQL) */
static const char *std_ph(const char *num, const char *nam, const char *typ)
{
    return "?";
}

static const char *std_bn(const char *num, const char *nam)
{
    return num;
}

/* PostgreSQL */
static const char *pgsql_ph(const char *num, const char *nam, const char *typ)
{
    char *buf = phbuf[phix];
    sprintf(buf, "$%s::%s", num, typ);
    phix = (phix + 1) % MAXIX;
    return buf;
}

static const char *pgsql_bn(const char *num, const char *nam)
{
    return num;
}

/* Oracle */
static const char *ora_ph(const char *num, const char *nam, const char *typ)
{
    char *buf = phbuf[phix];
    sprintf(buf, ":%s", nam);
    phix = (phix + 1) % MAXIX;
    return buf;
}

static const char *ora_bn(const char *num, const char *nam)
{
    return nam;
}

int main()
{
    test("arnepc4", 9001, "arne", "topsecret", std_ph, std_bn); /* 9001 = localmysql */
    test("arnepc4", 9002, "arne", "topsecret", pgsql_ph, pgsql_bn); /* 9002 = localpgsql */
    test("arnepc4", 9003, "arne", "topsecret", std_ph, std_bn); /* 9003 = localdb2 */
    test("arnepc4", 9004, "arne", "topsecret", ora_ph, ora_bn); /* 9004 = localora */
    test("arnepc4", 9005, "arne", "topsecret", std_ph, std_bn); /* 9005 = odbcsqlsrv */
    test("arnepc4", 9006, "arne", "topsecret", std_ph, std_bn); /* 9006 = odbcmysql */
    test("arnepc4", 9007, "arne", "topsecret", std_ph, std_bn); /* 9007 = odbcpgsql */
    test("arnepc4", 9008, "arne", "topsecret", std_ph, std_bn); /* 9008 = odbcdb2 */
    test("arnepc4", 9010, "arne", "topsecret", std_ph, std_bn); /* 9010 = vmsmysql */
    test("arnepc4", 9011, "arne", "topsecret", std_ph, std_bn); /* 9011 = vmsodbcrdb */
    test("arnepc4", 9013, "arne", "topsecret", std_ph, std_bn); /* 9013 = vmsodbcmimer */
    return 0;
}

Build:

$ cxx/name=(as_is,shorten) sqlr.cpp
$ cxxlink sqlr + sys$input/option
sqlr$shr/share
$
$ exit

Build in case of socklen_t problem (happended for me with M release on Alpha):

$ cxx/name=(as_is,shorten)/define=("socklen_t=unsigned") sqlr.cpp
$ cxxlink sqlr + sys$input/option
sqlr$shr/share
$
$ exit

VMS API:

VMS SQL Relay client VMS API is a VMS wrapper around the standard SQL Relay C API to make it more VMS friendly.

Changes include:

routines names changed from sqlrxxx_yyyy to sqlr$xxx_yyyy
routines return traditional VMS status code (odd=good,even=error)
string arguments are passed by descriptor instead of C nul terminated strings

This API can easily be called from traditional VMS languages: Cobol, Fortran, Pascal and Basic.

Demo code in Pascal:

program sqlr(input, output);

%include "sqlr$pascal:sqlrdef.pas"

const
   MAX_REC = 100;

type
   pstr = varying[32000] of char;
   portnumber = integer16;
   sqlrcon = integer64;
   sqlrcurs = integer64;
   t1 = record
           f1 : integer;
           f2 : pstr;
        end;

(* error handling functions *)
procedure con_exit(con : sqlrcon);

var
   msg : pstr;

begin
   sqlr$con_errormessage(con, msg.body, msg.length);
   writeln('SQLR connection error: ' + msg);
   halt;
end;

procedure curs_exit(curs : sqlrcurs);

var
   msg : pstr;

begin
   sqlr$cur_errormessage(curs, msg.body, msg.length);
   writeln('SQLR cursor error: ' + msg);
   halt;
end;

procedure other_exit(msg : pstr);

begin
   writeln(msg);
   halt;
end;

(* get f1 given f2 *)
function t1_get_one(con : sqlrcon;
                    f2 : pstr;
                    function ph(num, nam, typ : pstr) : pstr;
                    function bn(num, nam : pstr) : pstr) : integer;

var
   curs : sqlrcurs;
   temp : integer64;
   stat, res, f1 : integer;
   s : pstr;

begin
   (* get cursor *)
   sqlr$cur_alloc(con, curs);
   (* prepare *)
   sqlr$cur_preparequery(curs, 'SELECT f1 FROM t1 WHERE f2 = ' + ph('1', 'f2', 'text'));
   (* bind parameters *)
   sqlr$cur_inputbindstring(curs, bn('1', 'f2'), substr(f2.body, 1, f2.length));
   (* execute *)
   stat := sqlr$cur_executequery(curs, res);
   if (stat mod 2) = 0 then curs_exit(curs);
   (* process result *)
   stat := sqlr$cur_getfieldbyindex(curs, 0, 0, s.body, s.length);
   if (stat mod 2) = 0 then begin
      other_exit('Row not found');
   end;
   sqlr$cur_getfieldasintbyind(curs, 0, 0, temp);
   f1 := temp;
   sqlr$con_endsession(con);
   (* close cursor *)
   sqlr$cur_free(curs);
   t1_get_one := f1;
end;

(* get all records *)
function t1_get_all(con : sqlrcon;
                    var buf : array[$L1..$U1:integer] of t1;
                    bufsiz : integer) : integer;

label
   done;

var
   curs : sqlrcurs;
   stat, count : integer;
   row : unsigned64;
   temp : integer64;
   s : pstr;

begin
   (* get cursor *)
   sqlr$cur_alloc(con, curs);
   (* execute *)
   stat := sqlr$cur_sendquery(curs, 'select f1,f2 from t1');
   if (stat mod 2) = 0 then curs_exit(curs);
   (* process result *)
   sqlr$cur_setresultsetbuffersize(curs, 100);
   row := 0;
   count := 0;
   while true do begin
      if count >= bufsiz then goto done;
      stat := sqlr$cur_getfieldbyindex(curs, row, 0, s.body, s.length);
      if (stat mod 2) = 0 then goto done;
      count := count + 1;
      sqlr$cur_getfieldasintbyind(curs, row, 0, temp);
      buf[count].f1 := temp;
      sqlr$cur_getfieldbyindex(curs, row, 1, buf[count].f2.body, buf[count].f2.length);
      row := row + 1;
   end;
done:
   sqlr$con_endsession(con);
   (* close cursor *)
   sqlr$cur_free(curs);
   t1_get_all := count;
end;

(* add record *)
procedure t1_put(con : sqlrcon;
                 f1 : integer;
                 f2 : pstr; function ph(num, nam, typ : pstr) : pstr;
                 function bn(num, nam : pstr) : pstr);

var
   curs : sqlrcurs;
   stat, res : integer;
   temp : integer64;
   n : unsigned64;

begin
   (* get cursor *)
   sqlr$cur_alloc(con, curs);
   (* prepare *)
   sqlr$cur_preparequery(curs, 'INSERT INTO t1 VALUES(' + ph('1', 'f1', 'int') + ', ' + ph('2', 'f2', 'text') + ')');
   (* bind parameters *)
   temp := f1;
   sqlr$cur_inputbindlong(curs, bn('1', 'f1'), temp);
   sqlr$cur_inputbindstring(curs, bn('2', 'f2'), substr(f2.body, 1, f2.length));
   (* execute *)
   stat := sqlr$cur_executequery(curs, res);
   if (stat mod 2) = 0 then curs_exit(curs);
   sqlr$cur_affectedrows(curs, n);
   if n <> 1 then begin
      other_exit('INSERT did not insert 1 row');
   end;
   sqlr$con_endsession(con);
   (* close cursor *)
   sqlr$cur_free(curs);
end;

(* delete record *)
procedure t1_remove(con : sqlrcon;
                    f1 : integer;
                    function ph(num, nam, typ : pstr) : pstr;
                    function bn(num, nam : pstr) : pstr);

var
   curs : sqlrcurs;
   stat, res : integer;
   temp : integer64;
   n : unsigned64;

begin
   (* get cursor *)
   sqlr$cur_alloc(con, curs);
   (* prepare *)
   sqlr$cur_preparequery(curs, 'DELETE FROM t1 WHERE f1 = ' + ph('1', 'f1', 'int'));
   (* bind parameters *)
   temp := f1;
   sqlr$cur_inputbindlong(curs, bn('1', 'f1'), temp);
   (* execute *)
   stat := sqlr$cur_executequery(curs, res);
   if (stat mod 2) = 0 then curs_exit(curs);
   sqlr$cur_affectedrows(curs, n);
   if n <> 1 then begin
      other_exit('DELETE did not delete 1 row');
   end;
   sqlr$con_endsession(con);
   (* close cursor *)
   sqlr$cur_free(curs);
end;

(* print all records *)
procedure t1_dump(con : sqlrcon);

var
   buf : array [1..MAX_REC] of t1;
   i, n : integer;

begin
   n := t1_get_all(con, buf, MAX_REC);
   for i := 1 to n do begin
      writeln(buf[i].f1, ' ', buf[i].f2);
   end;
end;

procedure test(host : packed array[$L1..$U1:integer] of char;
               port : portnumber;
               un : packed array[$L2..$U2:integer] of char;
               pw : packed array[$L3..$U3:integer] of char;
               function ph(num, nam, typ : pstr) : pstr;
               function bn(num, nam : pstr) : pstr);

var
   con : sqlrcon;
   socket : packed array[1..1] of char value '?';
   f1 : integer;

begin
   writeln('Connect host=', host, ' port=', port:1); 
   (* open *)
   sqlr$con_alloc(host, port, socket, un, pw, 0, 1, con);
   (* test t1_get_one *)   
   f1 := t1_get_one(con, 'BB', ph, bn);
   writeln(f1);
   (* test t1_get_all *)   
   t1_dump(con);   
   (* test t1_put *)
   t1_put(con, 999, 'XXX', ph, bn);
   t1_dump(con);
   (* test t1_remove *)
   t1_remove(con, 999, ph, bn);
   t1_dump(con);
   (* close *)
   sqlr$con_free(con);
end;

(* standard (ODBC, DB2, MySQL) *)
function std_ph(num, nam, typ : pstr) : pstr;

begin
   std_ph := '?';
end;

function std_bn(num, nam : pstr) : pstr;

begin
   std_bn := num;
end;

(* PostgreSQL *)
function pgsql_ph(num, nam, typ : pstr) : pstr;

begin
   pgsql_ph := '$' + num + '::' + typ;
end;

function pgsql_bn(num, nam : pstr) : pstr;

begin
   pgsql_bn := num;
end;

(* Oracle *)
function ora_ph(num, nam, typ : pstr) : pstr;

begin
   ora_ph := ':' + nam;
end;

function ora_bn(num, nam : pstr) : pstr;

begin
   ora_bn := nam;
end;

begin
   test('arnepc4', 9001, 'arne', 'topsecret', std_ph, std_bn); (* 9001 = localmysql *)
   test('arnepc4', 9002, 'arne', 'topsecret', pgsql_ph, pgsql_bn); (* 9002 = localpgsql *)
   test('arnepc4', 9003, 'arne', 'topsecret', std_ph, std_bn); (* 9003 = localdb2 *)
   test('arnepc4', 9004, 'arne', 'topsecret', ora_ph, ora_bn); (* 9004 = localora *)
   test('arnepc4', 9005, 'arne', 'topsecret', std_ph, std_bn); (* 9005 = odbcsqlsrv *)
   test('arnepc4', 9006, 'arne', 'topsecret', std_ph, std_bn); (* 9006 = odbcmysql *)
   test('arnepc4', 9007, 'arne', 'topsecret', std_ph, std_bn); (* 9007 = odbcpgsql *)
   test('arnepc4', 9008, 'arne', 'topsecret', std_ph, std_bn); (* 9008 = odbcdb2 *)
   test('arnepc4', 9010, 'arne', 'topsecret', std_ph, std_bn); (* 9010 = vmsmysql *)
   test('arnepc4', 9011, 'arne', 'topsecret', std_ph, std_bn); (* 9011 = vmsodbcrdb *)
   test('arnepc4', 9013, 'arne', 'topsecret', std_ph, std_bn); (* 9013 = vmsodbcmimer *)
end.

Build:

$ pas sqlr
$ link sqlr + sys$input/option
sqlr$shr/share
$
$ exit

Demo code in Fortran:

      program sqlr
      implicit none
      external std_ph,std_bn,pgsql_ph,pgsql_bn,ora_ph,ora_bn
      character*32 std_ph,std_bn,pgsql_ph,pgsql_bn,ora_ph,ora_bn
      call test('arnepc4',9001,'arne','topsecret',std_ph,std_bn)
      call test('arnepc4',9002,'arne','topsecret',pgsql_ph,pgsql_bn)
      call test('arnepc4',9003,'arne','topsecret',std_ph,std_bn)
      call test('arnepc4',9004,'arne','topsecret',ora_ph,ora_bn)
      call test('arnepc4',9005,'arne','topsecret',std_ph,std_bn)
      call test('arnepc4',9006,'arne','topsecret',std_ph,std_bn)
      call test('arnepc4',9007,'arne','topsecret',std_ph,std_bn)
      call test('arnepc4',9008,'arne','topsecret',std_ph,std_bn)
      call test('arnepc4',9010,'arne','topsecret',std_ph,std_bn)
      call test('arnepc4',9011,'arne','topsecret',std_ph,std_bn)
      call test('arnepc4',9013,'arne','topsecret',std_ph,std_bn)
      end
c******** test one database
      subroutine test(host,port,un,pw,ph,bn)
      implicit none
      character*(*) host,un,pw
      external ph,bn
      character*32 ph,bn
      integer*4 port
      integer*8 con
      character*1 socket
      integer*4 f1
      integer*4 t1_get_one
      write(*,*) 'Connect host=',host,' port=',port
c  open
      socket = '?'
      call sqlr$con_alloc(host,port,socket,un,pw,0,1,con)
c  test t1_get_one
      f1=t1_get_one(con,'BB',ph,bn)
      write(*,*) f1
c  test t1_get_all
      call t1_dump(con)
c  test t1_put
      call t1_put(con,999,'XXX',ph,bn)
      call t1_dump(con)
c  test t1_remove
      call t1_remove(con,999,ph,bn)
      call t1_dump(con)
c  close
      call sqlr$con_free(con)
      return
      end
c******** print all records
      subroutine t1_dump(con)
      implicit none
      integer*8 con
      structure /t1/
        integer*4 f1
        character*50 f2
      end structure
      integer*4 MAX_REC
      parameter (MAX_REC=100)
      record /t1/buf(MAX_REC)
      integer*4 n,i
      integer*4 t1_get_all
      n=t1_get_all(con,buf,MAX_REC)
      do 100 i=1,n
        write(*,*) buf(i).f1,' ',buf(i).f2
100   continue
      return
      end
c******** get f1 given f2
      integer*4 function t1_get_one(con,f2,ph,bn)
      implicit none
      integer*8 con
      character*(*) f2
      external ph,bn
      character*32 ph,bn
      include 'sqlr$fortran:sqlrdef.for'
      integer*4 stat,res,slen,f1
      integer*8 curs,temp
      character*50 s
c  get cursor
      call sqlr$cur_alloc(con,curs)
c  prepare
      call sqlr$cur_preparequery(curs,'SELECT f1 FROM t1 WHERE f2 = '//
     +                                ph('1','f2','text'))
c  bind parameters
      call sqlr$cur_inputbindstring(curs,bn('1','f2'),f2,len(f2))
c  execute
      stat=sqlr$cur_executequery(curs,res)
      if (mod(stat,2).eq.0) callcurs_exit(curs)
c  process result
      stat=sqlr$cur_getfieldbyindex(curs,0,0,s,slen)
      if(mod(stat,2).eq.0) call other_exit('Row not found')
      call sqlr$cur_getfieldasintbyind(curs,0,0,temp)
      f1=temp
      call sqlr$con_endsession(con)
c  close cursor
      call sqlr$cur_free(curs)
      t1_get_one=f1
      return
      end
c******** get all records
      integer*4 function t1_get_all(con,buf,bufsiz)
      implicit none
      integer*8 con
      structure /t1/
        integer*4 f1
        character*50 f2
      end structure
      record /t1/buf(*)
      integer*4 bufsiz
      include 'sqlr$fortran:sqlrdef.for'
      integer*8 curs,row,temp
      integer*4 stat,count,slen
      character*50 s
c  get cursor
      call sqlr$cur_alloc(con,curs)
c  execute
      stat=sqlr$cur_sendquery(curs,'select f1,f2 from t1')
      if(mod(stat,2).eq.0) call curs_exit(curs)
c  process result
      count=0
      call sqlr$cur_setresultsetbuffersize(curs,100)
      row=0
      count=0
100   if(count.ge.bufsiz) goto 200
      stat=sqlr$cur_getfieldbyindex(curs,row,0,s,slen)
      if(mod(stat,2).eq.0) goto 200
      count=count+1
      call sqlr$cur_getfieldasintbyind(curs,row,0,temp)
      buf(count).f1=temp
      call sqlr$cur_getfieldbyindex(curs,row,1,s,slen)
      buf(count).f2=s(1:slen)
      row=row+1
      goto 100
200   call sqlr$con_endsession(con)
c  close cursor
      call sqlr$cur_free(curs)
      t1_get_all=count
      return
      end
c******** add record
      subroutine t1_put(con,f1,f2,ph,bn)
      implicit none
      integer*8 con
      integer*4 f1
      character*(*) f2
      external ph,bn
      character*32 ph,bn
      include 'sqlr$fortran:sqlrdef.for'
      integer*4 stat,res
      integer*8 curs,temp,n
c  get cursor
      call sqlr$cur_alloc(con,curs)
c  prepare
      call sqlr$cur_preparequery(curs,'INSERT INTO t1 VALUES('//
     +                                ph('1','f1','int')//','//
     +                                ph('2','f2','text')//')')
c  bind parameters
      temp=f1
      call sqlr$cur_inputbindlong(curs,bn('1','f1'),temp)
      call sqlr$cur_inputbindstring(curs,bn('2','f2'),f2,len(f2))
c  execute
      stat=sqlr$cur_executequery(curs,res)
      if (mod(stat,2).eq.0) callcurs_exit(curs)
      call sqlr$cur_affectedrows(curs,n)
      if(n.ne.1) call other_exit('INSERT did not insert 1 row')
      call sqlr$con_endsession(con)
c  close cursor
      call sqlr$cur_free(curs)
      return
      end
c******** delete record
      subroutine t1_remove(con,f1,ph,bn)
      implicit none
      integer*8 con
      integer*4 f1
      external ph,bn
      character*32 ph,bn
      include 'sqlr$fortran:sqlrdef.for'
      integer*4 stat,res
      integer*8 curs,temp,n
c  get cursor
      call sqlr$cur_alloc(con,curs)
c  prepare
      call sqlr$cur_preparequery(curs,'DELETE FROM t1 WHERE f1 = '//
     +                                ph('1','f1','int'))
c  bind parameters
      temp=f1
      call sqlr$cur_inputbindlong(curs,bn('1','f1'),temp)
c  execute
      stat=sqlr$cur_executequery(curs,res)
      if (mod(stat,2).eq.0) callcurs_exit(curs)
      call sqlr$cur_affectedrows(curs,n)
      if(n.ne.1) call other_exit('DELETE did not delete 1 row')
      call sqlr$con_endsession(con)
c  close cursor
      call sqlr$cur_free(curs)
      return
      end
c******** error handling functions
      subroutine con_exit(con)
      implicit none
      integer*8 con
      integer*4 msglen
      character*1024 msg
      call sqlr$con_errormessage(con,msg,msglen)
      write(*,*) 'SQLR connection error: ',msg(1:msglen)
      stop
      end
c********
      subroutine curs_exit(curs)
      implicit none
      integer*8 curs
      integer*4 msglen
      character*1024 msg
      call sqlr$cur_errormessage(curs,msg,msglen)
      write(*,*) 'SQLR cursor error: ',msg(1:msglen)
      stop
      end
c********
      subroutine other_exit(msg)
      implicit none
      character*(*) msg
      write(*,*) msg
      stop
      end
c******** standard (ODBC, DB2, MySQL)
      character*32 function std_ph(num,nam,typ)
      character*(*) num,nam,typ
      std_ph='?'
      return
      end
c********
      character*32 function std_bn(num,nam)
      character*(*) num,nam
      std_bn=num
      return
      end
c******** PostgreSQL
      character*32 function pgsql_ph(num,nam,typ)
      character*(*) num,nam,typ
      pgsql_ph='$'//num//'::'//typ
      return
      end
c********
      character*32 function pgsql_bn(num,nam)
      character*(*) num,nam
      pgsql_bn=num
      return
      end
c******** Oracle
      character*32 function ora_ph(num,nam,typ)
      character*(*) num,nam,typ
      ora_ph=':'//nam
      return
      end
c********
      character*32 function ora_bn(num,nam)
      character*(*) num,nam
      ora_bn=nam
      return
      end

Build:

$ for sqlr
$ link sqlr + sys$input/option
sqlr$shr/share
$
$ exit

Embedded SQL:

VMS SQL Relay client comes with embedded SQL pre-compilers. Currently in beta status. Currently only for C and Cobol. Currently only for Oracle (other databases have problems with parameters).

Demo code in C:

/* standard C headers */
#include <stdio.h>
#include <stdlib.h>
#include <string.h>

/* embedded SQL headers */
EXEC SQL INCLUDE SQLCA;

#define F2_MAX_LEN 50
#define MAX_REC 100

/* table structure */
struct t1
{
    int f1;
    char f2[F2_MAX_LEN + 1];
};

/* error handling functions */
void sql_exit(char *sql)
{
    printf("SQL error in %s: %s\n", sql, sqlca.sqlerrm.sqlerrmc);
    exit(1);
}

void other_exit(char *msg)
{
    printf("%s\n", msg);
    exit(1);
}

/* get f1 given f2 */
int t1_get_one(char *f2)
{
    EXEC SQL BEGIN DECLARE SECTION;
    char inf2[51];
    long int outf1;
    EXEC SQL END DECLARE SECTION;
    /* open cursor */
    strcpy(inf2, f2);
    EXEC SQL DECLARE cone CURSOR FOR SELECT f1 FROM t1 WHERE f2 = :inf2;
    if(sqlca.sqlcode != 0) sql_exit("declare cursor");
    EXEC SQL OPEN cone;
    if(sqlca.sqlcode != 0) sql_exit("open cursor");
    /* read from cursor */
    EXEC SQL FETCH cone INTO :outf1;
    if(sqlca.sqlcode != 0)
    {
        other_exit("Row not found");
    }
    /* close cursor */
    EXEC SQL CLOSE cone;
    return outf1;
}

/* get all records */
int t1_get_all(struct t1 *buf, int bufsiz)
{
    EXEC SQL BEGIN DECLARE SECTION;
    char f2[51];
    long int f1;
    EXEC SQL END DECLARE SECTION;
    int count;
    /* open cursor */
    EXEC SQL DECLARE call CURSOR FOR SELECT f1,f2 FROM t1;
    if(sqlca.sqlcode != 0) sql_exit("declare cursor");
    EXEC SQL OPEN call;
    if(sqlca.sqlcode != 0) sql_exit("open cursor");
    /* read from cursor */
    count = 0;
    for(;;)
    {
        if(count >= bufsiz) break;
        EXEC SQL FETCH call INTO :f1, :f2;
        if(sqlca.sqlcode != 0) break;
        buf[count].f1 = f1;
        strcpy(buf[count].f2, f2);
        count++;
    }
    /* close cursor */
    EXEC SQL CLOSE call;
    return count;
}

/* add record */
void t1_put(int f1, char *f2)
{
    EXEC SQL BEGIN DECLARE SECTION;
    char insf2[51];
    long int insf1;
    EXEC SQL END DECLARE SECTION;
    /* execute */
    insf1 = f1;
    strcpy(insf2, f2);
    EXEC SQL INSERT INTO t1 VALUES(:insf1, :insf2);
    if(sqlca.sqlcode != 0) sql_exit("insert");
    /* check if OK */
    if(sqlca.sqlerrd[2] != 1)
    {
        other_exit("INSERT did not insert 1 row");
    }
}

/* delete record */
void t1_remove(int f1)
{
    EXEC SQL BEGIN DECLARE SECTION;
    long int delf1;
    EXEC SQL END DECLARE SECTION;
    /* execute */
    delf1 = f1;
    EXEC SQL DELETE FROM t1 WHERE f1 = :delf1;
    if(sqlca.sqlcode != 0) sql_exit("delete");
    /* check if OK */
    if(sqlca.sqlerrd[2] != 1)
    {
        other_exit("DELETE did not delete 1 row");
    }
}

/* print all records */
void t1_dump()
{
    struct t1 buf[MAX_REC];
    int i, n;
    n = t1_get_all(buf, MAX_REC);
    for(i = 0; i < n; i++)
    {
        printf("%d \"%s\"\n", buf[i].f1, buf[i].f2);
    }
}

int main()
{
    EXEC SQL BEGIN DECLARE SECTION;
    char srv[50];
    char un[50];
    char pw[50];
    EXEC SQL END DECLARE SECTION;
    int f1;
    /* get connection */
    strcpy(srv, "arnepc4:9004");
    strcpy(un, "arne");
    strcpy(pw, "topsecret");
    EXEC SQL CONNECT :un IDENTIFIED BY :pw USING :srv;
    if(sqlca.sqlcode != 0) sql_exit("connect");
    /* test t1_get_one */
    f1 = t1_get_one("BB");
    printf("%d\n", f1);
    /* test t1_get_all */
    t1_dump();
    /* test t1_put */
    t1_put(999, "XXX");
    t1_dump();
    /* test t1_remove */
    t1_remove(999);
    t1_dump();
    return 0;
}

The code is the same as in C/C++ Database Access.

Build:

$ presqlr :== $sqlr$root:[bin]presqlr.exe
$ presqlr /lang=c /iname=pre.pc /oname=pre.c
$ cc pre
$ link pre + sys$input/option
sqlr$shr/share
sqlr$libesql_shr/share
$
$ exit

Build in case precompiler insert Cobol style comments at the top (happended for me with M release on Alpha):

$ presqlr :== $sqlr$root:[bin]presqlr.exe
$ presqlr /lang=c /iname=pre.pc /oname=pre.c
$ define/user sys$input sys$command
$ edit/edt/command=x.edt pre.c
$ cc pre
$ link pre + sys$input/option
sqlr$shr/share
sqlr$libesql_shr/share
$
$ exit

x.edt:

d
d
d
exit

Demo code in Cobol:

IDENTIFICATION DIVISION.
PROGRAM-ID. PRE2.

ENVIRONMENT DIVISION.

DATA DIVISION.
WORKING-STORAGE SECTION.
EXEC SQL INCLUDE SQLCA END-EXEC.
01 SRV PIC X(50).
01 UN PIC X(50).
01 PW PIC X(50).
01 F1RES PIC 9(9) DISPLAY.
01 TEMPF1 PIC S9(9) COMP-5.
01 TEMPF2 PIC X(50).
01 C PIC S9(9).
01 BUF.
   03 F1 PIC 9(9) DISPLAY OCCURS 50 TIMES.
   03 F2 PIC X(50) OCCURS 50 TIMES.
01 ERRMSG PIC X(50).
01 DONE-FLAG PIC X(1).
01 I PIC S9(9).

PROCEDURE DIVISION.
MAIN-PARAGRAPH.
    MOVE "arnepc4:9004" TO SRV.
    MOVE "arne" TO UN.
    MOVE "topsecret" TO PW.
    EXEC SQL CONNECT :UN IDENTIFIED BY :PW USING :SRV END-EXEC.
    MOVE "BB" TO TEMPF2
    PERFORM T1-GET-ONE-PARAGRAPH.
    DISPLAY F1RES.
    PERFORM DUMP-ALL-PARAGRAPH.
    MOVE 999 TO TEMPF1
    MOVE "XXX" TO TEMPF2
    PERFORM T1-PUT-PARAGRAPH.
    PERFORM DUMP-ALL-PARAGRAPH.
    MOVE 999 TO TEMPF1
    PERFORM T1-REMOVE-PARAGRAPH.
    PERFORM DUMP-ALL-PARAGRAPH.
    STOP RUN.
DUMP-ALL-PARAGRAPH.
    PERFORM T1-GET-ALL-PARAGRAPH.
    PERFORM VARYING I FROM 1 BY 1 UNTIL I > C
      DISPLAY F1(I) " " F2(I)
    END-PERFORM.
T1-GET-ONE-PARAGRAPH.
    EXEC SQL DECLARE cone CURSOR FOR SELECT f1 FROM t1 WHERE f2 = TRIM(:tempf2) END-EXEC.
    IF NOT SQLCODE = 0 THEN
      MOVE "declare cursor" TO ERRMSG
      PERFORM SQL-EXIT-PARAGRAPH
    END-IF.
    EXEC SQL OPEN cone END-EXEC.
    IF NOT SQLCODE = 0 THEN
      MOVE "open cursor" TO ERRMSG
      PERFORM SQL-EXIT-PARAGRAPH
    END-IF.
    EXEC SQL FETCH cone INTO :tempf1 END-EXEC
    IF NOT SQLCODE = 0 THEN
      MOVE "Row not found" TO ERRMSG
      PERFORM OTHER-EXIT-PARAGRAPH
    END-IF
    EXEC SQL CLOSE cone END-EXEC.
    MOVE TEMPF1 TO F1RES.
T1-GET-ALL-PARAGRAPH.
**** Not sure why it is needed to init SQLCODE but it is
    MOVE 0 TO SQLCODE.
    EXEC SQL DECLARE call CURSOR FOR SELECT f1,f2 FROM t1 END-EXEC.
    IF NOT SQLCODE = 0 THEN
      MOVE "declare cursor" TO ERRMSG
      PERFORM SQL-EXIT-PARAGRAPH
    END-IF.
    EXEC SQL OPEN call END-EXEC.
    IF NOT SQLCODE = 0 THEN
      MOVE "open cursor" TO ERRMSG
      PERFORM SQL-EXIT-PARAGRAPH
    END-IF.
    MOVE 'N' TO DONE-FLAG.
    MOVE 0 TO C
    PERFORM UNTIL DONE-FLAG = 'Y'
      EXEC SQL FETCH call INTO :tempf1, :tempf2 END-EXEC
      IF SQLCODE = 0 THEN
        COMPUTE C = C + 1
        MOVE TEMPF1 TO F1(C)
        MOVE TEMPF2 TO F2(C)
      ELSE
        MOVE 'Y' TO DONE-FLAG
      END-IF
    END-PERFORM.
    EXEC SQL CLOSE call END-EXEC.
T1-PUT-PARAGRAPH.
    EXEC SQL INSERT INTO t1 VALUES(:tempf1,TRIM(:tempf2)) END-EXEC.
    IF NOT SQLCODE = 0 THEN
      MOVE "INSERT did not insert 1 row" TO ERRMSG
      PERFORM OTHER-EXIT-PARAGRAPH
    END-IF.
T1-REMOVE-PARAGRAPH.
    EXEC SQL DELETE FROM t1 WHERE f1 = :tempf1 END-EXEC.
    IF NOT SQLCODE = 0 THEN
      MOVE "INSERT did not insert 1 row" TO ERRMSG
      PERFORM OTHER-EXIT-PARAGRAPH
    END-IF.
SQL-EXIT-PARAGRAPH.
    DISPLAY "SQL error in " ERRMSG ": " SQLERRMC
    STOP RUN.
OTHER-EXIT-PARAGRAPH.
    DISPLAY ERRMSG
    STOP RUN.

Build:

$ presqlr :== $sqlr$root:[bin]presqlr.exe
$ presqlr /lang=cob /iname=pre2.pco /oname=pre2.cob
$ cobol pre2
$ link pre2 + sys$input/option
sqlr$shr/share
sqlr$libesql_shr/share
$
$ exit

I am not a Cobol programmer so the above Cobol may not be optimal and may not feel true Cobolish. Hopefully the point about the usage of embedded SQL gets through.

Conclusion:

SQL Relay is a very interesting technology for VMS. It enables VMS applications to access almost any database.

I see 3 major reasons to use SQL Relay on VMS:

Access to databases without a VMS client library or without a supported VMS client library
Ability to use same API to access all databases enabling database independent code
Full support for other native languages than C and C++: Cobol, Fortran, Pascal, Basic

Of course there are also some operational aspects. This article has focused on access and API's. Production usage will need to look at security and reliability as well. But SQL Relay should support SSL and various redundancy models.

Links to start reading:

Article history:

Version	Date	Description
1.0	June 6th 2021	Initial version
1.1	June 11th 2021	Add embedded SQL examples

Comments:

Please send comments to Arne Vajhøj

VMS Tech Demo 2 - SQL Relay

Content:

Introduction:

Background:

Setup:

C API:

C++ API:

VMS API:

Embedded SQL:

Conclusion:

Article history:

Other articles:

Comments: