PC Toledo

Código: Selecionar todos

/*
* SQLRDD Test
* Copyright (c) 2003 - Marcelo Lombardo  <marcelo@xharbour.com.br>
* All Rights Reserved
*/

#include "sqlrdd.ch"

#define RECORDS_IN_TEST                   1000
#define SQL_DBMS_NAME                       17
#define SQL_DBMS_VER                        18

/*------------------------------------------------------------------------*/

REQUEST DBFNTX
REQUEST DBFCDX
REQUEST DBFFPT
REQUEST DBFDBT

Function Main( cRDD, cDSN )


   local aStruct := {{"CODE_ID","C",8,0 },;
                     {"CARDID","C",1,0},;
                     {"DESCR","C",50,0},;
                     {"PERCENT","N",10,2},;
                     {"DAYS","N",8,0},;
                     {"DATE_LIM","D",8,0},;
                     {"ENABLE","L",1,0},;
                     {"OBS","M",10,0},;
                     {"VALUE","N",18,6},; 
                     {"ID_EMPRESA","C",4,0} }
					 
   local nCnn, i

   ? ""
   ? "Teste.exe"
   ? ""
   ? "Teste com SQLRDD "
   ? ""

   ? "Connecting to database..."
   
*   SR_SetUseSequences(.T.)         // DESABILITA O CONTADOR DE SEQUENCIA AUTOMATICO
   SR_UseDeleteds( .F. )           // NÃO MANTER REGISTROS DELETADOS NAS TABELAS
   SR_SetFastOpen(.T.)             // ABRE AS TABELAS EM MODO COMPARTILHADO
   SR_SetGoTopOnScope(.F.)         // NÃO EXECUTA O DBGOTOP() AUTOMATICO NOS ORDSCOPE
   SR_MaxRowCache( 10 )            // Quantidade máxima de linhas mantidas em cache em tabelas do SQLRDD. O Default é 1000.
   SR_SetBaseLang( 2 )             // linguagem portugues
   SR_Msg(2)                       // portugues
   SR_SETSYNTHETICINDEX(.F.)       // vale o que for configurado pela função SR_SetSyntheticIndexMinimun().
   SR_SETSYNTHETICINDEXMINIMUN(10) // Quantidade mínima de colunas na chave de índice para criá-lo como Sintético. Os valores aceitos são entre 0 e 10.
   SETPGSOLDBEHAVIOR(.T.)          // CONSIDERAR CAMPOS NULL COMO VAZIO


   If !Connect("SQLRDD", "POSTGRES NATIVE")
      alert('Nao foi possivel conectar ao banco de dados...!')
      close all
      quit
   EndIf

   ? "Connected to        :", SR_GetConnectionInfo(, SQL_DBMS_NAME ), SR_GetConnectionInfo(, SQL_DBMS_VER )
   ? "RDD in use          :", cRDD
   ? "Creating table      :", dbCreate( "TEST_TABLE", aStruct, "SQLRDD" )

   USE "TEST_TABLE" EXCLUSIVE VIA "SQLRDD"

   ? "Table opened. Alias :", select(), alias(), RddName()
   ? "Fieldpos( CODE_ID ) :", Fieldpos( "CODE_ID" )
   ? "Fieldpos( DESCR )   :", Fieldpos( "DESCR" )

   ? "Creating 02 indexes..."

   Index on ID_EMPRESA + CODE_ID       tag TEST_TABLE_IND01 to TEST_TABLE
   Index on str(DAYS) + dtos(DATE_LIM) tag TEST_TABLE_IND02 to TEST_TABLE

   ? "Appending " + alltrim(str(RECORDS_IN_TEST)) + " records.."

   s := seconds()
   
   For i = 1 to RECORDS_IN_TEST
      Append Blank
	  Replace ID_EMPRESA WITH '0001'
      Replace CODE_ID  with strZero( i, 5 )
      Replace DESCR    with dtoc( date() ) + " - " + time()
      Replace DAYS     with (RECORDS_IN_TEST - i)
      Replace DATE_LIM with date()
      Replace ENABLE   with .T.
      Replace OBS      with "This is a memo field. Seconds since midnight : " + alltrim(str(seconds()))
	  
   Next

   ? "dbClearIndex()      :", dbClearIndex()
   ? "dbCloseArea()       :", dbCloseArea()

   USE "TEST_TABLE" SHARED VIA "SQLRDD"

   ? "Opening Indexes"
   dbsetindex('TEST_TABLE')
   
   ? "Set Order to 1      :", OrdSetFocus(1)
   ? "Seek                :", dbSeek( "000100002" )

   ? "found()             :", found()
   ? "Recno(),bof(),eof() :", recno(), bof(), eof()
   ? "dbUnLock()          :", dbUnLock()
   ? "RLock(), dbRLockList:", rlock(), sr_showVector( dbRLockList() )
   ? "Writes to the WA    :", FIELD->DESCR := "Hello, SQL!", FIELD->PERCENT  := 23.55
   ? "dbCommit()          :", dbCommit()
   ? " "
 
   ? "Press any key to browse()"

   inkey(0)
   clear

   ? "Order 1, key is     :", OrdSetFocus(1), ordKey()

   ? "TOP Scope           :", OrdScope( 0 )
   ? "BOTTOM Scope        :", OrdScope( 1 )

   ? "Press any key to browse() with another index and scope"
   inkey(0)
   dbGoTop()
   clear
   browse(row()+1,1,row()+20,80)

   clear
     
   DbGoBottom()
   alert("Recno antes de deletar os registros: " + str(recno()) )
   
&& ---------------- se comentar esse bloco aqui o problema desaparece -----------------   

   if trava()
      delete
      unlock 
	  
      DbGoBottom()
	  
      delete
      DbUnlock() 

	else
      alert("Nao foi possivel bloquear o Registro...!")
   endif	  

&& -------------------------------------------------------------------------------------
 
    DbGoBottom()
	alert( "Recno depois de deletar os 2 registros: " + str(recno()) )
  
  
   ? "Order 1, key is     :", OrdSetFocus(1), ordKey()

   
   
&& ---------------- ou se não utilizar scope também não acontece o erro  ----------------------   


   set scope to '0001' , '9999'

   ? "TOP Scope           :", OrdScope( 0 )
   ? "BOTTOM Scope        :", OrdScope( 1 )

   ? "Press any key to browse() with another index and scope"
   inkey(0)
   dbGoTop()
   clear
   browse(row()+1,1,row()+20,80)

   SET SCOPE TO            && Desativa ESCOPO


   DbGoBottom()
   if trava()
      alert('vou apagar o registro: ' + str(recno()))	  
      delete
      DbUnlock() 
   endif		 
	  
   DbGoBottom()

   alert( "Recno depois de deletar 3º registro: " + str(recno()) )
 
    ? "Pressione qualquer tecla para incluir um novo registro registro()"
   inkey(0)

   if inclui()
      Replace ID_EMPRESA with '0001'
      poecodigo({'ID_EMPRESA','CODE_ID'},5)
      replace DESCR    with dtoc( date() ) + " - " + time()
      Replace DAYS     with (RECORDS_IN_TEST - i)
      Replace DATE_LIM with date()
      Replace ENABLE   with .T.
      Replace OBS      with "This is a memo field. Seconds since midnight : " + alltrim(str(seconds()))
      DbCommit()
   endif
   
Return NIL


**************
func trava
**************

private tt
for tt=1 to 10
   if rlock()
      exit
   endif
   inkey(0.1)
next tt
if !rlock()
*   alert('Registro do arquivo: ' + dbf() + ';Bloqueado em outro terminal.. !')
   alert('Registro ' + if(UsaSgbd,'da Tabela: ','do Arquivo: ') + alias() + ';Esta Sendo Utilizado Em Outro Terminal,;' + ;
         'Libere o Registro para continuar...')

endif
return rlock()

***************
func inclui
***************

private ordem,tt
ordem = indexord()
for tt=1 to 10
   append blank 
   alert('Recno no append blank: ' + str(recno()))
   if !neterr()
      exit
   endif
   inkey(0.1)
next tt

if neterr()
   alert( if(UsaSgbd,'Tabela ',' Arquivo ')  + ' Bloqueado por Outro Usuario - NÆo e poss¡vel incluir registros !')
endif

return !neterr()

*******************
procedure PoeCodigo
*******************
local cCampoTemp
private cCampoAux

para campo,tama,OrdemPara,MemoriaPara

OrdemPara   = if(pcount()>2,OrdemPara,1)
MemoriaPara = if(pcount()>3,MemoriaPara,.t.)

cCampoAux = ''

if type('campo') = 'A'      && Aqui testa para verificar se tem mais de um campo a chave
   for xyz = 1 to len(campo) - 1
       cCampoTemp = campo[xyz]      
       cCampoAux += &cCampoTemp.
   next xyz
   campo = campo[len(campo)]
endif

m->registro = recno()
m->ordem    = indexord()
m->tama     = tama
set order to ordempara
alert('Recno do inclui: ' + str(recno()))
do while .t.
   DbGoBottom()
   ProvAux = strzero(val(&campo) + 1,m->tama)
   seek cCampoaux + ProvAux
   if found()
      if empty(&campo.)                      && Coloquei esse bloco de codigo para evitar o loop 
         IF trava()  &&rlock()                          && enterno quando o valor do registro era em branco.
            replace &campo. with ProvAux
         endif
      endif
      loop
   else 
      if CodigoUnico()
         exit
      endif
   endif
enddo
DbGoto( m->registro )
set order to m->ordem
return

********************
function codigounico
********************

DbGoto( m->registro )


if trava() && rlock()
   replace &campo. with ProvAux
endif   
DbCommit()

seek cCampoAux + ProvAux
* alert('Registro: ' + str(m->Registro) +';Recno: ' + str(recno()) )
if found() .and. m->registro = recno()
   return .t.
endif
return .f.


/*------------------------------------------------------------------------*/

#include "connect.prg"

/*------------------------------------------------------------------------*/