/*!*****************************************************
*
*    ex14.c
*    ======
*
*    EXdbop();      Interface routine for DB_OPEN
*    EXdbbg();      Interface routine for DB_BEGIN
*    EXdbsl();      Interface routine for DB_SELECT
*    EXdbfi();      Interface routine for DB_FETCHI
*    EXdbff();      Interface routine for DB_FETCHF
*    EXdbfs();      Interface routine for DB_FETCHS
*    EXdbnx();      Interface routine for DB_NEXT
*    EXdbup();      Interface routine for DB_UPDATE
*    EXdbin();      Interface routine for DB_INSERT
*    EXdbdl();      Interface routine for DB_DELETE
*    EXdben();      Interface routine for DB_END
*    EXdbrl();      Interface routine for DB_ROLLBACK
*
*    EXdbcl();      Interface routine for DB_CLOSE
*
*    blrini();      Initiera nytt BLR-statement
*    blrend();      Avslutar BLR-statement
*    blrfld();      Skapar FIELD-statement
*    blrlit();      Skapar BLR-literal
*    blrfor();      Skapa  RSE-delen i FOR-statement
*    blrmes();      Skapa message-delen i BLR-statement
*    rdberr();      Hantering av vissa RDB-fel
*
*    This file is part of the VARKON Execute Library.
*    URL:  http://www.varkon.com
*
*    This library is free software; you can redistribute it and/or
*    modify it under the terms of the GNU Library General Public
*    License as published by the Free Software Foundation; either
*    version 2 of the License, or (at your option) any later version.
*
*    This library is distributed in the hope that it will be useful,
*    but WITHOUT ANY WARRANTY; without even the implied warranty of
*    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
*    Library General Public License for more details.
*
*    You should have received a copy of the GNU Library General Public
*    License along with this library; if not, write to the Free
*    Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
*
*    (C)Microform AB 1984-1998, Johan Kjellander, johan@microform.se
*
*********************************************************/

#include "../../DB/include/DB.h"
#include "../../IG/include/IG.h"

/*******************************************************!*/

#ifdef VMS

unsigned long dbhndl = NULL;

/* Database handle. NULL=> Databasen ej öppen. */


unsigned long trhndl;
char accmod;

/* Transaction handle. Initieras till NULL av DB_OPEN.
   får värde av DB_BEGIN och nollställs av DB_END och
   DB_ROLLBACK. accmod = R/W.  */


unsigned long rehndl;

/* Request handle för DB_UPDATE, DB_NSERT och DB_DELETE. */


unsigned long slhndl;

/* Request handle för DB_SELECT. */


char mesbuf[1640];
unsigned short messiz;

/* Meddelandebuffer för mottagande av data från RDB.
   Max 20 värden om max 82 tecken = 1640. Aktivt meddelande
   är messiz stort. */

short mestyp[21];
char *mespek[21];
short mesant;

/* mesant meddelanden av typen mestyp på platserna mespek finns i mesbuf */


#define MAXBLR 500
unsigned char blrbuf[MAXBLR];
unsigned char *blrpek;

/* Buffer och pekare för BLR-statements */

/*
***Externa RDB/VMS-databasrutiner.
*/
extern int RDB$ATTACH_DATABASE();
extern int RDB$START_TRANSACTION();
extern int RDB$COMPILE_REQUEST();
extern int RDB$START_REQUEST();
extern int RDB$RECEIVE();
extern int RDB$RELEASE_REQUEST();
extern int RDB$COMMIT_TRANSACTION();
extern int RDB$ROLLBACK_TRANSACTION();
extern int RDB$DETACH_DATABASE();
/*
***Externa V3-rutiner.
*/
extern short erpush();

#endif

/*!******************************************************/

        short EXdbop(
        char  *namn,
        DBint *status)
 
/*      Interface-rutin för DB_OPEN.
 *
 *      In:  namn   => Pekare till databasens namn.
 *           status => Pekare till returstatus.
 *
 *      Ut:  *status => Status från databasen.
 *
 *      Felkoder: EX3012 = Databas redan öppen.
 *
 *      (C)microform ab 12/5/87 J. Kjellander
 *
 ******************************************************!*/

  {
#ifdef VMS

    long mesvec[20];
    short errsev;
    struct dsc$descriptor_s dbnam;

/*
***Kontroll av indata.
*/
    if ( dbhndl != NULL ) return(erpush("EX3012",namn));
/*
***Lite initiering.
*/
   trhndl = NULL;
/*
***Descriptor för databasnamnet.
*/
   dbnam.dsc$w_length = strlen(namn);
   dbnam.dsc$a_pointer = namn;
   dbnam.dsc$b_class = DSC$K_CLASS_S;
   dbnam.dsc$b_dtype = DSC$K_DTYPE_T;
/*
***Anropa RDB.
*/
   *status = RDB$ATTACH_DATABASE(mesvec,&dbnam,&dbhndl,NULL,NULL);
   if ( (errsev=rdberr("DB_OPEN",*status)) < 0 ) return(errsev);

#endif
   return(0);
  }

/********************************************************/
/*!******************************************************/

        short EXdbbg(
        char  *mode,
        DBint *status)
 
/*      Interface-rutin för DB_BEGIN.
 *
 *      In:  mode   = Pekare till R/W
 *           status = Pekare till returstatus.
 *
 *      Ut:  *status => Status från databasen.
 *
 *      Felkoder: EX3022 = Databasen ej öppnad.
 *                EX3052 = Transaktion redan startad.
 *                EX3002 = Okänd mode.
 *
 *      (C)microform ab 12/5/87 J. Kjellander
 *
 ******************************************************!*/

  {
#ifdef VMS

    long mesvec[20];
    char tpb[2];
    short errsev;

/*
***Kontroll av indata.
*/
    if ( dbhndl == NULL ) return(erpush("EX3022","DB_BEGIN"));
    if ( trhndl != NULL ) return(erpush("EX3052","DB_BEGIN"));
/*
***Acess mode.
*/
    if ( *mode == 'R' || *mode == 'r' ) accmod = 'R';
    else if ( *mode == 'W' || *mode == 'w' ) accmod = 'W';
    else return(erpush("EX3002",mode));
/*
***Transaction parameter block.
*/
   tpb[0] = TPB$K_VERSION1;
   if ( accmod == 'R' ) tpb[1] = TPB$K_READ;
   else tpb[1] = TPB$K_WRITE;
/*
***Anropa RDB.
*/
    *status = RDB$START_TRANSACTION(mesvec,&trhndl,(unsigned short)1,
                                    &dbhndl,(unsigned long)2,tpb);
   if ( (errsev=rdberr("DB_BEGIN",*status)) < 0 ) return(errsev);
/*
***Inget select aktivt.
*/
    slhndl = NULL;

#endif
    return(0);
  }

/********************************************************/
/*!******************************************************/

        short EXdbsl(
        char    *tab,
        char    *kol1,
        PMLITVA *val1,
        char    *kol2,
        PMLITVA *val2,
        PMPARVA *pv,
        DBshort  nkol,
        DBint   *status)
 
/*      Interface-rutin för DB_SELECT.
 *
 *      In:  tab    = Pekare till tabellnamn.
 *           kol1   = Pekare till kolumn 1:s namn.
 *           val1   = Pekare till kolumn 1:s värde.
 *           kol2   = Pekare till kolumn 2:s namn.
 *           val2   = Pekare till kolumn 2:s värde.
 *           pv     = Pekare till ut-kolumners namn.
 *           nkol   = Antal ut-kolumner.
 *           status = Pekare till status-resultat.
 *
 *      Ut:  *status => Status från databasen.
 *
 *      Felkoder: EX3022 = Databasen ej öppnad.
 *                EX3042 = Transaktion ej startad.
 *
 *      (C)microform ab 12/5/87 J. Kjellander
 *
 *      18/4/88  Instantiation par = 0, J. Kjellander
 *
 ******************************************************!*/

  {
#ifdef VMS

    register short i;
    short          errsev;
    long           mesvec[20];
    unsigned short blrsiz;
    PMLITVA        eof;

/*
***Kontroll av indata.
*/
    if ( dbhndl == NULL ) return(erpush("EX3022","DB_SELECT"));
    if ( trhndl == NULL ) return(erpush("EX3042","DB_SELECT"));
/*
***Om select-request aktivt, gör release.
*/
    if ( slhndl != NULL )
      {
      *status = RDB$RELEASE_REQUEST(mesvec,&slhndl);
      if ( (errsev=rdberr("DB_SELECT",*status)) < 0 ) return(errsev);
      }
/*
***Skapa BLR-statement.
*/
    blrini();
    blrmes(nkol,pv);
    blrfor(tab,kol1,val1,kol2,val2);
/*
***FOR-loopens send.
*/
    *blrpek = BLR$K_SEND;            ++blrpek;
    *blrpek = 0;                     ++blrpek;
    *blrpek = BLR$K_BEGIN;           ++blrpek;

    for ( i=0; i<nkol; ++i )
      {
      *blrpek = BLR$K_ASSIGNMENT;      ++blrpek;
      blrfld(pv[2*i].par_va.lit.str_va,1);
      *blrpek = BLR$K_PARAMETER;       ++blrpek;
      *blrpek = 0;                     ++blrpek;
      *blrpek = (char)i;               ++blrpek;
      *blrpek = 0;                     ++blrpek;
      }

    *blrpek = BLR$K_ASSIGNMENT;      ++blrpek;
    eof.lit_type = C_INT_VA;
    eof.lit.int_va = 0;
    blrlit(&eof);
    *blrpek = BLR$K_PARAMETER;       ++blrpek;
    *blrpek = 0;                     ++blrpek;
    *blrpek = (char)nkol;            ++blrpek;
    *blrpek = 0;                     ++blrpek;
    *blrpek = BLR$K_END;             ++blrpek;
    *blrpek = BLR$K_END;             ++blrpek;
/*
***Sista SEND.
*/
    *blrpek = BLR$K_SEND;            ++blrpek;
    *blrpek = 0;                     ++blrpek;
    *blrpek = BLR$K_ASSIGNMENT;      ++blrpek;
    eof.lit_type = C_INT_VA;
    eof.lit.int_va = -1;
    blrlit(&eof);
    *blrpek = BLR$K_PARAMETER;       ++blrpek;
    *blrpek = 0;                     ++blrpek;
    *blrpek = (char)nkol;            ++blrpek;
    *blrpek = 0;                     ++blrpek;

    blrend();
/*
***Kompilera request, använd slhndl som handtag.
*/
    blrsiz = blrpek - blrbuf;
    *status = RDB$COMPILE_REQUEST(mesvec,&dbhndl,&slhndl,blrsiz,blrbuf);
    if ( (errsev=rdberr("DB_SELECT",*status)) < 0 ) return(errsev);
/*
***Utför request.
*/
    *status = RDB$START_REQUEST(mesvec,&slhndl,&trhndl,(unsigned short)0);
    if ( (errsev=rdberr("DB_SELECT",*status)) < 0 ) return(errsev);
/*
***Gör ett första recieve.
*/
    *status = RDB$RECEIVE(mesvec,&slhndl,(unsigned char)0,
                         messiz,mesbuf,(unsigned short)0);
    if ( (errsev=rdberr("DB_SELECT",*status)) < 0 ) return(errsev);

#endif
    return(0);
  }

/********************************************************/
/*!******************************************************/

        short EXdbfi(
        DBshort  pnum,
        DBint   *ival,
        DBint   *status)
 
/*      Interface-rutin för DB_FETCHI.
 *
 *      In:  pnum   = Parameternummer.
 *           ival   = Pekare till värde.
 *           status = Pekare till statusresultat.
 *
 *      Ut:  *ival   => Det lästa heltalet.
 *           *status => Status från databasen.
 *
 *      Felkoder: EX3022 = Databasen ej öppnad.
 *                EX3042 = Transaktion ej startad.
 *                EX3092 = Select-request ej aktivt.
 *
 *      (C)microform ab 12/5/87 J. Kjellander
 *
 ******************************************************!*/

  {
#ifdef VMS
    register char *frompk,*topk;

/*
***Kontroll av indata.
*/
    *status = 0;

    if ( dbhndl == NULL ) return(erpush("EX3022","DB_FETCHI"));
    if ( trhndl == NULL ) return(erpush("EX3042","DB_FETCHI"));
    if ( slhndl == NULL ) return(erpush("EX3092","DB_FETCHI"));
    if ( pnum < 0 || pnum > mesant ) return(erpush("EX3122","DB_FETCHI"));
/*
***Beräkna adress i mesbuf.
*/
    if ( pnum == 0 )
     {
     frompk = mespek[mesant];
     }
    else
     {
     frompk = mespek[pnum-1];
     if ( mestyp[pnum-1] != C_INT_VA ) return(erpush("EX3132","DB_FETCHI"));
     }
/*
***Returnera värde.
*/
    topk = (char *)ival;

    *topk = *frompk;   ++topk;  ++frompk;
    *topk = *frompk;   ++topk;  ++frompk;
    *topk = *frompk;   ++topk;  ++frompk;
    *topk = *frompk;

    *status = 1;

#endif
    return(0);
  }

/********************************************************/
/*!******************************************************/

        short EXdbff(
        DBshort  pnum,
        DBfloat *fval,
        DBint   *status)
 
/*      Interface-rutin för DB_FETCHF.
 *
 *      In:  pnum   = Parameternummer.
 *           fval   = Pekare till värde.
 *           status = Pekare till statusresultat.
 *
 *      Ut:  *fval   => Det lästa flyttalet.
 *           *status => Status från databasen.
 *
 *      Felkoder: EX3022 = Databasen ej öppnad.
 *                EX3042 = Transaktion ej startad.
 *                EX3092 = Select-request ej aktivt.
 *
 *      (C)microform ab 12/5/87 J. Kjellander
 *
 ******************************************************!*/

  {
#ifdef VMS
    register char *frompk,*topk;

/*
***Kontroll av indata.
*/
    *status = 0;

    if ( dbhndl == NULL ) return(erpush("EX3022","DB_FETCHF"));
    if ( trhndl == NULL ) return(erpush("EX3042","DB_FETCHF"));
    if ( slhndl == NULL ) return(erpush("EX3092","DB_FETCHF"));
    if ( pnum < 1 || pnum > mesant ) return(erpush("EX3122","DB_FETCHF"));
    if ( mestyp[pnum-1] != C_FLO_VA ) return(erpush("EX3132","DB_FETCHF"));
/*
***Returnera värde.
*/
    frompk = mespek[pnum-1];
    topk = (char *)fval;

    *topk = *frompk;   ++topk;  ++frompk;
    *topk = *frompk;   ++topk;  ++frompk;
    *topk = *frompk;   ++topk;  ++frompk;
    *topk = *frompk;   ++topk;  ++frompk;
    *topk = *frompk;   ++topk;  ++frompk;
    *topk = *frompk;   ++topk;  ++frompk;
    *topk = *frompk;   ++topk;  ++frompk;
    *topk = *frompk;

    *status = 1;

#endif
    return(0);
  }

/********************************************************/
/*!******************************************************/

        short EXdbfs(
        DBshort  pnum,
        char    *sval,
        DBint   *status)
 
/*      Interface-rutin för DB_FETCHS.
 *
 *      In:  pnum   = Parameternummer.
 *           sval   = Pekare till värde.
 *           status = Pekare till statusresultat.
 *
 *      Ut:  *sval   => Den lästa strängen.
 *           *status => Status från databasen.
 *
 *      Felkoder: EX3022 = Databasen ej öppnad.
 *                EX3042 = Transaktion ej startad.
 *                EX3092 = Select-request ej aktivt.
 *                EX3122 = Otillåtet pnum.
 *                EX3132 = Fel typ
 *
 *      (C)microform ab 12/5/87 J. Kjellander
 *
 ******************************************************!*/

  {
#ifdef VMS
    register short i,nchar;
    register char *frompk,*topk;

/*
***Kontroll av indata.
*/
    *status = 0;

    if ( dbhndl == NULL ) return(erpush("EX3022","DB_FETCHS"));
    if ( trhndl == NULL ) return(erpush("EX3042","DB_FETCHS"));
    if ( slhndl == NULL ) return(erpush("EX3092","DB_FETCHS"));
    if ( pnum < 1 || pnum > mesant ) return(erpush("EX3122","DB_FETCHS"));
    if ( mestyp[pnum-1] != C_STR_VA ) return(erpush("EX3132","DB_FETCS"));
/*
***Returnera värde.
*/
    nchar = *(mespek[pnum-1]);
    frompk = mespek[pnum-1] + 2;
    topk = sval;

    for ( i=0; i<nchar; ++i, ++frompk, ++topk ) *topk = *frompk;
    *topk = '\0';

    *status = 1;

#endif
    return(0);
  }

/********************************************************/
/*!******************************************************/

        short EXdbnx(DBint *status)
 
/*      Interface-rutin för DB_NEXT.
 *
 *      In:  status = Pekare till statusresultat.
 *
 *      Ut:  *status => Status från databasen.
 *
 *      Felkoder: EX3022 = Databasen ej öppnad.
 *                EX3042 = Ingen transaktion startad.
 *                EX3092 = Select ej aktivt
 *
 *      (C)microform ab 12/5/87 J. Kjellander
 *
 ******************************************************!*/

  {
#ifdef VMS

    long mesvec[20];
    short errsev;
/*
***Kontroll av läget.
*/
    if ( dbhndl == NULL ) return(erpush("EX3022","DB_NEXT"));
    if ( trhndl == NULL ) return(erpush("EX3042","DB_NEXT"));
    if ( slhndl == NULL ) return(erpush("EX3092","DB_NEXT"));
/*
***Anropa RDB.
*/
    *status = RDB$RECEIVE(mesvec,&slhndl,(unsigned char)0,
                         messiz,mesbuf,(unsigned short)0);
    if ( (errsev=rdberr("DB_NEXT",*status)) < 0 ) return(errsev);

#endif
    return(0);
  }

/********************************************************/
/*!******************************************************/

        short EXdbup(
        char    *tab,
        char    *kol1,
        PMLITVA *val1,
        char    *kol2,
        PMLITVA *val2,
        PMPARVA *pv,
        DBshort  nkol,
        DBint   *status)
 
/*      Interface-rutin för DB_UPDATE.
 *
 *      In:  tab    = Pekare till tabellnamn.
 *           kol1   = Pekare till kolumn 1:s namn.
 *           val1   = Pekare till kolumn 1:s värde.
 *           kol2   = Pekare till kolumn 2:s namn.
 *           val2   = Pekare till kolumn 2:s värde.
 *           pv     = Pekare till nya kolumner och värden.
 *           nkol   = Antal nya kolumner.
 *           status = Pekare till resultat.
 *
 *      Ut:  *status => Status från databasen.
 *
 *      Felkoder: EX3022 = Databasen ej öppnad.
 *                EX3042 = Transaktion ej startad.
 *                EX3032 = Transaktionen är read only.
 *
 *      (C)microform ab 12/5/87 J. Kjellander
 *
 *      18/4/88  Instantiation par = 0, J. Kjellander
 *
 ******************************************************!*/

  {
#ifdef VMS

    register short i;
    long mesvec[20];
    unsigned short blrsiz;
    short errsev;

/*
***Kontroll av indata.
*/
    if ( dbhndl == NULL ) return(erpush("EX3022","DB_UPDATE"));
    if ( trhndl == NULL ) return(erpush("EX3042","DB_UPDATE"));
    if ( accmod != 'W' ) return(erpush("EX3032","DB_UPDATE"));
/*
***Skapa BLR-statement.
*/
    blrini();
    blrfor(tab,kol1,val1,kol2,val2);

    *blrpek = BLR$K_MODIFY;         ++blrpek;
    *blrpek = 1;                    ++blrpek;
    *blrpek = 2;                    ++blrpek;

    *blrpek = BLR$K_BEGIN;          ++blrpek;

    for ( i=0; i<nkol; ++i )
      {
      *blrpek = BLR$K_ASSIGNMENT;      ++blrpek;
      if ( blrlit(&pv[2*i+1].par_va) < 0 )
                  return(erpush("EX3072","DB_UPDATE"));
      blrfld(pv[2*i].par_va.lit.str_va,2);
      }

    *blrpek = BLR$K_END;            ++blrpek;
    *blrpek = BLR$K_END;            ++blrpek;

    blrend();
/*
***Kompilera request.
*/
    blrsiz = blrpek - blrbuf;
    *status = RDB$COMPILE_REQUEST(mesvec,&dbhndl,&rehndl,blrsiz,blrbuf);
    if ( (errsev=rdberr("DB_UPDATE",*status)) < 0 ) return(errsev);
/*
***Utför request.
*/
    *status = RDB$START_REQUEST(mesvec,&rehndl,&trhndl,(unsigned short)0);
    if ( (errsev=rdberr("DB_UPDATE",*status)) < 0 ) return(errsev);
/*
***Releas:a requestet.
*/
    *status = RDB$RELEASE_REQUEST(mesvec,&rehndl);
    if ( (errsev=rdberr("DB_UPDATE",*status)) < 0 ) return(errsev);

#endif
    return(0);
  }

/********************************************************/
/*!******************************************************/

        short EXdbin(
        char    *tab,
        PMPARVA *pv,
        DBshort  nkol,
        DBint   *status)
 
/*      Interface-rutin för DB_INSERT.
 *
 *      In:  tab    = Pekare till tabellnamn.
 *           pv     = Pekare till PMPARVA-parametrar.
 *           nkol   = Antal kolumner.
 *           status = Pekare till utdata.
 *
 *      Ut:  *status => Status från databasen.
 *
 *      Felkoder: EX3022 = Databasen ej öppnad.
 *                EX3042 = Transaktion ej startad.
 *                EX3032 = Transaktionen är read only.
 *                EX3072 = Otillåten datatyp.
 *
 *      (C)microform ab 12/5/87 J. Kjellander
 *
 *      18/4/88  Instantiation par = 0, J. Kjellander
 *
 ******************************************************!*/

  {
#ifdef VMS

    register short i;
    long mesvec[20];
    short errsev;
    unsigned short blrsiz;

/*
***Kontroll av indata.
*/
    if ( dbhndl == NULL ) return(erpush("EX3022","DB_INSERT"));
    if ( trhndl == NULL ) return(erpush("EX3042","DB_INSERT"));
    if ( accmod != 'W' ) return(erpush("EX3032","DB_INSERT"));
/*
***Skapa BLR-statement.
*/
    blrini();

    *blrpek = BLR$K_STORE;          ++blrpek;
    blrrel(tab);

    *blrpek = BLR$K_BEGIN;          ++blrpek;

     for ( i=0; i<nkol; ++i )
       {
       *blrpek = BLR$K_ASSIGNMENT;               ++blrpek;
       if ( blrlit(&pv[2*i+1].par_va) < 0 )
                   return(erpush("EX3072","DB_INSERT"));
       blrfld(pv[2*i].par_va.lit.str_va,1);
       }

    *blrpek = BLR$K_END;            ++blrpek;

    blrend();
/*
***Kompilera request.
*/
    blrsiz = blrpek - blrbuf;
    *status = RDB$COMPILE_REQUEST(mesvec,&dbhndl,&rehndl,blrsiz,blrbuf);
    if ( (errsev=rdberr("DB_INSERT",*status)) < 0 ) return(errsev);
/*
***Utför request.
*/
    *status = RDB$START_REQUEST(mesvec,&rehndl,&trhndl,(unsigned short)0);
    if ( (errsev=rdberr("DB_INSERT",*status)) < 0 ) return(errsev);
/*
***Releas:a requestet.
*/
    *status = RDB$RELEASE_REQUEST(mesvec,&rehndl);
    if ( (errsev=rdberr("DB_INSERT",*status)) < 0 ) return(errsev);

#endif
    return(0);
  }

/********************************************************/
/*!******************************************************/

        short EXdbdl(
        char    *tab,
        char    *kol1,
        PMLITVA *val1,
        char    *kol2,
        PMLITVA *val2,
        DBint   *status)
 
/*      Interface-rutin för DB_DELETE.
 *
 *      In:  tab    = Pekare till tabellnamn.
 *           kol1   = Pekare till kolumn 1:s namn.
 *           val1   = Pekare tiil kolumn 1:s värde.
 *           kol2   = Pekare till kolumn 2:s namn.
 *           val2   = Pekare tiil kolumn 2:s värde.
 *           status = Pekare till resultat.
 *
 *      Ut:  *status => Status från databasen.
 *
 *      Felkoder: EX3022 = Databasen ej öppnad.
 *                EX3042 = Transaktion ej startad.
 *                EX3032 = Transaktionen är read only.
 *
 *      (C)microform ab 12/5/87 J. Kjellander
 *
 *      18/4/88  Instantiation par = 0, J. Kjellander
 *
 ******************************************************!*/

  {
#ifdef VMS

    long mesvec[20];
    unsigned short blrsiz;
    short errsev;

/*
***Kontroll av indata.
*/
    if ( dbhndl == NULL ) return(erpush("EX3022","DB_DELETE"));
    if ( trhndl == NULL ) return(erpush("EX3042","DB_DELETE"));
    if ( accmod != 'W' ) return(erpush("EX3032","DB_DELETE"));
/*
***Skapa BLR-statement.
*/
    blrini();
    blrfor(tab,kol1,val1,kol2,val2);

    *blrpek = BLR$K_ERASE;          ++blrpek;
    *blrpek = 1;                    ++blrpek;
    *blrpek = BLR$K_END;            ++blrpek;

    blrend();
/*
***Kompilera request.
*/
    blrsiz = blrpek - blrbuf;
    *status = RDB$COMPILE_REQUEST(mesvec,&dbhndl,&rehndl,blrsiz,blrbuf);
    if ( (errsev=rdberr("DB_DELETE",*status)) < 0 ) return(errsev);
/*
***Utför request.
*/
    *status = RDB$START_REQUEST(mesvec,&rehndl,&trhndl,(unsigned short)0);
    if ( (errsev=rdberr("DB_DELETE",*status)) < 0 ) return(errsev);
/*
***Releas:a requestet.
*/
    *status = RDB$RELEASE_REQUEST(mesvec,&rehndl);
    if ( (errsev=rdberr("DB_DELETE",*status)) < 0 ) return(errsev);

#endif
    return(0);
  }

/********************************************************/
/*!******************************************************/

        short EXdben(DBint *status)
 
/*      Interface-rutin för DB_END.
 *
 *      In:  status = Pekare till statusresultat.
 *
 *      Ut:  *status => Status från databasen.
 *
 *      Felkoder: EX3022 = Databasen ej öppnad.
 *                EX3042 = Ingen transaktion startad.
 *
 *      (C)microform ab 12/5/87 J. Kjellander
 *
 ******************************************************!*/

  {
#ifdef VMS

    long mesvec[20];
    short errsev;

/*
***Kontroll av läget.
*/
    if ( dbhndl == NULL ) return(erpush("EX3022","DB_END"));
    if ( trhndl == NULL ) return(erpush("EX3042","DB_END"));
/*
***Anropa RDB.
*/
    *status = RDB$COMMIT_TRANSACTION(mesvec,&trhndl);
    if ( (errsev=rdberr("DB_END",*status)) < 0 ) return(errsev);
/*
***Ingen transaktion aktiv längre.
*/
    trhndl = NULL;

#endif
    return(0);
  }

/********************************************************/
/*!******************************************************/

        short EXdbrl(DBint *status)
 
/*      Interface-rutin för DB_ROLLBACK.
 *
 *      In:  status = Pekare till returstatus.
 *
 *      Ut:  *status => Status från databasen.
 *
 *      Felkoder: EX3022 = Databasen ej öppnad.
 *                EX3042 = Transaktion ej startad.
 *
 *      (C)microform ab 12/5/87 J. Kjellander
 *
 ******************************************************!*/

  {
#ifdef VMS

    long mesvec[20];
    short errsev;

/*
***Kontroll av läget.
*/
    if ( dbhndl == NULL ) return(erpush("EX3022","DB_ROLLBACK"));
    if ( trhndl == NULL ) return(erpush("EX3042","DB_ROLLBACK"));
/*
***Anropa RDB.
*/
    *status = RDB$ROLLBACK_TRANSACTION(mesvec,&trhndl);
    if ( (errsev=rdberr("DB_ROLLBACK",*status)) < 0 ) return(errsev);
/*
***Ingen transaktion aktiv längre.
*/
    trhndl = NULL;

#endif
    return(0);
  }

/********************************************************/
/*!******************************************************/

        short EXdbcl(DBint *status)
 
/*      Interface-rutin för DB_CLOSE.
 *
 *      In:  status = Pekare till resultat.
 *
 *      Ut:  *status => Status från databasen.
 *
 *      Felkoder: EX3022 = Databasen ej öppnad.
 *                EX3052 = Transaktion aktiv.
 *                EX3082 = Kan ej stänga databasen.
 *
 *      (C)microform ab 12/5/87 J. Kjellander
 *
 ******************************************************!*/

  {
#ifdef VMS

    long mesvec[20];
    short errsev;

/*
***Kontroll av indata.
*/
    if ( dbhndl == NULL ) return(erpush("EX3022","DB_CLOSE"));
    if ( trhndl != NULL ) return(erpush("EX3052","DB_CLOSE"));
/*
***Anropa RDB.
*/
    *status = RDB$DETACH_DATABASE(mesvec,&dbhndl);
    if ( (errsev=rdberr("DB_CLOSE",*status)) < 0 ) return(errsev);
/*
***Kolla att databasen blev stängd.
*/
    if ( dbhndl != NULL ) return(erpush("EX3082","DB_CLOSE"));;

#endif
    return(0);
  }

/********************************************************/

#ifdef VMS

/*!******************************************************/

        static short blrini()
 
/*      Initierar nytt BLR-statement.
 *
 *      In:  Inget.
 *
 *      Ut:  Fyller i blrbuf.
 *
 *      FV:  0  = Ok.
 *
 *      (C)microform ab 20/5/87 J. Kjellander
 *
 ******************************************************!*/

  {
     blrpek = blrbuf;

     *blrpek = BLR$K_VERSION4;   ++blrpek;
     *blrpek = BLR$K_BEGIN;      ++blrpek;

     return(0);
  }

/********************************************************/
/*!******************************************************/

        static short blrend()
 
/*      Avslutar BLR-statement.
 *
 *      In:  Inget.
 *
 *      Ut:  Fyller i blrbuf.
 *
 *      FV:  0  = Ok.
 *
 *      (C)microform ab 20/5/87 J. Kjellander
 *
 ******************************************************!*/

  {

     *blrpek = BLR$K_END;   ++blrpek;
     *blrpek = BLR$K_EOC;   ++blrpek;
     return(0);
  }

/********************************************************/

/*
blrprt()
ä
char *pek = blrbuf;
short code;
FILE *f;

f = fopen("blr.DAT","w");

while ( pek < blrpek )
ä
code = (short)*pek;
fprintf(f,"Kod = %dÖn",code);
++pek;
å

fclose(f);

return(0);
å
*/

/*!******************************************************/

        static short blrrel(tabnam)
        char *tabnam;
 
/*      Skapar ett RELATION-BLR-statement.
 *
 *      In:  tabnam = Pekare till tabellen snamn.
 *
 *      Ut:  Fyller i blrbuf.
 *
 *      FV:  0  = Ok.
 *
 *      (C)microform ab 20/5/87 J. Kjellander
 *
 ******************************************************!*/

  {
    register int n;

    *blrpek = BLR$K_RELATION;       ++blrpek;
    n = strlen(tabnam);
    *blrpek = (char)n;              ++blrpek;
    strcpy(blrpek,tabnam);          blrpek += n;
    *blrpek = 1;                    ++blrpek;

     return(0);
  }

/********************************************************/
/*!******************************************************/

        static short blrfld(kolnam,contxt)
        char *kolnam;
        int  contxt;
 
/*      Skapar ett FIELD-statement.
 *
 *      In:  kolnam = Pekare till kolumnens namn.
 *           contxt = Context-nummer.
 *
 *      Ut:  Fyller i blrbuf.
 *
 *      FV:  0  = Ok.
 *
 *      (C)microform ab 20/5/87 J. Kjellander
 *
 ******************************************************!*/

  {
     register int n;

     *blrpek = BLR$K_FIELD;       ++blrpek;
     *blrpek = (char)contxt;      ++blrpek;
     n = strlen(kolnam);
     *blrpek =  (char)n;          ++blrpek;
     strcpy(blrpek,kolnam);       blrpek += n;

     return(0);
  }

/********************************************************/
/*!******************************************************/

        static short blrlit(val)
        PMLITVA *val;
 
/*      Skapar BLR-Literal Expression.
 *
 *      In:  val = Pekare till PMLITVA med typ och värde.
 *
 *      Ut:  Fyller i blrbuf.
 *
 *      FV:  0  = Ok.
 *          -1  = Otillåten datatyp.
 *
 *      (C)microform ab 17/5/87 J. Kjellander
 *
 ******************************************************!*/

  {
    register char *valpek;

    *blrpek = BLR$K_LITERAL;       ++blrpek;

    switch ( val->lit_type )
      {
      case C_INT_VA:
      *blrpek = BLR$K_DTYPE_L;      ++blrpek;
      *blrpek = 0;                  ++blrpek;
      valpek = &val->lit.int_va;
      *blrpek = *valpek;            ++blrpek; ++valpek;
      *blrpek = *valpek;            ++blrpek; ++valpek;
      *blrpek = *valpek;            ++blrpek; ++valpek;
      *blrpek = *valpek;            ++blrpek; ++valpek;
      break;

      case C_FLO_VA:
      *blrpek = BLR$K_DTYPE_G;      ++blrpek;
      valpek = &val->lit.float_va;
      *blrpek = *valpek;            ++blrpek; ++valpek;
      *blrpek = *valpek;            ++blrpek; ++valpek;
      *blrpek = *valpek;            ++blrpek; ++valpek;
      *blrpek = *valpek;            ++blrpek; ++valpek;
      *blrpek = *valpek;            ++blrpek; ++valpek;
      *blrpek = *valpek;            ++blrpek; ++valpek;
      *blrpek = *valpek;            ++blrpek; ++valpek;
      *blrpek = *valpek;            ++blrpek; ++valpek;
      break;

      case C_STR_VA:
      *blrpek = BLR$K_DTYPE_T;                 ++blrpek;
      *blrpek = (char)strlen(val->lit.str_va); ++blrpek;
      *blrpek = 0;                             ++blrpek;
      strcpy(blrpek,val->lit.str_va);
      blrpek += strlen(val->lit.str_va);
      break;

      default:
      return(-1);
      }

    return(0);
  }

/********************************************************/
/*!******************************************************/

        static short blrfor(tab,kol1,val1,kol2,val2)
        char    *tab;
        char    *kol1;
        PMLITVA *val1;
        char    *kol2;
        PMLITVA *val2;
 
/*      Skapar första delen av en FOR-loop med Record
 *      Selection Expression.
 *
 *      In:  tab  = Pekare till tabellnamn.
 *           kol1 = Pekare till kolumn 1:s namn.
 *           val1 = Pekare till kolumn 1:s värde.
 *           kol2 = Pekare till kolumn 2:s namn.
 *           val2 = Pekare till kolumn 2:s värde.
 *
 *      Ut:  Fyller i blrbuf.
 *
 *      FV:  0  = Ok.
 *          -1  = Otillåten datatyp, val1 eller val2.
 *
 *      (C)microform ab 17/5/87 J. Kjellander
 *
 ******************************************************!*/

  {

    *blrpek = BLR$K_FOR;           ++blrpek;
    *blrpek = BLR$K_RSE;           ++blrpek;
    *blrpek = 1;                   ++blrpek;
    blrrel(tab);
    *blrpek = BLR$K_BOOLEAN;       ++blrpek;

    if ( *kol2 != '\0' )
      {
      *blrpek = BLR$K_AND;           ++blrpek;
      }

    *blrpek = BLR$K_EQL;           ++blrpek;
    blrfld(kol1,1);
    if ( blrlit(val1) < 0 ) return(-1);

    if ( *kol2 != '\0' )
      {
      *blrpek = BLR$K_EQL;           ++blrpek;
      blrfld(kol2,1);
      if ( blrlit(val2) < 0 ) return(-1);
      }

    *blrpek = BLR$K_END;           ++blrpek;
    *blrpek = BLR$K_BEGIN;         ++blrpek;

    return(0);
  }

/********************************************************/
/*!******************************************************/

        static short blrmes(nval,pv)
        short nval;
        PMPARVA *pv;
 
/*      Skapar message för utdata.
 *
 *      In:  nval = Antal värden.
 *           pv   = Pekare till värden..
 *
 *      Ut:  Fyller i blrbuf.
 *
 *      FV:  0  = Ok.
 *          -1  = Otillåten datatyp.
 *
 *      (C)microform ab 17/5/87 J. Kjellander
 *
 ******************************************************!*/

  {
    register short i;

    *blrpek = BLR$K_MESSAGE;         ++blrpek;
    *blrpek = 0;                     ++blrpek;
    *blrpek = (char)nval+1;          ++blrpek;
    *blrpek = 0;                     ++blrpek;

    mesant = nval;
    messiz = 0;
    mespek[0] = mesbuf;

    for ( i=0; i<nval; ++i )
      {
      switch ( pv[2*i+1].par_va.lit.int_va )
        {
        case C_INT_VA:
        mestyp[i] = C_INT_VA;
        messiz += 4;
        mespek[i+1] = mespek[i] + 4;
        *blrpek = BLR$K_DTYPE_L;     ++blrpek;
        *blrpek = 0;                 ++blrpek;
        break;

        case C_FLO_VA:
        mestyp[i] = C_FLO_VA;
        messiz += 8;
        mespek[i+1] = mespek[i] + 8;
        *blrpek = BLR$K_DTYPE_G;     ++blrpek;
        break;

        case C_STR_VA:
        mestyp[i] = C_STR_VA;
        messiz += 82;
        mespek[i+1] = mespek[i] + 82;
        *blrpek = BLR$K_DTYPE_VT;    ++blrpek;
        *blrpek = 80;                ++blrpek;
        *blrpek = 0;                 ++blrpek;
        break;

        default:
        return(-1);
        }
      }

    *blrpek = BLR$K_DTYPE_L;        ++blrpek;
    *blrpek = 0;                    ++blrpek;
    messiz += 4;

    return(0);
  }

/********************************************************/
/*!******************************************************/

        static short rdberr(rutin,status)
        char *rutin;
        int   status;
 
/*      Kollar status från RDB-rutiner och genererar
 *      ev. felmeddelande.
 *
 *      In:  status = status från RDB.
 *           rutin  = MBS-rutin.
 *
 *      Ut:  Inget.
 *
 *      FV:  -2 = VARKON-felstatus.
 *
 *      Felkod = EX3142 = Felstatus från RDB i %s, felkod=%s
 *
 *      (C)microform ab 26/6/87 J. Kjellander
 *
 ******************************************************!*/

  {
     char errbuf[20];

     if ( (status & 1) == 0 )
       {
       sprintf(errbuf,"%s%%%d",rutin,status);
       return(erpush("EX3142",errbuf));
       }
     else
       {
       return(0);
       }
  }

/********************************************************/
#endif