Jorge Gayoso, quien esta desarrollando una gran aplicación comercial con FiveLinux ha sido tan amable de proporcionarnos el API de Oracle que ha desarrollado que estoy seguro será de utilidad para otros usuarios. Muchas gracias Jorge! 
oracle.prg
oracle.prg
#IfDef __FIVELINUX__
#include "FiveLinux.ch"
#include "linuxpos.ch"
#Endif
#IfDef __SQL__
#define n_Use 1
#define n_Alias 2
#define n_Key 3
#define n_DBSeek 4
#define n_Where 5
#define n_Found 6
#define n_Filter 7
#define n_Append 8
#define n_Keys 9
#define n_cmd 0
#define n_cmdPOS 1
#define n_cmdServer 2
#Endif
#IfnDef __SQL__
Function fSelect_SQL(v_Alias)
Return iif(v_Alias=NIL,select(),select(v_Alias))
#Else
Function fSelect_SQL(v_Alias)
local vRetorno,cR_SQL_Select:='',nR_SQL_Select:=0
if ValType(v_Alias)='C'
cR_SQL_Select:=v_Alias
elseif ValType(v_Alias)='N'
if v_Alias<=len(tSQL_select) .and. len(tSQL_select[v_Alias,2])>0
cR_SQL_Select:=tSQL_select[v_Alias,2]
nR_SQL_Select:=v_Alias
endif
else
cR_SQL_Select:=cSQL_Select
endif
if (nR_SQL_Select:=ascan(tSQL_select,{|x,y| upper(x[2])=upper(cR_SQL_Select) .and. len(alltrim(x[2]))>0 .and. len(alltrim(x[2]))=len(alltrim(cR_SQL_Select))}))=0
cR_SQL_Select:=''
nR_SQL_Select:=0
endif
Return iif(v_Alias=NIL,nR_SQL_Select,cR_SQL_Select)
#Endif
Function fDbSetOrder_SQL(cKEY)
local nKeyAct:=0
#IfnDef __SQL__
Dbsetorder(cKEY)
#Else
if valtype(cKey)='N'
nKeyAct=cKey
else
nKeyAct=ascan(tSQL_select[nSQL_Select,n_Keys],{|x,y| upper(x[1])=upper(cKey)})
endif
if .not. nKeyAct=tSQL_select[nSQL_Select,n_Key]
tSQL_select[nSQL_Select,n_Where]:=''
endif
tSQL_select[nSQL_Select,n_Key]:=nKeyAct
#Endif
Return .T.
Function fDBSeek_SQL(v_Buscar)
Local lRetorno:=.F., c_SQL:=''
#IfnDef __SQL__
lRetorno:=DBSeek(v_Buscar)
#Else
if nSQL_Select>0
if valtype(tSQL_select[nSQL_Select,n_DBSeek])!=valtype(v_Buscar) .or. tSQL_select[nSQL_Select,n_DBSeek]!=v_Buscar .or. len(tSQL_select[nSQL_Select,n_Where])>0
tSQL_select[nSQL_Select,n_DBSeek]:=v_Buscar
if valtype(v_Buscar)='C'
tSQL_select[nSQL_Select,n_Where]:="SUBSTR("+tSQL_select[nSQL_Select,n_Keys][tSQL_select[nSQL_Select,n_Key],2]+",1,"+;
alltrim(str(len(v_Buscar),4,0))+")='"+fEvalua_Busqueda(v_Buscar)+"'"
else
tSQL_select[nSQL_Select,n_Where]:=tSQL_select[nSQL_Select,n_Keys][tSQL_select[nSQL_Select,n_Key],2]+"="+alltrim(str(v_Buscar,15,0))
endif
endif
tSQL_select[nSQL_Select,n_Found]:=.F.
c_SQL:='select rowid,rownum, '+cSQL_Select+'.* from '+cSQL_Select+' where '+tSQL_select[nSQL_Select,n_Where]
if left(cSQL_Ejecuta(nSQL_Select,upper(c_SQL)),2)='OK'
tSQL_select[nSQL_Select,n_Found]:=iif(fLastRec_SQL()>0,.T.,.F.)
lRetorno:=tSQL_select[nSQL_Select,n_Found]
endif
endif
#Endif
Return lRetorno
Function fEof_SQL()
Public lRetorno:=.F.
#IfnDef __SQL__
lRetorno:=Eof()
#Else
if cSQL_Eof(nSQL_Select)=1
lRetorno := .T.
endif
#Endif
Return lRetorno
Function fBof_SQL()
Public lRetorno:=.F.
#IfnDef __SQL__
lRetorno:=Bof()
#Else
if cSQL_Bof(nSQL_Select)=1
lRetorno := .T.
endif
#Endif
Return lRetorno
Function fRecno_SQL()
Public nRetorno:=0
#IfnDef __SQL__
nRetorno:=RecNo()
#Else
nRetorno := cSQL_Field(nSQL_Select,"rownum")
if ValType(nRetorno)='C'
msgalert(nRetorno)
endif
#Endif
Return nRetorno
Function fLastRec_SQL()
Public nRetorno:=0
#IfnDef __SQL__
nRetorno:=LastRec()
#Else
nRetorno := cSQL_LastRec(nSQL_Select)
if ValType(nRetorno)='C'
msgalert(nRetorno)
endif
#Endif
Return nRetorno
Function fDBCommit_SQL()
local i, cReplace:='',cValues:=' VALUES(', lRetorno:=.F.
#IfnDef __SQL__
Dbunlock();Dbcommit()
#Else
if tSQL_select[nSQL_Select,n_Append]
cReplace:='INSERT INTO '+tSQL_select[nSQL_Select,n_Use]+'('
else
cReplace:='UPDATE '+tSQL_select[nSQL_Select,n_Use]+' SET '
endif
for i:=1 to len(tSQL_Replace)
if valtype(tSQL_Replace[i,2])='N'
tSQL_Replace[i,2]:=alltrim(str(tSQL_Replace[i,2],15,2))
elseif valtype(tSQL_Replace[i,2])='L'
tSQL_Replace[i,2]:=iif(tSQL_Replace[i,2],'1','0')
elseif valtype(tSQL_Replace[i,2])='D'
tSQL_Replace[i,2]:="to_date('"+DTOS(tSQL_Replace[i,2])+"','YYYYMMDD')"
else
tSQL_Replace[i,2]:="'"+STRTRAN(tSQL_Replace[i,2],"'",'"')+"'"
endif
if tSQL_select[nSQL_Select,n_Append]
cReplace+=tSQL_Replace[i,1]+iif(i<len(tSQL_Replace),',',')')
cValues+=tSQL_Replace[i,2]+iif(i<len(tSQL_Replace),',',')')
else
cReplace+=tSQL_Replace[i,1]+' = '+tSQL_Replace[i,2]+iif(i<len(tSQL_Replace),',','')
endif
next i
if tSQL_select[nSQL_Select,n_Append]
cReplace+=cValues
else
cReplace+=' WHERE '+tSQL_select[nSQL_Select,n_Where]
endif
if left(cValues:=cSQL_Ejecuta(nSQL_Select,cReplace,'A'),2)='OK'
lRetorno:=.T.
msgalert(cValues)
else
msgalert(cValues + ' ('+cReplace+')')
endif
#Endif
Return lRetorno
Function fFound_SQL()
local lRetorno:=.F.
#IfnDef __SQL__
lRetorno:=found()
#Else
lRetorno:=tSQL_select[nSQL_Select,n_Found]
#Endif
Return lRetorno
Function fRegLock_SQL()
local lRetorno:=.F.
#IfnDef __SQL__
lRetorno:=RegLock()
#Else
tSQL_Replace:={}
tSQL_select[nSQL_Select,n_Append]:=.F.
lRetorno:=.T.
#Endif
Return lRetorno
Function fSumReg_SQL()
local lRetorno:=.F.
#IfnDef __SQL__
lRetorno:=SumReg()
#Else
tSQL_Replace:={}
tSQL_select[nSQL_Select,n_Append]:=.T.
lRetorno:=.T.
#Endif
Return lRetorno
Function fDbSkip_SQL(nRegistros)
Local cResultado:=NIL
#IfnDef __SQL__
cResultado:=DbSkip(nRegistros)
#Else
nRegistros:=if(nRegistros=NIL,1,nRegistros)
if nRegistros<>0
cResultado := cSQL_DbSkip(nSQL_Select,nRegistros)
endif
if valtype(cResultado)='C'
msgalert(cResultado)
endif
#Endif
Return cResultado
Function fDbSelectArea_SQL(v_Alias)
#IfnDef __SQL__
DbSelectArea(v_Alias)
#Else
if valtype(v_Alias)='C'
if (nSQL_Select:=ascan(tSQL_select,{|x,y| upper(x[2])=upper(v_Alias) .and. len(alltrim(x[2]))>0 .and. len(alltrim(x[2]))=len(alltrim(v_Alias))}))=0
cSQL_Select:=''
else
cSQL_Select:=tSQL_select[nSQL_Select,2]
endif
elseif valtype(v_Alias)='N' .and. nSQL_Select<=len(tSQL_select) .and. len(tSQL_select[nSQL_Select,2])>0
cSQL_Select:=tSQL_select[nSQL_Select,2]
endif
#Endif
Return .T.
Function fIndexOrd_SQL()
Local nRetorno:=''
#IfnDef __SQL__
nRetorno:=IndexOrd()
#Else
nRetorno := tSQL_select[nSQL_Select,n_Key]
#Endif
Return nRetorno
Function fDbGoBottom_SQL()
Local cResultado:=NIL
#IfnDef __SQL__
cResultado:=DbGoBottom()
#Else
cResultado := cSQL_DbGoBottom(nSQL_Select)
if valtype(cResultado)='C'
msgalert(cResultado)
endif
#Endif
Return cResultado
Function fDbGoTop_SQL()
Local cResultado:=NIL
#IfnDef __SQL__
cResultado:=DbGoTop()
#Else
cResultado := cSQL_DbGoTop(nSQL_Select)
if valtype(cResultado)='C'
msgalert(cResultado)
endif
#Endif
Return cResultado
Function fDbGoto_SQL(nRegistro)
Local cResultado:=NIL
#IfnDef __SQL__
cResultado:=DbGoto(nRegistro)
#Else
if valtype(nRegistro)='N'
cResultado := cSQL_DbGoto(nSQL_Select, nRegistro)
else
cResultado := 'Tipo de dato no valido (SQL_DbGoto)'
endif
if valtype(cResultado)='C'
msgalert(cResultado)
endif
#endif
Return cResultado
Function fAlias_SQL()
local cRetorno:=''
#IfnDef __SQL__
cRetorno:=Alias()
#Else
cRetorno:=cSQL_Select
#Endif
Return cRetorno
Function fClose_SQL(cArchivo)
#IfnDef __SQL__
if cArchivo=NIL
DbCloseArea()
elseif lower(cArchivo)='index'
Close Index
else
Close (cArchivo)
endif
#Else
local i:=0
if cArchivo=NIL
i:=nSQL_Select
nSQL_Select:=0
cSQL_Select:=''
else
i:=ascan(tSQL_select,{|x,y| upper(x[2])=upper(cArchivo) .and. len(alltrim(x[2]))>0 .and. len(alltrim(x[2]))=len(alltrim(cArchivo))})
endif
if i>0
tSQL_select[i]:={'','',0,'','',.F.,'',.F.,{}}
if i=nSQL_Select
nSQL_Select:=0
cSQL_Select:=''
endif
endif
#Endif
Return .T.
Function fDbCloseAll_SQL()
#IfnDef __SQL__
DbCloseAll()
#Else
tSQL_select:={}
nSQL_Select:=0
cSQL_Select:=''
#Endif
Return .T.Function fDeleteAll_SQL(cFiltro)
local cRetorno:='Ok', c_SQL_Delete, cMsgProblemaAlEjecutar:=''
#IfnDef __SQL__
if cFiltro=NIL
delete all
else
delete all for &cFiltro.
endif
#Else
if cFiltro=NIL
cFiltro:=''
else
cFiltro:=fEvalua_Busqueda(cFiltro)
endif
c_SQL_Delete="delete from "+upper(cSQL_Select)+iif(len(cFiltro)=0,'',' where '+cFiltro)
if .not. left(cMsgProblemaAlEjecutar:=cSQL_Ejecuta(nSQL_Select,c_SQL_Delete,"A"),2)='OK'
cRetorno:=cMsgProblemaAlEjecutar
endif
#Endif
Return cRetorno
Function fSetFilter_SQL(cFiltro)
local cRetorno:=NIL, c_SQL_Filter, cMsgProblemaAlEjecutar:=''
#IfnDef __SQL__
if cFiltro=NIL
set filter to
else
set filter to &cFiltro.
endif
#Else
if cFiltro=NIL
cFiltro:=''
else
cFiltro:=fEvalua_Busqueda(cFiltro)
endif
c_SQL_Filter="select rowid,rownum, "+cSQL_Select+".* from "+upper(cSQL_Select)+iif(len(cFiltro)=0,'',' where '+cFiltro)
if .not. left(cMsgProblemaAlEjecutar:=cSQL_Ejecuta(nSQL_Select,c_SQL_Filter),2)='OK'
cRetorno:=cMsgProblemaAlEjecutar
endif
#Endif
Return cRetorno
Function fCountAll_SQL(cFiltro)
local nRetorno:=0, c_SQL_Count, cMsgProblemaAlEjecutar:=''
#IfnDef __SQL__
if cFiltro=NIL
Count all to nRetorno
else
Count all to nRetorno for &cFiltro.
endif
#Else
if cFiltro=NIL
cFiltro:=''
else
cFiltro:=fEvalua_Busqueda(cFiltro)
endif
c_SQL_Count="select count(*) as nCuenta from "+upper(cSQL_Select)+iif(len(cFiltro)=0,'',' where '+cFiltro)
if .not. left(cMsgProblemaAlEjecutar:=cSQL_Ejecuta(nSQL_Select,c_SQL_Count,'X'),2)='OK'
nRetorno:=cMsgProblemaAlEjecutar
else
nRetorno:=fField_SQL('nCuenta',n_cmd)
endif
#Endif
Return nRetorno
Function fCopyTo_SQL(cArchivo,cWhile,cFor,lSoloStructura)
local cRetorno:=NIL, c_SQL_CopyTo, cMsgProblemaAlEjecutar:=''
lSoloStructura:=iif(lSoloStructura=NIL,.F.,lSoloStructura)
#IfnDef __SQL__
cWhile:=iif(cWhile=NIL,'.T.',cWhile)
cFor:=iif(cFor=NIL,'.T.',cFor)
if lSoloStructura
copy struct TO (cArchivo)
else
copy TO &cArchivo. WHILE &cWhile. FOR &cFor.
endif
#Else
// cWhile NO SE OCUPA en SQL
if (i:=rat('/',cArchivo))>0
cArchivo:=substr(cArchivo,i+1)
endif
cArchivo:=strtran(cArchivo,'.','_')
if cFor=NIL
cFor:=''
else
cFor:=fEvalua_Busqueda(cFor)
if len(alltrim(cFor))>0
cFor:=' where '+cFor
endif
endif
c_SQL_CopyTo:='drop table '+cArchivo
cSQL_Ejecuta(nSQL_Select,c_SQL_CopyTo,'A')
c_SQL_CopyTo:='CREATE Table '+cArchivo+' as SELECT * FROM '+cSQL_Select+cFor
if .not. left(cMsgProblemaAlEjecutar:=cSQL_Ejecuta(nSQL_Select,c_SQL_CopyTo,'A'),2)='OK'
cRetorno:=cMsgProblemaAlEjecutar
endif
#Endif
Return cRetorno
Function fDbDelete_SQL()
local lRetorno:=.T.
#IfnDef __SQL__
DbDelete()
#Else
local cRowId,cMsgProblemaAlEjecutar
cRowId := cSQL_Field(nSQL_Select,"rowid")
?cRowId
c_SQL_CopyTo:="Delete from "+cArchivo+" where rowid='"+cRowId+"'"
if .not. left(cMsgProblemaAlEjecutar:=cSQL_Ejecuta(nSQL_Select,c_SQL_CopyTo,'A'),2)='OK'
lRetorno:=.F.
endif
?cMsgProblemaAlEjecutar
#Endif
Return lRetorno
Function fLocateAll_SQL(cWhile,cFor)
local cRetorno:=NIL, c_SQL_LocateAll, cMsgProblemaAlEjecutar:=''
#IfnDef __SQL__
if cWhile!=NIL
locate WHILE &cWhile. FOR &cFor.
else
locate all FOR &cFor.
endif
#Else
#Endif
Return cRetorno
Function fSetRelationTo(tRelacion)
local cRetorno:=NIL,i,cR1,cA1,cR2,cA2,cR3,cA3
#IfnDef __SQL__
if tRelacion=NIL
Set relation to
else
cR1:=tRelacion[1,1]
cA1:=tRelacion[1,2]
do case
case len(tRelacion)=1
Set relation to &cR1. into &cA1.
case len(tRelacion)=2
cR2:=tRelacion[2,1]
cA2:=tRelacion[2,2]
Set relation to &cR1. into &cA1.,to &cR2. into &cA2.
case len(tRelacion)=3
cR3:=tRelacion[2,1]
cA3:=tRelacion[2,2]
Set relation to &cR1. into &cA1.,to &cR2. into &cA2.,to &cR3. into &cA3.
endcase
endif
#Else
#Endif
Return cRetorno
Function fDbCreate_SQL(cArchivo,tEstructura)
local cRetorno:=NIL, cMsgProblemaAlEjecutar:=''
#IfnDef __SQL__
DbCreate(cArchivo, tEstructura)
#Else
#Endif
Return cRetorno
Function fIndexOn_SQL(cOrden,cArchivo,lUnico)
local cRetorno:=NIL, cMsgProblemaAlEjecutar:=''
lUnico:=iif(lUnico=NIL,.F.,lUnico)
#IfnDef __SQL__
if lUnico
index on &cOrden. to &cArchivo. unique
else
index on &cOrden. to &cArchivo.
endif
#Else
#Endif
Return cRetorno
Function fAppendFrom_SQL(cArchivo,cFiltro,lSDF)
local cRetorno:=NIL, c_SQL_AppendFrom, cMsgProblemaAlEjecutar:=''
lSDF:=iif(lSDF=NIL,.F.,lSDF)
#IfnDef __SQL__
if cFiltro=NIL
c_SQL_AppendFrom:=cArchivo
else
c_SQL_AppendFrom:=cArchivo+' for '+cFiltro
endif
if lSDF
c_SQL_AppendFrom+=' SDF'
endif
append from &c_SQL_AppendFrom.
#Else
#Endif
Return cRetorno
Function fReplaceAll_SQL(tReplace,cFiltro)
local cRetorno:=NIL, c_SQL_Replace:='', cMsgProblemaAlEjecutar:='',i:=0
#IfnDef __SQL__
cFiltro:=iif(cFiltro=NIL,'.T.',cFiltro)
for i:=1 to len(tReplace)
paso1:=tReplace[i,1]
paso2:=tReplace[i,2]
replace all &paso1 with &paso2 for &cFiltro.
next i
#Else
#Endif
Return cRetorno
#IfDef __SQL__
Function fUse_SQL(cAlias,nOrigenData)
local lRetorno:=.F.,tKey:={}, i, cSelect:=cSelect:="select rowid,rownum, ai.index_name, ic.column_name "+;
"from all_ind_columns ic, all_indexes ai "+;
"where ai.index_name = ic.index_name and ai.table_name = '"+upper(cAlias)+"'"
cSQL_Select:=cAlias
if (nSQL_Select:=ascan(tSQL_select,{|x,y| upper(x[2])=upper(cSQL_Select) .and. len(alltrim(x[2]))>0 .and. len(alltrim(x[2]))=len(alltrim(cSQL_Select))}))=0
nSQL_Select:=len(tSQL_select)+1
aadd(tSQL_select,{cSQL_Select,cAlias,0,'','',.F.,'',.F.,{}})
cSQL_Use(nSQL_Select, nOrigenData)
&& ?'USE:',cSQL_Select,' nSelect:',alltrim(str(nSQL_Select,3,0)),' nOrigenData:',alltrim(str(nOrigenData,3,0))
if left(cSQL_Ejecuta(nSQL_Select,cSelect,"X"),2)='OK'
cSQL_Keys(@tKey)
cSelect="select rowid,rownum, posindex.* from posindex where name = '"+upper(cAlias)+"'"
if left(cSQL_Ejecuta(nSQL_Select,cSelect),2)='OK'
for i:=1 to len(tKey)
tKey[i]:={tKey[i],fField_SQL('KEY'+alltrim(str(i,3,0)))}
&& ?'INDEX:',alltrim(str(i,3,0)),tKey[i,1],tKey[i,2]
next i
tSQL_select[nSQL_Select,n_Keys]:=tKey
fDbSetOrder_SQL('KEY1',.T.)
endif
cSelect="select rowid,rownum, "+cSQL_Select+".* from "+upper(cAlias)
if left(cSQL_Ejecuta(nSQL_Select,cSelect),2)='OK'
lRetorno:=.T.
endif
endif
else
lRetorno:=.T.
endif
Return lRetorno
Function fReplace_SQL(cField, vData)
if c_Modo_SQL$'CD'
replace &cField with vData
Endif
if c_Modo_SQL$'OD'
aadd(tSQL_Replace,{cField, vData})
endif
Return .T.
Function fDBSkipper_SQL(lRecs , lPageDown)
lSkipped := 0
fBEof := .F.
ulRecords := 0
lPageDown:=iif(lPageDown=NIL,.F.,lPageDown)
if fSelect_SQL() > 0
if (ulRecords:=fLastRec_SQL()) > 0
if ( lRecs > 0 )
if fRecno_SQL()!=ulRecords
do while ( lSkipped < lRecs )
if fEof_SQL()
exit
endif
fDbSkip_SQL( 1 )
lSkipped++
enddo
if fEof_SQL()
if (c_Modo_SQL='O' .and. .not. lPageDown) .or. c_Modo_SQL='C'
lSkipped:=0
endif
fDbSkip_SQL( -1 )
endif
endif
elseif ( lRecs < 0 )
do while ( lSkipped > lRecs )
fDbSkip_SQL( -1 )
if fBof_SQL()
exit
endif
lSkipped--
enddo
endif
endif
endif
Return lSkipped
Function fField_SQL(vField,nCmd)
local vRetorno
vRetorno := cSQL_Field(iif(nCmd=NIL,nSQL_Select,nCmd),vField)
Return vRetorno
Function fEvalua_Busqueda(cKey)
local cKeyOracle:=cKey,cPaso:=cKey
&& VAL
ii=AT('VAL(',upper(cPaso))
IF II>0
DO WHILE ii>0
cKeyOracle=LEFT(cPaso,ii-1)
cPaso='TO_NUMBER'+SUBSTR(cPaso,ii+3)
yy=fBuscaCierreFuncion('(',')',cPaso)
IF yy>0
cPaso=LEFT(cPaso,yy-1)+':'+SUBSTR(cPaso,yy+1)
cKeyOracle=cKeyOracle+LEFT(cPaso,yy-1)+SUBSTR(cPaso,yy)
ENDIF
ii=AT('VAL(',upper(cKeyOracle))
cPaso=cKeyOracle
ENDDO
ENDIF
&& DTOS
cPaso=cKeyOracle
ii=AT('DTOS',upper(cPaso))
DO WHILE ii>0
cKeyOracle=LEFT(cPaso,ii-1)
cPaso='TO_CHAR'+SUBSTR(cPaso,ii+4)
yy=fBuscaCierreFuncion('(',')',cPaso)
IF yy>0
cPaso=LEFT(cPaso,yy-1)+':'+SUBSTR(cPaso,yy+1)
cKeyOracle=cKeyOracle+LEFT(cPaso,yy-1)+"á'yyyymmdd'"+SUBSTR(cPaso,yy)
ENDIF
ii=AT('DTOS',upper(cKeyOracle))
cPaso=cKeyOracle
ENDDO
&& DTOC
cPaso=cKeyOracle
ii=AT('DTOC',upper(cPaso))
IF II>0
DO WHILE ii>0
cKeyOracle=LEFT(cPaso,ii-1)
cPaso='TO_CHAR'+SUBSTR(cPaso,ii+4)
yy=fBuscaCierreFuncion('(',')',cPaso)
IF yy>0
cPaso=LEFT(cPaso,yy-1)+':'+SUBSTR(cPaso,yy+1)
cKeyOracle=cKeyOracle+LEFT(cPaso,yy-1)+",'dd/mm/yyyy'"+SUBSTR(cPaso,yy)
ENDIF
ii=AT('DTOC',upper(cKeyOracle))
cPaso=cKeyOracle
ENDDO
ENDIF
&& STR(
cPaso=cKeyOracle
ii=fBuscaFuncion('STR(',upper(cPaso))
IF II>0
DO WHILE ii>0
cKeyOracle=LEFT(cPaso,ii-1)
cPaso='TO_CHAR'+SUBSTR(cPaso,ii+3)
xx=AT(',',cPaso)
yy=fBuscaCierreFuncion('(',')',cPaso)
IF xx>0
cPaso=LEFT(cPaso,xx-1)+';'+SUBSTR(cPaso,xx+1)
cPaso=LEFT(cPaso,yy-1)+':'+SUBSTR(cPaso,yy+1)
cKeyOracle=cKeyOracle+LEFT(cPaso,xx)+STRTRAN(SUBSTR(cPaso,xx+1,yy-xx),',0','')+SUBSTR(cPaso,yy+1)
ENDIF
ii=fBuscaFuncion('STR(',upper(cKeyOracle))
cPaso=cKeyOracle
ENDDO
ENDIF
&& LEFT(
cPaso=cKeyOracle
ii=AT('LEFT(',upper(cPaso))
IF II>0
DO WHILE ii>0
cKeyOracle=LEFT(cPaso,ii-1)
cPaso='SUBSTR'+SUBSTR(cPaso,ii+4)
xx=AT(',',cPaso)
yy=fBuscaCierreFuncion('(',')',cPaso)
IF xx>0
cPaso=LEFT(cPaso,xx-1)+';1;'+SUBSTR(cPaso,xx+1)
cKeyOracle=cKeyOracle+cPaso
ENDIF
ii=AT('LEFT(',upper(cKeyOracle))
cPaso=cKeyOracle
ENDDO
ENDIF
&& STRZERO
cPaso=cKeyOracle
ii=AT('STRZERO',upper(cPaso))
IF II>0
cKeyOracle=''
DO WHILE ii>0
cKeyOracle=LEFT(cPaso,ii-1)
cPaso='TRIM(TO_CHAR'+SUBSTR(cPaso,ii+7)
xx=AT(',',cPaso)
yy=fBuscaCierreFuncion('(',')',substr(cPaso,6))+5
IF xx>0
cPaso=LEFT(cPaso,xx-1)+';'+SUBSTR(cPaso,xx+1)
cPaso=LEFT(cPaso,yy-1)+':'+SUBSTR(cPaso,yy+1)
cKeyOracle=cKeyOracle+LEFT(cPaso,xx)+"RPAD('0'"+SUBSTR(cPaso,xx,yy-xx)+"))"+SUBSTR(cPaso,yy)
ENDIF
ii=AT('STRZERO',upper(cKeyOracle))
cPaso=cKeyOracle
ENDDO
ENDIF
IF LEN(TRIM(cKeyOracle))=0
cKeyOracle=cKey
ENDIF
cKeyOracle:=STRTRAN(cKeyOracle,'+','||')
cKeyOracle:=STRTRAN(cKeyOracle,';',',')
cKeyOracle:=STRTRAN(cKeyOracle,':',')')
cKeyOracle:=STRTRAN(cKeyOracle,'"',"'")
do while (ii:=at('$',cKeyOracle))>0
xx:=rat(' ',left(cKeyOracle,ii))+1
if (yy:=at(' .',substr(cKeyOracle,ii)))=0
yy:=len(cKeyOracle)
else
yy+=ii-2
endif
cKeyOracle:=left(cKeyOracle,xx-1)+'INSTR('+strtran(substr(cKeyOracle,ii+1,yy-ii),'"',"'")+','+substr(cKeyOracle,xx,ii-xx)+')>0'+substr(cKeyOracle,yy+1)
enddo
do while (ii:=at('DELETE()',upper(cKeyOracle)))>0
cKeyOracle:=left(cKeyOracle,ii-1)+''+substr(cKeyOracle,ii+8)
enddo
if alltrim(upper(cKeyOracle))$'.NOT.'
cKeyOracle:=''
endif
do while (ii:=at('PADR(',upper(cKeyOracle)))>0
cKeyOracle:=left(cKeyOracle,ii-1)+'RPAD('+substr(cKeyOracle,ii+5)
enddo
do while (ii:=at('PADL(',upper(cKeyOracle)))>0
cKeyOracle:=left(cKeyOracle,ii-1)+'LPAD('+substr(cKeyOracle,ii+5)
enddo
do while (ii:=at('.NOT.',upper(cKeyOracle)))>0
cKeyOracle:=left(cKeyOracle,ii-1)+substr(cKeyOracle,ii+1,3)+substr(cKeyOracle,ii+5)
enddo
do while (ii:=at('.AND.',upper(cKeyOracle)))>0
cKeyOracle:=left(cKeyOracle,ii-1)+substr(cKeyOracle,ii+1,3)+substr(cKeyOracle,ii+5)
enddo
do while (ii:=at('.OR.',upper(cKeyOracle)))>0
cKeyOracle:=left(cKeyOracle,ii-1)+substr(cKeyOracle,ii+1,3)+substr(cKeyOracle,ii+5)
enddo
do while (ii:=at('INT(',upper(cKeyOracle)))>0 .and. (ii=1 .or. substr(cKeyOracle,ii-1,1)$' (')
cKeyOracle:=left(cKeyOracle,ii-1)+'TRUNC'+substr(cKeyOracle,ii+3)
enddo
do while (ii:=at('LEN(',upper(cKeyOracle)))>0 .and. (ii=1 .or. substr(cKeyOracle,ii-1,1)$' (')
cKeyOracle:=left(cKeyOracle,ii-1)+'LENGTH'+substr(cKeyOracle,ii+3)
enddo
do while (ii:=at('ALLTRIM',upper(cKeyOracle)))>0
cKeyOracle:=left(cKeyOracle,ii-1)+'R'+substr(cKeyOracle,ii+3)
enddo
Return cKeyOracle
FUNCTION fBuscaCierreFuncion(cA,cB,cPaso)
LOCAL i,c,y
c=0
FOR i=1 TO LEN(cPaso)
IF SUBSTR(cPaso,i,1)=cA
c=c+1
ELSE
IF SUBSTR(cPaso,i,1)=cB
exit
ENDIF
ENDIF
NEXT i
y=0
FOR i=1 TO LEN(cPaso)
IF SUBSTR(cPaso,i,1)=cB
y=y+1
IF y=c
EXIT
ENDIF
ENDIF
NEXT i
IF i>LEN(cPaso)
i=LEN(cPaso)
endif
RETURN i
Function fBuscaFuncion(cFuncion,cTxt)
local i, d:=at(cFuncion,cTxt)
for i:=d to len(cTxt)
if upper(substr(cTxt,i,len(cFuncion)))=upper(cFuncion)
if substr(cTxt,i-1,1)$' (+' .or. i=1
exit
endif
endif
next i
Return iif(i>len(cTxt),0,i)
#pragma BEGINDUMP
#include "hbapi.h"
#include <SQLAPI.h> // main SQLAPI++ header
#include <hbapiitm.h>
#include "stdio.h"
#define n_cmd 0
#define n_cmdPOS 1
#define n_cmdServer 2
SAConnection conector_pos;
SAConnection conector_server;
SACommand cmd[200];
int cmd_param[200][5]; //0=cmd_origen_Data, 1=lastrec()
HB_FUNC( CSQL_USE )
{
cmd_param[hb_parnl(1)][0]=hb_parnl(2);
hb_retnl( cmd_param[hb_parnl(1)][0] );
}
HB_FUNC( CSQL_CONECTA )
{
try
{
if ( hb_parnl(1) == n_cmdPOS ) {
if(conector_pos.isConnected()) {
conector_pos.setAutoCommit(SA_AutoCommitOn);
hb_retc( "OK - Ya esta conectado a datos POS" );
} else {
conector_pos.Connect("XE_POS", "fasapos", "Farmacia1", SA_Oracle_Client);
hb_retc( "OK - Conectado a datos POS" );
}
} else {
if(conector_server.isConnected()) {
conector_server.setAutoCommit(SA_AutoCommitOn);
hb_retc( "OK - Ya esta conectado a datos SERVER" );
} else {
conector_server.Connect("XE_SERVER", "fasapos", "Farmacia1", SA_Oracle_Client);
hb_retc( "OK - Conectado a datos SERVER" );
}
};
} catch(SAException &x) {
try
{
// on error rollback changes
if ( hb_parnl(1) == n_cmdPOS ) {
conector_pos.Rollback();
} else {
conector_server.Rollback();
}
} catch(SAException &) {
}
hb_retc( x.ErrText() + " (cSQL_Conecta)" );
}
}
HB_FUNC( CSQL_EJECUTA )
{
bool b_isResultSet;
int i = hb_parnl(1);
const char* cUtiliza_cmd = " ";
try
{
if ( hb_pcount() >= 3 ) {
cUtiliza_cmd = hb_parc(3);
i = n_cmd;
};
if ( cmd_param[hb_parnl(1)][0] == n_cmdPOS ) {
cmd[i].setConnection(&conector_pos);
} else {
cmd[i].setConnection(&conector_server);
};
cmd[i].setCommandText( hb_parc(2) );
if ( i != n_cmd ) {
cmd[i].setOption("Scrollable") = "true";
}
cmd[i].Execute();
if ( *cUtiliza_cmd == 'A' ) {
hb_retc( "OK - Ejecutado" );
} else {
b_isResultSet = cmd[i].isResultSet();
if ( b_isResultSet ) {
if ( i > n_cmd ) {
cmd[i].FetchLast();
cmd_param[i][1] = cmd[i].Field("rownum").asLong();
cmd[i].FetchFirst();
} else {
cmd[i].FetchNext();
}
hb_retc( "OK - Ejecutado" );
} else {
hb_retc( "NOT - isResultSet" );
}
}
} catch(SAException &x) {
try
{
// on error rollback changes
if ( hb_parnl(1) == n_cmdPOS ) {
conector_pos.Rollback();
} else {
conector_server.Rollback();
}
} catch(SAException &) {
}
hb_retc( x.ErrText() + " (cSQL_Ejecuta)" );
}
}
HB_FUNC( CSQL_KEYS )
{
PHB_ITEM pArray = hb_itemNew( NULL );
PHB_ITEM pValue;
SAString cNombreIndice;
hb_arrayNew( pArray, 0 );
cNombreIndice = ' ';
try
{
while(cmd[n_cmd].FetchNext())
{
if ( cmd[n_cmd].Field(2).asString() != cNombreIndice ) {
pValue = hb_itemPutC( NULL, cmd[n_cmd].Field(2).asString() );
hb_arrayAdd( pArray, pValue );
cNombreIndice = cmd[n_cmd].Field(2).asString();
}
}
hb_itemCopy( hb_param( 1, HB_IT_ANY ), pArray );
hb_itemRelease( pArray );
hb_itemRelease( pValue );
} catch(SAException &x) {
hb_retc( x.ErrText() + " (cSQL_Key)" );
}
}
HB_FUNC( CSQL_DBSKIP )
{
int i = hb_parnl(1);
int c = 1;
int x = 1;
try
{
if ( hb_pcount() > 1 ) {
c = hb_parnl(2);
if (c < 0 ) {
x = c;
c = -1;
}
}
while( x <= c ) {
if ( x > 0 ) {
cmd[i].FetchNext();
} else {
cmd[i].FetchPrior();
}
x = x + 1;
};
} catch(SAException &x) {
hb_retc( x.ErrText() + " (cSQL_DbSkip)" );
}
}
HB_FUNC( CSQL_DBGOTO )
{
int i = hb_parnl(1);
int x = 1;
try
{
// SIMULA DBGOTO(X)
cmd[i].FetchFirst();
while ( x < hb_parnl(2) ) {
cmd[i].FetchNext();
x = x + 1;
}
//
} catch(SAException &x) {
hb_retc( x.ErrText() + " (cSQL_DbGoto)" );
}
}
HB_FUNC( CSQL_DBGOTOP )
{
int i = hb_parnl(1);
try
{
cmd[i].FetchFirst();
} catch(SAException &x) {
hb_retc( x.ErrText() + " (cSQL_DbGoTop)" );
}
}
HB_FUNC( CSQL_DBGOBOTTOM )
{
int i = hb_parnl(1);
try
{
cmd[i].FetchLast();
} catch(SAException &x) {
hb_retc( x.ErrText() + " (cSQL_DbGoBottom)" );
}
}
HB_FUNC( CSQL_BOF )
{
int i = hb_parnl(1);
try
{
if ( cmd[i].Field(1).asLong() == 1 ) {
hb_retnl( 1 );
} else {
hb_retnl( 0 );
}
} catch(SAException &x) {
hb_retc( x.ErrText() + " (cSQL_Bof)" );
}
}
HB_FUNC( CSQL_EOF )
{
int i = hb_parnl(1);
try
{
if ( cmd[i].Field(1).asLong() == cmd_param[i][1] ) {
hb_retnl( 1 );
} else {
hb_retnl( 0 );
}
} catch(SAException &x) {
hb_retc( x.ErrText() + " (cSQL_Eof)" );
}
}
HB_FUNC( CSQL_LASTREC )
{
int i = hb_parnl(1);
try
{
hb_retnl( cmd_param[i][1] );
} catch(SAException &x) {
hb_retc( x.ErrText() + " (cSQL_LastRec)" );
}
}
HB_FUNC( CSQL_FIELD )
{
SADateTime dtValue;
int i = hb_parnl(1);
try
{
// 0 - SA_dtUnknown Data type is unknown.
// 1 - SA_dtBool Data type is C bool .
// 2 - SA_dtShort Data type is C short.
// 4 - SA_dtLong Data type is C long.
// 6 - SA_dtDouble Data type is C double.
// 7 - SA_dtNumeric Data type is SANumeric (used internally).
// 8 - SA_dtDateTime Data type is SADateTime.
// 10 - SA_dtString Data type is character string (SAString).
// 11 - SA_dtBytes Data type is binary string (SAString).
// 12 - SA_dtLongBinary Data type is long binary data (SAString).
// 13 - SA_dtLongChar Data type is long character data (SAString).
// 14 - SA_dtBLob Data type is BLob data (SAString).
// 15 - SA_dtCLob Data type is CLob data (SAString).
// 16 - SA_dtCursor Data type is Oracle REF CURSOR (SACommand).
// 17 - SA_dtSpecificToDBMS Data type is server-specific.
// printf("Tipo: %d \n",cmd[i].Field(hb_parc(2)).FieldType());
switch (cmd[i].Field(hb_parc(2)).FieldType())
{
case SA_dtDateTime:
dtValue = cmd[i].Field(hb_parc(2)).asDateTime();
hb_retd( dtValue.GetYear(), dtValue.GetMonth(), dtValue.GetDay());
break;
case SA_dtBool:
hb_retnl( cmd[i].Field(hb_parc(2)).asLong() );
break;
case SA_dtNumeric:
hb_retnl( cmd[i].Field(hb_parc(2)).asLong() );
break;
case SA_dtLong:
hb_retnl( cmd[i].Field(hb_parc(2)).asLong() );
break;
case SA_dtDouble:
hb_retnl( cmd[i].Field(hb_parc(2)).asLong() );
break;
case SA_dtString:
hb_retc( cmd[i].Field(hb_parc(2)).asString() );
break;
case SA_dtLongChar:
hb_retc( cmd[i].Field(hb_parc(2)).asString() );
break;
default:
break;
};
} catch(SAException &x) {
hb_retc( x.ErrText() + " (cSQL_Field)" );
}
}
#pragma ENDDUMP
#Endif