FiveTech Support Forums

FiveWin / Harbour / xBase community
Board index FiveWin para Harbour/xHarbour clase TPqSQLServer and xbrowse
Posts: 1789
Joined: Tue Oct 11, 2005 05:01 PM

clase TPqSQLServer and xbrowse

Posted: Sun Jun 04, 2017 12:57 AM
Estimados, estoy desarrollando una clase similar a tmysql (TMySqlServer y TMySqlQuery)
pero para postgres (la he llamado TPqSqlServer y TPqSqlQuery), he tomado como base la tpostgres y tmysql de contrib de xharbour,
he realizado varios cambios, y la llevo bastante avanzada, pero actualmente tengo un problema con xbrowse, y es que no me muestra los datos,
ya que xbrowse internamente esta desarrollada para soportar dolphin, tmysql, ado, dbf, arrays, y las nuevas clases de de fwh.
en el ejemplo que muestro, todo me funciona, salvo lo del mostrar los datos con xbrowse,
me pudiera dar una mano con esto por favor.
lo he probado con un server 8.4,

en el enlace pongo lo necesario para compilar el ejemplo con xharbour y borland c 7.x.
habria que cambiar ip del server, y la base de datos a los propio.

http://castillolawyers.no-ip.info/owncloud/index.php/s/yvVyVYHbqYKxtCQ

Code (fw): Select all Collapse
#include "fivewin.ch" 
#include "xbrowse.ch" 


REQUEST HB_LANG_ES
REQUEST DBFCDX, DBFFPT
EXTERNAL OrdKeyNo, OrdKeyCount, OrdKeyGoto

procedure main()
   local oServer, oQuery
   local aStruct
   local oBrw
   local oErr
   
   HB_LangSelect("ES")
   RDDSetDefault( "DBFCDX" )
    
   set cent on
   set date brit
   
   //MsgInfo("Inicio")
     
   oServer := TPqSQLServer():new( "192.168.1.105", "northwind", "postgres", "postgres", 5432 )
   
   if oServer:NetErr()
      MsgInfo( oServer:ErrorTxt() )
      oServer:End()
      return
   else
      ?"connected..."
      oServer:TraceOn( "prueba.txt" )
   endif
   
   ?"Database:", oServer:cDBName,"Schema:", oServer:cSchema   
   ?"Existe tabla customers? ", oServer:TableExists( "customers" ),;
    "Existe tabla clientes? ", oServer:TableExists( "clientes" )

   xbrowse( oServer:ListTables() )
   
   oServer:DeleteTable( "clientes1" )

   if oServer:NetErr()
      MsgInfo( oServer:ErrorTxt() )
   else
      ?"tabla clientes1 borrada!"
   endif

   oServer:DeleteTable( "prueba" )

   if oServer:NetErr()
      MsgInfo( oServer:ErrorTxt() )
   else
      ?"tabla prueba borrada!"
   endif

   ?"clientes.dbf existe? ", file( "clientes.dbf" )
   
   use clientes new
   aStruct := clientes->( dbstruct() )
   
   fwdbg aStruct
   
   ?"table prueba crated? ",oServer:CreateTable( "prueba", aStruct, "my_recno", "my_recno" )

   if oServer:NetErr()
      MsgInfo( oServer:ErrorTxt() )
   endif
   
   fwdbg oServer:TableStruct( "prueba" ), ;
         oServer:TableStruct( "customer" ),; 
         oServer:TableStruct( "customers" ),;
         oServer:TableStruct( "employees" )
         
   ?"creacion de index 1: ",oServer:CreateIndex( "fullname", "prueba", {"firsts","lasts"}, .t. )
   ?"creacion de index 2: ",oServer:CreateIndex( "fullname", "prueba", {"firsts","lasts"}, .f. )

   if oServer:NetErr()
      MsgInfo( oServer:ErrorTxt() )
   endif

   MsgInfo("verifique creacion de index")
   
   oServer:ThrowError( .t. )
   
   try
      oServer:StartTransaction()
      oServer:Execute( "insert into prueba (firsts,lasts) values ('carlos','vargas')" )
      oServer:Execute( "insert into prueba (firsts,lasts) values ('reyna','montoya')" )
      oServer:Execute( "insert into prueba (firsts,lasts) values ('nicole','vargas')" )
      oServer:Commit()
   catch oErr
      oServer:Rollback()
      ?oErr:description
   end
   
   oServer:ThrowError( .f. )
   
   //?"eliminacion de index: ",oServer:DeleteIndex( "fullname", "prueba" )
 
   oQuery := oServer:Query( "select * from prueba" )
  
   if oServer:NetErr()
      MsgInfo( oServer:ErrorTxt() )
      oServer:End()
      return
   endif
   
   fwdbg oQuery:RecCount(), oQuery:RecNo(), oQuery:Bof(), oQuery:Eof()
   
   xbrowse( oQuery )
   
   oQuery:GoTop()
   do while !oQuery:eof()
      ?oQuery:firsts, oQuery:married, valtype(oQuery:married), oQuery:salary, valtype(oQuery:salary), oQuery:RecNo()
      oQuery:Skip()
   enddo      
   
  // esta columna no existe, salta error
  //?oQuery:fullname //
   
   fwdbg oQuery:Bof(), oQuery:Eof(), oQuery:RecNo()
   
   xbrowser oQuery SETUP ( SetPostgre( oBrw, oQuery, .t. ) )
   
   oQuery:End()
   oServer:End()
   
return   

PROCEDURE SetPostgre( oBrw, oQry, lAddCols )

   LOCAL xField    := NIL
   LOCAL cHeader   := ""
   LOCAL cCol      := ""
   LOCAL aFldNames, oCol
   
   IF lAddCols == NIL 
      lAddCols = .T.
   ENDIF

   WITH OBJECT oBrw
      :bGoTop    := {|| If( oQry:LastRec() > 0, oQry:GoTop(), NIL ) }
      :bGoBottom := {|| If( oQry:LastRec() > 0, oQry:GoBottom(), nil )  }
      :bSkip     := {| n | oQry:Skip( n ) }
      :bBof      := {|| oQry:Bof() }
      :bEof      := {|| oQry:Eof() }
      :bBookMark := {| n | If( n == nil,;
                           If( oQry:LastRec() > 0, oQry:RecNo(), 0 ), ;
                           If( oQry:LastRec() > 0, oQry:goto( n ), 0 ) ) }
      :bKeyNo    := {| n | If( n == nil, ;
                           If( oQry:LastRec() > 0, oQry:RecNo(), 0 ), ;
                           If( oQry:LastRec() > 0, oQry:Goto( n ), 0 ) ) }
      :bKeyCount := {|| oQry:LastRec() }
   END

   oBrw:nDataType := DATATYPE_USER
   //oQry:Cargo = oQry:aStructure[ 1 ][ 1 ]
   
   IF lAddCols

      aFldNames := oQry:Struct() //aStructure

      FOR EACH xField IN aFldNames
         cCol    := xField[ 1 ]
         cHeader := xField[ 1 ]
         oCol = SetColFromPostgre( cCol, cHeader, oQry, oBrw )
         //set order
      NEXT

   ENDIF

RETURN 


FUNCTION SetColFromPostgre( cnCol, cHeader, oQry , oBrw ) 

   LOCAL nType, cType, nLen, nDec, cName
   LOCAL oCol, nCol
   
   IF ValType( cnCol ) == "C"
      nCol               := oQry:FieldPos( cnCol )
   ENDIF

   cName                 := oQry:FieldName( nCol )
   DEFAULT ;
   nCol                  := cnCol
   oCol                  := oBrw:AddCol()
   oCol:cHeader          := cHeader
   cType                 := oQry:FieldType( nCol )
   nLen                  := 0
   nDec                  := 0

   DO CASE
   CASE cType       == 'N'
      nLen               := oQry:FieldLen( nCol )
      nDec               := oQry:FieldDec( nCol )
      oCol:cEditPicture  := NumPict( nLen, nDec, .F., .f. )

   CASE cType       == 'C'
      nLen               := MIN( 100, oQry:FieldLen( nCol ) )

   CASE cType       == 'M'
      nLen               := MIN( 100, Len(AllTrim(oQry:FieldGet( nCol ))) )
      nLen               := IF(nLen < 30, 30, nLen )

   CASE cType       == 'D'
      nLen  := 8
      oCol:nHeadStrAlign := 2
      oCol:nDataStrAlign := 0
   
   CASE cType       == 'D'
      nLen  := 1

   OTHERWISE
      // just in case.  this will not be executed
      oCol:bEditValue    := { || "..." } 

   ENDCASE

   oCol:bEditValue       := { || oQry:FieldGet( nCol ) }
   //oCol:cDataType        := If( cType == nil, 'C', cType )
   //oCol:bOnPostEdit      := { |o,x,n| If( n == VK_RETURN, oBrw:onedit( o, x, n, cType, nCol ), NIL ) }

RETURN oCol
Salu2

Carlos Vargas

Desde Managua, Nicaragua (CA)
Posts: 1789
Joined: Tue Oct 11, 2005 05:01 PM

Re: clase TPqSQLServer and xbrowse

Posted: Sun Jun 04, 2017 10:45 PM
Bueno he resuelto de forma cutre pero fácil.
al ser tpqsql una clase muy similar a la tmysql, y como los métodos y datas son similares (al menos en los usado en xbrowse)
he realizado estas pocas modificaciones:

METHOD Initiate
original:
Code (fw): Select all Collapse
      elseif ! Empty( ::oMysql ) .AND. ::oMysql:IsKindOf( 'TMYSQLQUERY' )

cambiado a:
Code (fw): Select all Collapse
      elseif ! Empty( ::oMysql ) .AND. ( ::oMysql:IsKindOf( 'TMYSQLQUERY' ) .or. ::oMysql:IsKindOf( 'TPQSQLQUERY' ) )

function XbrwSetDataSource( oBrw, uDataSrc, lAddCols, lAutoSort, aCols, aRows, aHeaders, bChange )
original:
Code (fw): Select all Collapse
         if uDataSrc:IsKindOf( 'TMYSQLQUERY' )


cambiado a:
Code (fw): Select all Collapse
         if uDataSrc:IsKindOf( 'TMYSQLQUERY' ) .or. uDataSrc:IsKindOf( 'TPQSQLQUERY' )



Salu2

Carlos Vargas

Desde Managua, Nicaragua (CA)
Posts: 1279
Joined: Mon Feb 06, 2006 04:28 PM

Re: clase TPqSQLServer and xbrowse

Posted: Mon Jun 05, 2017 01:57 AM

Excelente Carlos, que buen trabajo :)

Saludos/Regards,

José Murugosa

"Los errores en programación, siempre están entre la silla, el teclado y la IA!!"
Posts: 1078
Joined: Thu Sep 27, 2007 03:47 PM

Re: clase TPqSQLServer and xbrowse

Posted: Thu Jun 08, 2017 07:17 PM
SAludos Carlos
Compile tu ejemplo. y me da este error, supuesta mente no deberia mostrar datos como tu decias,

Tu tienes la libreria para Harbour


Code (fw): Select all Collapse
Application
===========
   Path and name: J:\Estaba en Unidad G\Descargas_Varias\Clase TPqSqlServer para PosgresSQL\samples\prueba1.exe (32 bits)
   Size: 3,553,280 bytes
   Compiler version: xHarbour 1.2.3 Intl. (SimpLex) (Build 20161218)
   FiveWin  version: FWHX 17.04
   C compiler version: Borland/Embarcadero C++ 7.0 (32-bit)
   Windows version: 6.2, Build 9200 

   Time from start: 0 hours 0 mins 8 secs 
   Error occurred at: 08/06/2017, 13:56:48
   Error description: Error BASE/1082  Error de argumento: -
   Args:
     [   1] = N   1
     [   2] = U   

Stack Calls
===========
   Called from: .\source\function\XBROWSER.PRG => FITSIZES( 323 )
   Called from: .\source\function\XBROWSER.PRG => (b)XBROWSE( 270 )
   Called from: .\source\classes\DIALOG.PRG => TDIALOG:INITIATE( 714 )
   Called from: .\source\classes\DIALOG.PRG => TDIALOG:HANDLEEVENT( 906 )
   Called from:  => DIALOGBOXINDIRECT( 0 )
   Called from: .\source\classes\DIALOG.PRG => TDIALOG:ACTIVATE( 296 )
   Called from: .\source\function\XBROWSER.PRG => XBROWSE( 270 )
   Called from: prueba1.prg => MAIN( 124 )
Ruben Dario Gonzalez
Cali-Colombia
rubendariogd@hotmail.com - rubendariogd@gmail.com
Posts: 10733
Joined: Sun Nov 19, 2006 05:22 AM

Re: clase TPqSQLServer and xbrowse

Posted: Fri Jun 09, 2017 10:16 AM

Now FWH 17.05 starts supporting hbpgsql (Harbour ) and pgsql (xHarbour) without any changes or modifications. In FWH 17.06 the support is greatly enhanced.

viewtopic.php?f=3t=34182

&

Regards



G. N. Rao.

Hyderabad, India
Posts: 817
Joined: Sun Jun 15, 2008 07:47 PM

Re: clase TPqSQLServer and xbrowse

Posted: Fri Jun 09, 2017 08:53 PM
Hola Mr. Rao te felicito por la gran labor que está haciendo en el mundo de FWH.
Dicho esto quiero hacer una sugerencia...

El paradigma informático de la Programación Orientada al Objeto está basada en la herencia para conseguir clases especializadas en algo concreto...
Hay que conseguir desacoplar la clase al máximo y desgraciadamente cuando veo el código de TXBrowse me horroriza.
Se ha conseguido que haga muchas cosas, pero a costa de "IF", de "CASE" y continuos parches y eso no está nada bien, lo siento.
Cuando he intentado visualizar fuentes de datos diferentes a las "acopladas" cuesta un poco :-)
La idea es hacer algo parecido al TBrowse de clipper y que con los codeblock de movimiento sea suficiente...
Si queremos un TXBrowse para MariaDB por ejemplo, siempre se podría hacer:
Code (fw): Select all Collapse
CLASS TXBrwMariaDB FROM TXBrowse
ó
CLASS TXBrwEditable FROM TXBrowse
y luego
CLASS TXBrwMariaDB FROM TXBrwEditable


Creo que todo el mundo, sobretodo los desarrolladores se lo agradeceríamos :-)
Será posible? :-)

Saludos y le animo a que siga con su grandísima labor!!!!
______________________________________________________________________________

Sevilla - Andalucía

Continue the discussion