PROCEDURE      ODBC.CONNECT:T
CONNECT conid SERVER   'ODBC'
              DATABASE srce
              USER     user
              PASSWORD pwd
              PREFIX   ''
              ERROR    errid
| write 'Connection ' conid errid
IF (errid lt 0 or conid eq 0)  execute subprocedure error
IF (errid lt 0 or conid eq 0)  execute subprocedure error
END PROCEDURE
PROCEDURE      ODBC.DISCONN:T
DISCONNECT conid
END PROCEDURE
PROCEDURE      ODBC.ENDLOOP:T
END LOOP
<1>write 'Rows returned ' rnum
DELETE STATEMENT statid CONNECT conid
END PROCEDURE
PROCEDURE      ODBC.GETDATA:T
program
DEFINE PROCEDURE VARIABLES ARRAYS
string ofns
call sysproc.odbc.header
execute subroutine sysproc.menu.odbclist returning(srce)

display textbox "Enter output filename" response ok,ofns
if(ok <=0) exit program
if(srst(ofns,".csv")=0)compute ofns=ofns+'.csv'

display textbox "Enter username" response ok,user
if(ok <=0) exit program
display textbox "Enter password" secret response ok,pwd
if(ok <=0) exit program

call sysproc.ODBC.CONNECT
display textbox "Enter query" response ok,qtext
if(ok <=0) exit program

call sysproc.odbc.loop | ($C $)
perform procs
call sysproc.odbc.endloop
call sysproc.odbc.disconn
call sysproc.odbc.tail
report filename=consol/sort=rnum
before report
string*4000 outline
open ofn/dsnvar=ofns/write/lrecl=4000
compute outline=""
for k=1,cnum
compute outline=outline+'"'+trim(cname(k))+'"'
if(k<cnum)compute outline=outline+','
end for
write(ofn)outline
break level 1, rnum
detail block
compute outline=""
for k=1,cnum
ifthen(exists(fields(k)))
compute outline=outline+'"'+trim(fields(k))+'"'
else
compute outline=outline+'" "'
endif
if(k <cnum)compute outline=outline+','
end for
write(ofn) outline
end break level
after report
close ofn
pql escape ['"c:\windows\system32\cmd" /c "start '+ofns+'" '] wait 0 minimize 1
end report
end program
END PROCEDURE
PROCEDURE      ODBC.HEADER:T
integer*4 errid conid statid statid2 rnum cnum COLT
string*200 colval
string*80 srce errstr,user,pwd,pref
string*300 qtext,utext
STRING*200 LINE
string*200 array fields(100)
string*200 array cname(100)
END PROCEDURE
PROCEDURE      ODBC.LOOP:T
STATEMENT statid  CONNECT conid ERROR errid
IF (errid lt 0)  execute subprocedure error
PREPARE STATEMENT statid CONNECT conid
        COMMAND qtext
        ERROR errid
IF (errid lt 0)  execute subprocedure error
EXECUTE STATEMENT statid CONNECT conid ERROR errid
IF (errid lt 0)  execute subprocedure error
rnum = ROWCOUNT (conid,statid)
cnum = COLCOUNT (conid,statid)
<1>write qtext
<1>write 'Columns returned ' cnum
compute rnum=0
LOOP
. res = NEXTROW (conid,statid)
. IF (res le 0) exit loop
. compute rnum=rnum+1
. FOR I = 1,cnum
.   compute COLT = COLTYPE(conid,statid,i)
.   IFTHEN (COLT LE 2)
.     colval = COLVALS (conid,statid,res,i)
.     ifthen(colt=2 and len(colval)=18 and picture(colval,'dddddddddddddd0000')=0)
.       colval=datec(cdate(sbst(colval,1,8),'yyyymmdd'),'dd/mm/yyyy')+" "+
               timec(ctime(sbst(colval,9,6),'hhmmss'),'hh:mm:ss')
.     Endif
.   else
.     ifthen( colt =3)
.       colval=datec(colvaln(conid,statid,res,i),'dd/mm/yyyy')
.     else
.       ifthen(colt=4)
.         colval=timec(colvaln(conid,statid,res,i),'hh:mm:ss')
.       else
.         colval = FORMAT (COLVALN (conid,statid,res,i))
.       fi
.     fi
.   FI
.   compute cname(i) = COLNAME (conid,statid,i)
|.   if(len(cname(i)) gt 8)compute cname(i)=sbst(cname(i),1,8)
|.   compute cname(i)=replace(cname(i)," ","_",8,1,0)
.   compute colval=replace(colval,char(10)," ",1,0,0)
.   compute fields(i)=colval
. end for
END PROCEDURE
PROCEDURE      ODBC.RUNREAD:T
program
call sysproc.odbc.header
compute srce='1 CSV'
compute user='dcd'
compute pwd='dcd'
compute qtext='select * from employee.csv'
call sysproc.odbc.connect
call sysproc.odbc.loop ($C $)
write cname(1) 5e
write fields(1) 5e
call sysproc.odbc.endloop ($C $)
call sysproc.odbc.disconn
call sysproc.odbc.tail
end program
END PROCEDURE
PROCEDURE      ODBC.RUNUP:T
program
call sysproc.odbc.header
compute srce='3 Access'
compute user='dcd'
compute pwd='dcd'
Compute utext='update employee set ndepends=3'
call sysproc.odbc.connect
call sysproc.odbc.update
call sysproc.odbc.disconn
call sysproc.odbc.tail
end program
END PROCEDURE
PROCEDURE      ODBC.TAIL:T
subprocedure error
errstr = GETERR(0)
write errid ' ' errstr
DISCONNECT conid
exit program
end subprocedure
SUBPROCEDURE RT_ERROR
WRITE 'RT_ERROR'
DISCONNECT conid
exit program
END SUBPROCEDURE
END PROCEDURE
PROCEDURE      ODBC.TEMPLATE:T
program
call sysproc.odbc.header
compute srce=''
compute user=''
compute pwd=''
call sysproc.odbc.connect
compute qtext=''
call sysproc.odbc.loop ($C $)
write cname(1) 5e
write fields(1) 5e
call sysproc.odbc.endloop ($C $)
call sysproc.odbc.disconn
call sysproc.odbc.tail
end program
END PROCEDURE
PROCEDURE      ODBC.UPDATE:T
STATEMENT statid2  CONNECT conid ERROR errid
IF (errid lt 0)  execute subprocedure error
PREPARE STATEMENT statid2 CONNECT conid
        COMMAND utext
        ERROR errid
IF (errid lt 0)  execute subprocedure error
EXECUTE STATEMENT statid2 CONNECT conid ERROR errid
IF (errid lt 0)  execute subprocedure error
<1>write utext
DELETE STATEMENT statid2 CONNECT conid
END PROCEDURE
PROCEDURE      ODBC.UPTEMPL:T
program
call sysproc.odbc.header
compute srce=''
compute user=''
compute pwd=''
Compute utext=''
call sysproc.odbc.connect
call sysproc.odbc.update
call sysproc.odbc.disconn
call sysproc.odbc.tail
end program
END PROCEDURE